Merge branch 'main' of ssh://ssh.github.com:443/sourceryinstitute/sourcery into fixes-for-favpro

Author: zbeekman

src/sourcery/sourcery_string_functions_m.f90

@@ -14,6 +14,8 @@ module sourcery_string_m
     generic :: string => as_character
     procedure :: is_allocated
     procedure :: get_json_key
+    procedure :: file_extension
+    procedure :: base_name
     generic :: operator(//)   => string_t_cat_string_t, string_t_cat_character, character_cat_string_t
     generic :: operator(/=)   => string_t_ne_string_t, string_t_ne_character, character_ne_string_t
     generic :: operator(==)   => string_t_eq_string_t, string_t_eq_character, character_eq_string_t
@@ -38,6 +40,12 @@ elemental module function construct(string) result(new_string)
       type(string_t) new_string
     end function
 
+    elemental module function from_default_integer(i) result(string)
+      implicit none
+      integer, intent(in) :: i
+      type(string_t) string
+    end function
+
   end interface
 
   interface
@@ -66,6 +74,18 @@ elemental module function get_json_key(self) result(unquoted_key)
       type(string_t) unquoted_key
     end function
 
+    elemental module function file_extension(self) result(extension)
+      !! result contains all characters in file_name after the last dot (.)
+      class(string_t), intent(in) :: self
+      type(string_t) extension
+    end function
+
+    pure module function base_name(self) result(base)
+      !! result contains all characters in file_name before the last dot (.)
+      class(string_t), intent(in) :: self
+      type(string_t) base
+    end function
+
     elemental module function get_json_real(self, key, mold) result(value_)
       implicit none
       class(string_t), intent(in) :: self, key

src/sourcery/sourcery_string_functions_s.f90

@@ -17,6 +17,13 @@
     string_allocated = allocated(self%string_)
   end procedure
 
+  module procedure from_default_integer
+    integer, parameter :: sign_width = 1, digits_width = range(i) + 1
+    character(len = digits_width + sign_width) characters
+    write(characters, '(i0)') i
+    string = string_t(characters)
+  end procedure
+
   module procedure array_of_strings
     character(len=:), allocatable :: remainder, next_string
     integer next_delimiter, string_end
@@ -51,6 +58,34 @@
 
   end procedure
 
+  module procedure file_extension
+    character(len=:), allocatable :: name_
+
+    name_ = trim(adjustl(self%string()))
+
+    associate( dot_location => index(name_, '.', back=.true.) )
+      if (dot_location < len(name_)) then
+        extension = trim(adjustl(name_(dot_location+1:)))
+      else
+        extension = ""
+      end if
+    end associate
+  end procedure
+
+  module procedure base_name
+    character(len=:), allocatable :: name_
+
+    name_ = self%string()
+    
+    associate(dot_location => index(name_, '.', back=.true.) )
+      if (dot_location < len(name_)) then
+        base = trim(adjustl(name_(1:dot_location-1)))
+      else
+        base = ""
+      end if
+    end associate
+  end procedure
+
   module procedure get_json_real
     character(len=:), allocatable :: raw_line, string_value
 

src/sourcery/sourcery_string_m.f90

@@ -2,7 +2,6 @@ module string_test_m
   use sourcery_m, only : test_t, test_result_t, string_t
   implicit none
 
-
   private
   public :: string_test_t
 
@@ -34,7 +33,10 @@ function results() result(test_results)
       test_result_t('supporting operator(/=) for string_t and character operands', supports_non_equivalence_operator()), &
       test_result_t('assigning a string_t object to a character variable', assigns_string_t_to_character()), &
       test_result_t('assigning a character variable to a string_t object', assigns_character_to_string_t()), &
-      test_result_t('supporting operator(//) for string_t and character operands', supports_concatenation_operator()) &
+      test_result_t('supporting operator(//) for string_t and character operands', supports_concatenation_operator()), &
+      test_result_t('constructing from a default integer', constructs_from_default_integer()), &
+      test_result_t('extracting file base name', extracts_file_base_name()), &
+      test_result_t('extracting file name extension', extracts_file_name_extension()) &
     ]
   end function
 
@@ -151,4 +153,25 @@ function supports_concatenation_operator() result(passed)
     end associate
   end function
 
+  function constructs_from_default_integer() result(passed)
+    logical passed
+    associate(string => string_t(1234567890))
+      passed = adjustl(trim(string%string())) == "1234567890"
+    end associate
+  end function
+
+  function extracts_file_base_name() result(passed)
+    logical passed
+    associate(string => string_t(" foo .bar.too "))
+      passed = string%base_name() == "foo .bar"
+    end associate
+  end function
+
+  function extracts_file_name_extension() result(passed)
+    logical passed
+    associate(string => string_t(" foo .bar.too "))
+      passed = string%file_extension() == "too"
+    end associate
+  end function
+
 end module string_test_m