@@ -739,45 +739,76 @@ pure function get_string_idx_impl( list, idx )
739
739
740
740
end function get_string_idx_impl
741
741
742
- ! pop:
743
-
744
742
! > Version: experimental
745
743
! >
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
758
755
759
756
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)
764
757
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
766
765
767
766
allocate ( new_stringarray(new_len) )
768
-
769
- do i = 1 , idxn - 1
767
+ do i = 1 , firstn - 1
770
768
call move( list% stringarray(i), new_stringarray(i) )
771
769
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
774
783
call move( list% stringarray(i), new_stringarray(inew) )
784
+ inew = inew + 1
775
785
end do
776
786
777
787
call move_alloc( new_stringarray, list% stringarray )
778
788
779
789
end if
780
790
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
+
781
812
end function pop_string_idx_impl
782
813
783
814
! drop:
@@ -789,10 +820,8 @@ end function pop_string_idx_impl
789
820
subroutine drop_string_idx_impl ( list , idx )
790
821
class(stringlist_type) :: list
791
822
type (stringlist_index_type), intent (in ) :: idx
792
- type (string_type) :: garbage_string
793
823
794
- ! Throwing away garbage_string by not returning it
795
- garbage_string = list% pop( idx )
824
+ call pop_positions( list, idx, idx )
796
825
797
826
end subroutine drop_string_idx_impl
798
827
0 commit comments