Merge pull request #70 from sourceryinstitute/string-features

String features: unary array operator(.cat.) and constructor from `real` scalar

Author: rouson

src/sourcery/sourcery_string_m.f90

@@ -5,6 +5,7 @@ module sourcery_string_m
   private
   public :: string_t
   public :: array_of_strings
+  public :: operator(.cat.) ! element-wise concatenation operator
 
   type, extends(characterizable_t) :: string_t
     private
@@ -46,10 +47,25 @@ elemental module function from_default_integer(i) result(string)
       type(string_t) string
     end function
 
+    elemental module function from_real(x) result(string)
+      implicit none
+      real, intent(in) :: x
+      type(string_t) string
+    end function
+
   end interface
 
-  interface
+  interface operator(.cat.)
 
+    pure module function concatenate_elements(strings) result(concatenated_strings)
+      implicit none
+      type(string_t), intent(in) :: strings(:)
+      type(string_t) concatenated_strings
+    end function
+
+  end interface
+
+  interface
     pure module function as_character(self) result(raw_string)
       implicit none
       class(string_t), intent(in) :: self

src/sourcery/sourcery_string_s.f90

@@ -24,6 +24,24 @@
     string = string_t(characters)
   end procedure
 
+  module procedure from_real
+    integer, parameter :: sign_ = 1, decimal_ = 1, digits = precision(x) + 3, exponent_width = 4
+    character(len=sign_ + decimal_ + digits + exponent_width) characters
+    write(characters, '(g0)') x
+    string = string_t(characters)
+  end procedure
+
+  module procedure concatenate_elements
+    integer s 
+
+    !allocate(concatenated_strings(sum(len(strings%string()))))
+
+    concatenated_strings = ""
+    do s = 1, size(strings)
+      concatenated_strings = concatenated_strings // strings(s)%string()
+    end do
+  end procedure
+
   module procedure array_of_strings
     character(len=:), allocatable :: remainder, next_string
     integer next_delimiter, string_end

src/sourcery_m.f90

@@ -5,7 +5,7 @@ module sourcery_m
   use sourcery_bin_m, only : bin_t
   use sourcery_formats_m, only : csv, cscv, separated_values
   use sourcery_file_m, only : file_t
-  use sourcery_string_m, only : string_t
+  use sourcery_string_m, only : string_t, operator(.cat.)
   use sourcery_test_result_m, only : test_result_t
   use sourcery_test_m, only : test_t
   use sourcery_user_defined_collectives_m, only : co_all

test/string_test.f90

@@ -1,5 +1,5 @@
 module string_test_m
-  use sourcery_m, only : test_t, test_result_t, string_t
+  use sourcery_m, only : test_t, test_result_t, string_t, operator(.cat.)
   implicit none
 
   private
@@ -23,20 +23,22 @@ function results() result(test_results)
 
     test_results = [ &
       test_result_t("is_allocated() result .true. if & only if the string_t component(s) is/are allocated", check_allocation()), &
+      test_result_t('supporting operator(==) for string_t and character operands', supports_equivalence_operator()), &
+      test_result_t('supporting operator(/=) for string_t and character operands', supports_non_equivalence_operator()), &
+      test_result_t('supporting operator(//) for string_t and character operands', supports_concatenation_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('constructing from a default integer', constructs_from_default_integer()), &
+      test_result_t('constructing from a real value', constructs_from_real()), &
+      test_result_t('supporting unary operator(.cat.) for array arguments', concatenates_elements()), &
       test_result_t("extracting a key string from a colon-separated key/value pair", extracts_key()), &
       test_result_t("extracting a real value from a colon-separated key/value pair", extracts_real_value()), &
       test_result_t("extracting a string value from a colon-separated key/value pair", extracts_string_value()), &
       test_result_t("extracting a logical value from a colon-separated key/value pair", extracts_logical_value()), &
       test_result_t("extracting an integer array value from a colon-separated key/value pair", extracts_integer_array_value()), &
       test_result_t("extracting an integer value from a colon-separated key/value pair", extracts_integer_value()), &
-      test_result_t('supporting operator(==) for string_t and character operands', supports_equivalence_operator()), &
-      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('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()) &
+      test_result_t('extracting a file base name', extracts_file_base_name()), &
+      test_result_t('extracting a file name extension', extracts_file_name_extension()) &
     ]
   end function
 
@@ -160,6 +162,13 @@ function constructs_from_default_integer() result(passed)
     end associate
   end function
 
+  function constructs_from_real() result(passed)
+    logical passed
+    associate(string => string_t(123456789E+09))
+      passed = adjustl(trim(string%string())) == "0.123456791E+18"
+    end associate
+  end function
+
   function extracts_file_base_name() result(passed)
     logical passed
     associate(string => string_t(" foo .bar.too "))
@@ -174,4 +183,11 @@ function extracts_file_name_extension() result(passed)
     end associate
   end function
 
+  function concatenates_elements() result(passed)
+    logical passed
+    associate(elements => [string_t("foo"), string_t("bar")])
+      passed = .cat. elements  == "foobar"
+    end associate
+  end function
+
 end module string_test_m