Skip to content

Commit 440fd27

Browse files
committed
created a new subroutine pop_positions
1 parent 8746922 commit 440fd27

File tree

1 file changed

+55
-26
lines changed

1 file changed

+55
-26
lines changed

src/stdlib_stringlist_type.f90

Lines changed: 55 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -735,45 +735,76 @@ pure function get_string_idx_impl( list, idx )
735735

736736
end function get_string_idx_impl
737737

738-
! pop:
739-
740738
!> Version: experimental
741739
!>
742-
!> Removes the string present at stringlist_index 'idx' in stringlist 'list'
743-
!> Returns the removed string
744-
function pop_string_idx_impl( list, idx )
745-
class(stringlist_type) :: list
746-
type(stringlist_index_type), intent(in) :: idx
747-
type(string_type) :: pop_string_idx_impl
748-
749-
integer :: idxn, i, inew
750-
integer :: old_len, new_len
751-
type(string_type), dimension(:), allocatable :: new_stringarray
752-
753-
idxn = list%to_current_idxn( idx )
740+
!> Removes strings present at indexes in interval ['first', 'last']
741+
!> Returns captured popped strings
742+
subroutine pop_positions( list, first, last, capture_popped)
743+
class(stringlist_type) :: list
744+
type(stringlist_index_type), intent(in) :: first, last
745+
type(string_type), allocatable, intent(out), optional :: capture_popped(:)
746+
747+
integer :: firstn, lastn
748+
integer :: i, inew
749+
integer :: pos, old_len, new_len
750+
type(string_type), dimension(:), allocatable :: new_stringarray
754751

755752
old_len = list%len()
756-
! if the index is out of bounds, returns a string_type instance equivalent to empty string
757-
! without deleting anything from the stringlist
758-
if ( 1 <= idxn .and. idxn <= old_len ) then
759-
pop_string_idx_impl = list%stringarray(idxn)
760753

761-
new_len = old_len - 1
754+
firstn = max( list%to_current_idxn( first ), 1 )
755+
lastn = min( list%to_current_idxn( last ), old_len )
756+
757+
! out of bounds indexes won't modify stringlist
758+
if ( firstn <= lastn ) then
759+
pos = lastn - firstn + 1
760+
new_len = old_len - pos
762761

763762
allocate( new_stringarray(new_len) )
764-
765-
do i = 1, idxn - 1
763+
do i = 1, firstn - 1
766764
call move( list%stringarray(i), new_stringarray(i) )
767765
end do
768-
do i = idxn + 1, old_len
769-
inew = i - 1
766+
767+
! capture popped strings
768+
if ( present(capture_popped) ) then
769+
allocate( capture_popped(pos) )
770+
inew = 1
771+
do i = firstn, lastn
772+
call move( list%stringarray(i), capture_popped(inew) )
773+
inew = inew + 1
774+
end do
775+
end if
776+
777+
inew = firstn
778+
do i = lastn + 1, old_len
770779
call move( list%stringarray(i), new_stringarray(inew) )
780+
inew = inew + 1
771781
end do
772782

773783
call move_alloc( new_stringarray, list%stringarray )
774784

775785
end if
776786

787+
end subroutine pop_positions
788+
789+
! pop:
790+
791+
!> Version: experimental
792+
!>
793+
!> Removes the string present at stringlist_index 'idx' in stringlist 'list'
794+
!> Returns the removed string
795+
function pop_string_idx_impl( list, idx )
796+
class(stringlist_type) :: list
797+
type(stringlist_index_type), intent(in) :: idx
798+
type(string_type) :: pop_string_idx_impl
799+
800+
type(string_type), dimension(:), allocatable :: capture_popped
801+
802+
call pop_positions( list, idx, idx, capture_popped )
803+
804+
if ( allocated(capture_popped) ) then
805+
pop_string_idx_impl = capture_popped(1)
806+
end if
807+
777808
end function pop_string_idx_impl
778809

779810
! drop:
@@ -785,10 +816,8 @@ end function pop_string_idx_impl
785816
subroutine drop_string_idx_impl( list, idx )
786817
class(stringlist_type) :: list
787818
type(stringlist_index_type), intent(in) :: idx
788-
type(string_type) :: garbage_string
789819

790-
! Throwing away garbage_string by not returning it
791-
garbage_string = list%pop( idx )
820+
call pop_positions( list, idx, idx )
792821

793822
end subroutine drop_string_idx_impl
794823

0 commit comments

Comments
 (0)