feat(sring_t): add get_json_real_array function

Author: rouson

src/sourcery/sourcery_string_m.f90

@@ -21,8 +21,10 @@ module sourcery_string_m
     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
     generic :: assignment(= ) => assign_string_t_to_character, assign_character_to_string_t
-    generic :: get_json_value =>     get_json_integer_array, get_json_logical, get_json_integer, get_json_string, get_json_real
-    procedure, private            :: get_json_integer_array, get_json_logical, get_json_integer, get_json_string, get_json_real
+    generic :: get_json_value =>     get_json_integer_array, get_json_logical, get_json_integer, get_json_string, get_json_real, &
+                                     get_json_real_array
+    procedure, private            :: get_json_integer_array, get_json_logical, get_json_integer, get_json_string, get_json_real, &
+                                     get_json_real_array
     procedure, private            :: string_t_ne_string_t, string_t_ne_character
     procedure, private            :: string_t_eq_string_t, string_t_eq_character
     procedure, private            :: assign_character_to_string_t
@@ -102,7 +104,7 @@ pure module function base_name(self) result(base)
       type(string_t) base
     end function
 
-    elemental module function get_json_real(self, key, mold) result(value_)
+    pure module function get_json_real(self, key, mold) result(value_)
       implicit none
       class(string_t), intent(in) :: self, key
       real, intent(in) :: mold
@@ -136,6 +138,13 @@ pure module function get_json_integer_array(self, key, mold) result(value_)
       integer, allocatable :: value_(:)
     end function
 
+    pure module function get_json_real_array(self, key, mold) result(value_)
+      implicit none
+      class(string_t), intent(in) :: self, key
+      real, intent(in) :: mold(:)
+      real, allocatable :: value_(:)
+    end function
+
     elemental module function string_t_eq_string_t(lhs, rhs) result(lhs_eq_rhs)
       implicit none
       class(string_t), intent(in) :: lhs, rhs

src/sourcery/sourcery_string_s.f90

@@ -205,6 +205,30 @@
 
   end procedure
 
+  module procedure get_json_real_array
+    character(len=:), allocatable :: raw_line
+    real, allocatable :: real_array(:)
+    integer i
+
+    call assert(key==self%get_json_key(), "string_s(get_json_real_array): key==self%get_json_key()", key)
+
+    raw_line = self%string()
+    associate(colon => index(raw_line, ":"))
+      associate(opening_bracket => colon + index(raw_line(colon+1:), "["))
+        associate(closing_bracket => opening_bracket + index(raw_line(opening_bracket+1:), "]"))
+          associate(commas => count("," == [(raw_line(i:i), i=opening_bracket+1,closing_bracket-1)]))
+            associate(num_inputs => commas + 1)
+              allocate(real_array(num_inputs))
+              read(raw_line(opening_bracket+1:closing_bracket-1), fmt=*) real_array
+              value_ = real_array
+            end associate
+          end associate
+        end associate
+      end associate
+    end associate
+
+  end procedure
+
   module procedure string_t_eq_string_t
     lhs_eq_rhs = lhs%string() == rhs%string()
   end procedure

test/string_test.F90

@@ -36,6 +36,7 @@ function results() result(test_results)
       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 real array value from a colon-separated key/value pair", extracts_real_array_value()), &
       test_result_t("extracting an integer value from a colon-separated key/value pair", extracts_integer_value()), &
       test_result_t('extracting a file base name', extracts_file_base_name()), &
       test_result_t('extracting a file name extension', extracts_file_name_extension()) &
@@ -171,6 +172,26 @@ function extracts_integer_array_value() result(passed)
 #endif
   end function
 
+  function extracts_real_array_value() result(passed)
+    logical passed
+
+#ifndef _CRAYFTN
+    associate(key_real_array_pair => string_t('"a key" : [1., 2., 4.],'))
+      associate(real_array => key_real_array_pair%get_json_value(key=string_t("a key"), mold=[real::]))
+        passed = all(real_array == [1., 2., 4.])
+      end associate
+    end associate
+#else
+    block
+      type(string_t) key_real_array_pair
+      real, allocatable :: real_array(:)
+      key_real_array_pair = string_t('"a key" : [1., 2., 4.],')
+      real_array = key_real_array_pair%get_json_value(key=string_t("a key"), mold=[real::])
+      passed = all(real_array == [1., 2., 4.])
+    end block
+#endif
+  end function
+
   function supports_equivalence_operator() result(passed)
     logical passed
     passed = &