@@ -84,8 +84,11 @@ module stdlib_stringlist_type
84
84
insert_before_chararray_int, &
85
85
insert_before_stringarray_int
86
86
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
89
92
90
93
end type stringlist_type
91
94
@@ -714,22 +717,64 @@ end subroutine insert_before_stringarray_int_impl
714
717
! >
715
718
! > Returns the string present at stringlist_index 'idx' in stringlist 'list'
716
719
! > Returns string_type instance
717
- pure function get_string_idx_wrap ( list , idx )
720
+ pure function get_string_idx_impl ( list , idx )
718
721
class(stringlist_type), intent (in ) :: list
719
722
type (stringlist_index_type), intent (in ) :: idx
720
- type (string_type) :: get_string_idx_wrap
723
+ type (string_type) :: get_string_idx_impl
721
724
722
725
integer :: idxn
723
726
724
727
idxn = list% to_current_idxn( idx )
725
728
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
727
730
if ( 1 <= idxn .and. idxn <= list% len () ) then
728
- get_string_idx_wrap = list% stringarray(idxn)
731
+ get_string_idx_impl = list% stringarray(idxn)
729
732
730
733
end if
731
734
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
733
777
778
+ end function delete_string_idx_impl
734
779
735
780
end module stdlib_stringlist_type
0 commit comments