Skip to content

Commit c790494

Browse files
committed
added delete function for stringlist
1 parent ea46f19 commit c790494

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

@@ -718,22 +721,64 @@ end subroutine insert_before_stringarray_int_impl
718721
!>
719722
!> Returns the string present at stringlist_index 'idx' in stringlist 'list'
720723
!> Returns string_type instance
721-
pure function get_string_idx_wrap( list, idx )
724+
pure function get_string_idx_impl( list, idx )
722725
class(stringlist_type), intent(in) :: list
723726
type(stringlist_index_type), intent(in) :: idx
724-
type(string_type) :: get_string_idx_wrap
727+
type(string_type) :: get_string_idx_impl
725728

726729
integer :: idxn
727730

728731
idxn = list%to_current_idxn( idx )
729732

730-
! if the index is out of bounds, return a string_type equivalent to empty string
733+
! if the index is out of bounds, returns a string_type instance equivalent to empty string
731734
if ( 1 <= idxn .and. idxn <= list%len() ) then
732-
get_string_idx_wrap = list%stringarray(idxn)
735+
get_string_idx_impl = list%stringarray(idxn)
733736

734737
end if
735738

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

782+
end function delete_string_idx_impl
738783

739784
end module stdlib_stringlist_type

0 commit comments

Comments
 (0)