Skip to content

Commit 92d5f0d

Browse files
committed
created a new subroutine pop_positions
1 parent 00de2b7 commit 92d5f0d

File tree

1 file changed

+55
-26
lines changed

1 file changed

+55
-26
lines changed

src/stdlib_stringlist_type.f90

Lines changed: 55 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -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

Comments
 (0)