@@ -735,45 +735,76 @@ pure function get_string_idx_impl( list, idx )
735
735
736
736
end function get_string_idx_impl
737
737
738
- ! pop:
739
-
740
738
! > Version: experimental
741
739
! >
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
754
751
755
752
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)
760
753
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
762
761
763
762
allocate ( new_stringarray(new_len) )
764
-
765
- do i = 1 , idxn - 1
763
+ do i = 1 , firstn - 1
766
764
call move( list% stringarray(i), new_stringarray(i) )
767
765
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
770
779
call move( list% stringarray(i), new_stringarray(inew) )
780
+ inew = inew + 1
771
781
end do
772
782
773
783
call move_alloc( new_stringarray, list% stringarray )
774
784
775
785
end if
776
786
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
+
777
808
end function pop_string_idx_impl
778
809
779
810
! drop:
@@ -785,10 +816,8 @@ end function pop_string_idx_impl
785
816
subroutine drop_string_idx_impl ( list , idx )
786
817
class(stringlist_type) :: list
787
818
type (stringlist_index_type), intent (in ) :: idx
788
- type (string_type) :: garbage_string
789
819
790
- ! Throwing away garbage_string by not returning it
791
- garbage_string = list% pop( idx )
820
+ call pop_positions( list, idx, idx )
792
821
793
822
end subroutine drop_string_idx_impl
794
823
0 commit comments