@@ -739,45 +739,76 @@ pure function get_string_idx_impl( list, idx )
739739
740740 end function get_string_idx_impl
741741
742- ! pop:
743-
744742 ! > Version: experimental
745743 ! >
746- ! > Removes the string present at stringlist_index 'idx' in stringlist 'list'
747- ! > Returns the removed string
748- function pop_string_idx_impl ( list , idx )
749- class(stringlist_type) :: list
750- type (stringlist_index_type), intent (in ) :: idx
751- type (string_type) :: pop_string_idx_impl
752-
753- integer :: idxn, i, inew
754- integer :: old_len, new_len
755- type (string_type), dimension (:), allocatable :: new_stringarray
756-
757- idxn = list% to_current_idxn( idx )
744+ ! > Removes strings present at indexes in interval ['first', 'last']
745+ ! > Returns captured popped strings
746+ subroutine pop_positions ( list , first , last , capture_popped )
747+ class(stringlist_type) :: list
748+ type (stringlist_index_type), intent (in ) :: first, last
749+ type (string_type), allocatable , intent (out ), optional :: capture_popped(:)
750+
751+ integer :: firstn, lastn
752+ integer :: i, inew
753+ integer :: pos, old_len, new_len
754+ type (string_type), dimension (:), allocatable :: new_stringarray
758755
759756 old_len = list% len ()
760- ! if the index is out of bounds, returns a string_type instance equivalent to empty string
761- ! without deleting anything from the stringlist
762- if ( 1 <= idxn .and. idxn <= old_len ) then
763- pop_string_idx_impl = list% stringarray(idxn)
764757
765- new_len = old_len - 1
758+ firstn = max ( list% to_current_idxn( first ), 1 )
759+ lastn = min ( list% to_current_idxn( last ), old_len )
760+
761+ ! out of bounds indexes won't modify stringlist
762+ if ( firstn <= lastn ) then
763+ pos = lastn - firstn + 1
764+ new_len = old_len - pos
766765
767766 allocate ( new_stringarray(new_len) )
768-
769- do i = 1 , idxn - 1
767+ do i = 1 , firstn - 1
770768 call move( list% stringarray(i), new_stringarray(i) )
771769 end do
772- do i = idxn + 1 , old_len
773- inew = i - 1
770+
771+ ! capture popped strings
772+ if ( present (capture_popped) ) then
773+ allocate ( capture_popped(pos) )
774+ inew = 1
775+ do i = firstn, lastn
776+ call move( list% stringarray(i), capture_popped(inew) )
777+ inew = inew + 1
778+ end do
779+ end if
780+
781+ inew = firstn
782+ do i = lastn + 1 , old_len
774783 call move( list% stringarray(i), new_stringarray(inew) )
784+ inew = inew + 1
775785 end do
776786
777787 call move_alloc( new_stringarray, list% stringarray )
778788
779789 end if
780790
791+ end subroutine pop_positions
792+
793+ ! pop:
794+
795+ ! > Version: experimental
796+ ! >
797+ ! > Removes the string present at stringlist_index 'idx' in stringlist 'list'
798+ ! > Returns the removed string
799+ function pop_string_idx_impl ( list , idx )
800+ class(stringlist_type) :: list
801+ type (stringlist_index_type), intent (in ) :: idx
802+ type (string_type) :: pop_string_idx_impl
803+
804+ type (string_type), dimension (:), allocatable :: capture_popped
805+
806+ call pop_positions( list, idx, idx, capture_popped )
807+
808+ if ( allocated (capture_popped) ) then
809+ pop_string_idx_impl = capture_popped(1 )
810+ end if
811+
781812 end function pop_string_idx_impl
782813
783814 ! drop:
@@ -789,10 +820,8 @@ end function pop_string_idx_impl
789820 subroutine drop_string_idx_impl ( list , idx )
790821 class(stringlist_type) :: list
791822 type (stringlist_index_type), intent (in ) :: idx
792- type (string_type) :: garbage_string
793823
794- ! Throwing away garbage_string by not returning it
795- garbage_string = list% pop( idx )
824+ call pop_positions( list, idx, idx )
796825
797826 end subroutine drop_string_idx_impl
798827
0 commit comments