Skip to content

Commit ef8248b

Browse files
committed
added delete function for stringlist
1 parent ff0756d commit ef8248b

File tree

1 file changed

+52
-7
lines changed

1 file changed

+52
-7
lines changed

src/stdlib_stringlist_type.f90

Lines changed: 52 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -84,8 +84,11 @@ module stdlib_stringlist_type
8484
insert_before_chararray_int, &
8585
insert_before_stringarray_int
8686

87-
procedure :: get_string_idx => get_string_idx_wrap
88-
generic, public :: get => get_string_idx
87+
procedure :: get_string_idx => get_string_idx_impl
88+
generic, public :: get => get_string_idx
89+
90+
procedure :: delete_string_idx => delete_string_idx_impl
91+
generic, public :: delete => delete_string_idx
8992

9093
end type stringlist_type
9194

@@ -714,22 +717,64 @@ end subroutine insert_before_stringarray_int_impl
714717
!>
715718
!> Returns the string present at stringlist_index 'idx' in stringlist 'list'
716719
!> Returns string_type instance
717-
pure function get_string_idx_wrap( list, idx )
720+
pure function get_string_idx_impl( list, idx )
718721
class(stringlist_type), intent(in) :: list
719722
type(stringlist_index_type), intent(in) :: idx
720-
type(string_type) :: get_string_idx_wrap
723+
type(string_type) :: get_string_idx_impl
721724

722725
integer :: idxn
723726

724727
idxn = list%to_current_idxn( idx )
725728

726-
! if the index is out of bounds, return a string_type equivalent to empty string
729+
! if the index is out of bounds, returns a string_type instance equivalent to empty string
727730
if ( 1 <= idxn .and. idxn <= list%len() ) then
728-
get_string_idx_wrap = list%stringarray(idxn)
731+
get_string_idx_impl = list%stringarray(idxn)
729732

730733
end if
731734

732-
end function get_string_idx_wrap
735+
end function get_string_idx_impl
736+
737+
! delete:
738+
739+
!> Version: experimental
740+
!>
741+
!> Deletes the string present at stringlist_index 'idx' in stringlist 'list'
742+
!> Returns the deleted string
743+
impure function delete_string_idx_impl( list, idx )
744+
class(stringlist_type) :: list
745+
type(stringlist_index_type), intent(in) :: idx
746+
type(string_type) :: delete_string_idx_impl
747+
748+
integer :: idxn, i, inew
749+
integer :: old_len, new_len
750+
type(string_type), dimension(:), allocatable :: new_stringarray
751+
752+
idxn = list%to_current_idxn( idx )
753+
754+
old_len = list%len()
755+
! if the index is out of bounds, returns a string_type instance equivalent to empty string
756+
! without deleting anything from the stringlist
757+
if ( 1 <= idxn .and. idxn <= old_len ) then
758+
delete_string_idx_impl = list%stringarray(idxn)
759+
760+
new_len = old_len - 1
761+
762+
allocate( new_stringarray(new_len) )
763+
764+
do i = 1, idxn - 1
765+
! TODO: can be improved by move
766+
new_stringarray(i) = list%stringarray(i)
767+
end do
768+
do i = idxn + 1, old_len
769+
inew = i - 1
770+
! TODO: can be improved by move
771+
new_stringarray(inew) = list%stringarray(i)
772+
end do
773+
774+
call move_alloc( new_stringarray, list%stringarray )
775+
776+
end if
733777

778+
end function delete_string_idx_impl
734779

735780
end module stdlib_stringlist_type

0 commit comments

Comments
 (0)