@@ -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
735780end module stdlib_stringlist_type
0 commit comments