@@ -69,10 +69,10 @@ module stdlib_stringlist_type
69
69
procedure :: insert_at_stringlist_idx = > insert_at_stringlist_idx_wrap
70
70
procedure :: insert_at_chararray_idx = > insert_at_chararray_idx_wrap
71
71
procedure :: insert_at_stringarray_idx = > insert_at_stringarray_idx_wrap
72
- generic, public :: insert_at = > insert_at_char_idx, &
73
- insert_at_string_idx, &
74
- insert_at_stringlist_idx, &
75
- insert_at_chararray_idx, &
72
+ generic, public :: insert_at = > insert_at_char_idx, &
73
+ insert_at_string_idx, &
74
+ insert_at_stringlist_idx, &
75
+ insert_at_chararray_idx, &
76
76
insert_at_stringarray_idx
77
77
78
78
procedure :: insert_before_string_int = > insert_before_string_int_impl
@@ -87,11 +87,15 @@ module stdlib_stringlist_type
87
87
procedure :: get_string_idx = > get_string_idx_impl
88
88
generic, public :: get = > get_string_idx
89
89
90
- procedure :: pop_string_idx = > pop_string_idx_impl
91
- generic, public :: pop = > pop_string_idx
90
+ procedure :: pop_idx = > pop_idx_impl
91
+ procedure :: pop_range_idx = > pop_range_idx_impl
92
+ generic, public :: pop = > pop_idx, &
93
+ pop_range_idx
92
94
93
- procedure :: drop_string_idx = > drop_string_idx_impl
94
- generic, public :: drop = > drop_string_idx
95
+ procedure :: drop_idx = > drop_idx_impl
96
+ procedure :: drop_range_idx = > drop_range_idx_impl
97
+ generic, public :: drop = > drop_idx, &
98
+ drop_range_idx
95
99
96
100
end type stringlist_type
97
101
@@ -743,7 +747,7 @@ end function get_string_idx_impl
743
747
! >
744
748
! > Removes strings present at indexes in interval ['first', 'last']
745
749
! > Returns captured popped strings
746
- subroutine pop_positions ( list , first , last , capture_popped )
750
+ subroutine pop_engine ( list , first , last , capture_popped )
747
751
class(stringlist_type) :: list
748
752
type (stringlist_index_type), intent (in ) :: first, last
749
753
type (string_type), allocatable , intent (out ), optional :: capture_popped(:)
@@ -785,44 +789,75 @@ subroutine pop_positions( list, first, last, capture_popped)
785
789
end do
786
790
787
791
call move_alloc( new_stringarray, list% stringarray )
788
-
792
+ else
793
+ if ( present (capture_popped) ) then
794
+ allocate ( capture_popped(0 ) )
795
+ end if
789
796
end if
790
797
791
- end subroutine pop_positions
798
+ end subroutine pop_engine
792
799
793
800
! pop:
794
801
795
802
! > Version: experimental
796
803
! >
797
804
! > Removes the string present at stringlist_index 'idx' in stringlist 'list'
798
805
! > Returns the removed string
799
- function pop_string_idx_impl ( list , idx )
806
+ function pop_idx_impl ( list , idx )
800
807
class(stringlist_type) :: list
801
808
type (stringlist_index_type), intent (in ) :: idx
802
- type (string_type) :: pop_string_idx_impl
809
+ type (string_type) :: pop_idx_impl
803
810
804
- type (string_type), dimension (:), allocatable :: capture_popped
811
+ type (string_type), dimension (:), allocatable :: popped_strings
805
812
806
- call pop_positions ( list, idx, idx, capture_popped )
813
+ call pop_engine ( list, idx, idx, popped_strings )
807
814
808
- if ( allocated (capture_popped) ) then
809
- pop_string_idx_impl = capture_popped (1 )
815
+ if ( size (popped_strings) > 0 ) then
816
+ pop_idx_impl = popped_strings (1 )
810
817
end if
811
818
812
- end function pop_string_idx_impl
819
+ end function pop_idx_impl
820
+
821
+ ! > Version: experimental
822
+ ! >
823
+ ! > Removes strings present at stringlist_indexes in interval ['first', 'last']
824
+ ! > in stringlist 'list'
825
+ ! > Returns removed strings
826
+ function pop_range_idx_impl ( list , first , last )
827
+ class(stringlist_type) :: list
828
+ type (stringlist_index_type), intent (in ) :: first, last
829
+
830
+ type (string_type), dimension (:), allocatable :: pop_range_idx_impl
831
+
832
+ call pop_engine( list, first, last, pop_range_idx_impl )
833
+
834
+ end function pop_range_idx_impl
813
835
814
836
! drop:
815
837
816
838
! > Version: experimental
817
839
! >
818
840
! > Removes the string present at stringlist_index 'idx' in stringlist 'list'
819
841
! > Doesn't return the removed string
820
- subroutine drop_string_idx_impl ( list , idx )
842
+ subroutine drop_idx_impl ( list , idx )
821
843
class(stringlist_type) :: list
822
844
type (stringlist_index_type), intent (in ) :: idx
823
845
824
- call pop_positions( list, idx, idx )
846
+ call pop_engine( list, idx, idx )
847
+
848
+ end subroutine drop_idx_impl
849
+
850
+ ! > Version: experimental
851
+ ! >
852
+ ! > Removes strings present at stringlist_indexes in interval ['first', 'last']
853
+ ! > in stringlist 'list'
854
+ ! > Doesn't return removed strings
855
+ subroutine drop_idx_impl ( list , first , last )
856
+ class(stringlist_type) :: list
857
+ type (stringlist_index_type), intent (in ) :: first, last
858
+
859
+ call pop_engine( list, first, last )
825
860
826
- end subroutine drop_string_idx_impl
861
+ end subroutine drop_idx_impl
827
862
828
863
end module stdlib_stringlist_type
0 commit comments