@@ -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
@@ -718,22 +721,64 @@ end subroutine insert_before_stringarray_int_impl
718
721
! >
719
722
! > Returns the string present at stringlist_index 'idx' in stringlist 'list'
720
723
! > Returns string_type instance
721
- pure function get_string_idx_wrap ( list , idx )
724
+ pure function get_string_idx_impl ( list , idx )
722
725
class(stringlist_type), intent (in ) :: list
723
726
type (stringlist_index_type), intent (in ) :: idx
724
- type (string_type) :: get_string_idx_wrap
727
+ type (string_type) :: get_string_idx_impl
725
728
726
729
integer :: idxn
727
730
728
731
idxn = list% to_current_idxn( idx )
729
732
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
731
734
if ( 1 <= idxn .and. idxn <= list% len () ) then
732
- get_string_idx_wrap = list% stringarray(idxn)
735
+ get_string_idx_impl = list% stringarray(idxn)
733
736
734
737
end if
735
738
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
737
781
782
+ end function delete_string_idx_impl
738
783
739
784
end module stdlib_stringlist_type
0 commit comments