Skip to content

Commit 1468fb6

Browse files
committed
added range functions for pop and drop
1 parent 92d5f0d commit 1468fb6

File tree

1 file changed

+56
-21
lines changed

1 file changed

+56
-21
lines changed

src/stdlib_stringlist_type.f90

Lines changed: 56 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -69,10 +69,10 @@ module stdlib_stringlist_type
6969
procedure :: insert_at_stringlist_idx => insert_at_stringlist_idx_wrap
7070
procedure :: insert_at_chararray_idx => insert_at_chararray_idx_wrap
7171
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, &
7676
insert_at_stringarray_idx
7777

7878
procedure :: insert_before_string_int => insert_before_string_int_impl
@@ -87,11 +87,15 @@ module stdlib_stringlist_type
8787
procedure :: get_string_idx => get_string_idx_impl
8888
generic, public :: get => get_string_idx
8989

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
9294

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
9599

96100
end type stringlist_type
97101

@@ -743,7 +747,7 @@ end function get_string_idx_impl
743747
!>
744748
!> Removes strings present at indexes in interval ['first', 'last']
745749
!> Returns captured popped strings
746-
subroutine pop_positions( list, first, last, capture_popped)
750+
subroutine pop_engine( list, first, last, capture_popped)
747751
class(stringlist_type) :: list
748752
type(stringlist_index_type), intent(in) :: first, last
749753
type(string_type), allocatable, intent(out), optional :: capture_popped(:)
@@ -785,44 +789,75 @@ subroutine pop_positions( list, first, last, capture_popped)
785789
end do
786790

787791
call move_alloc( new_stringarray, list%stringarray )
788-
792+
else
793+
if ( present(capture_popped) ) then
794+
allocate( capture_popped(0) )
795+
end if
789796
end if
790797

791-
end subroutine pop_positions
798+
end subroutine pop_engine
792799

793800
! pop:
794801

795802
!> Version: experimental
796803
!>
797804
!> Removes the string present at stringlist_index 'idx' in stringlist 'list'
798805
!> Returns the removed string
799-
function pop_string_idx_impl( list, idx )
806+
function pop_idx_impl( list, idx )
800807
class(stringlist_type) :: list
801808
type(stringlist_index_type), intent(in) :: idx
802-
type(string_type) :: pop_string_idx_impl
809+
type(string_type) :: pop_idx_impl
803810

804-
type(string_type), dimension(:), allocatable :: capture_popped
811+
type(string_type), dimension(:), allocatable :: popped_strings
805812

806-
call pop_positions( list, idx, idx, capture_popped )
813+
call pop_engine( list, idx, idx, popped_strings )
807814

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)
810817
end if
811818

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
813835

814836
! drop:
815837

816838
!> Version: experimental
817839
!>
818840
!> Removes the string present at stringlist_index 'idx' in stringlist 'list'
819841
!> Doesn't return the removed string
820-
subroutine drop_string_idx_impl( list, idx )
842+
subroutine drop_idx_impl( list, idx )
821843
class(stringlist_type) :: list
822844
type(stringlist_index_type), intent(in) :: idx
823845

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 )
825860

826-
end subroutine drop_string_idx_impl
861+
end subroutine drop_idx_impl
827862

828863
end module stdlib_stringlist_type

0 commit comments

Comments
 (0)