Merge pull request #22 from BerkeleyLab/extract-string-array

Read string_t-array value from JSON key/value pair

src/julienne/julienne_string_m.f90

@@ -23,7 +23,7 @@ module julienne_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_string &
+    generic :: get_json_value => get_string, get_string_t_array &
                                 ,get_real, get_real_with_character_key &
                                 ,get_character, get_character_with_character_key &
                                 ,get_logical, get_logical_with_character_key  &
@@ -33,7 +33,7 @@ module julienne_string_m
                                 ,get_double_precision, get_double_precision_with_character_key &
                                 ,get_double_precision_array, get_double_precision_array_with_character_key
     procedure, private :: get_real, get_real_with_character_key
-    procedure, private :: get_string
+    procedure, private :: get_string, get_string_t_array
     procedure, private :: get_logical, get_logical_with_character_key
     procedure, private :: get_integer, get_integer_with_character_key
     procedure, private :: get_real_array, get_real_array_with_character_key
@@ -185,6 +185,13 @@ elemental module function get_string(self, key, mold) result(value_)
       type(string_t) :: value_
     end function
 
+    pure module function get_string_t_array(self, key, mold) result(value_)
+      implicit none
+      class(string_t), intent(in) :: self, key
+      type(string_t), intent(in) :: mold(:)
+      type(string_t), allocatable :: value_(:)
+    end function
+
     pure module function get_integer_with_character_key(self, key, mold) result(value_)
       implicit none
       class(string_t), intent(in) :: self

src/julienne/julienne_string_s.f90

@@ -1,7 +1,7 @@
 ! Copyright (c) 2024, The Regents of the University of California and Sourcery Institute
 ! Terms of use are as specified in LICENSE.txt
 submodule(julienne_string_m) julienne_string_s
-  use assert_m, only : assert
+  use assert_m, only : assert, intrinsic_array_t
   implicit none
 
 contains
@@ -160,6 +160,35 @@
     end associate
   end procedure
 
+  module procedure get_string_t_array
+
+    character(len=:), allocatable :: raw_line
+    integer i, comma, opening_quotes, closing_quotes
+
+    call assert(key==self%get_json_key(), "key==self%get_string_json()", 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)]))
+            allocate(value_(commas+1))
+            opening_quotes = opening_bracket + index(raw_line(opening_bracket+1:), '"')
+            closing_quotes = opening_quotes + index(raw_line(opening_quotes+1:), '"')
+            value_(1) = raw_line(opening_quotes+1:closing_quotes-1)
+            do i = 1, commas
+              comma = closing_quotes + index(raw_line(closing_quotes+1:), ',')
+              opening_quotes = comma + index(raw_line(comma+1:), '"')
+              closing_quotes = opening_quotes + index(raw_line(opening_quotes+1:), '"')
+              value_(i+1) = raw_line(opening_quotes+1:closing_quotes-1)
+            end do
+          end associate
+        end associate
+      end associate
+    end associate
+  end procedure
+
   module procedure get_string
 
     character(len=:), allocatable :: raw_line

test/string_test.F90

@@ -64,6 +64,8 @@ function results() result(test_results)
         (string_t("extracting a logical value from a colon-separated key/value pair"), extracts_logical_value), &
       test_description_t &
         (string_t("extracting an integer array value from a colon-separated key/value pair"), extracts_integer_array_value), &
+      test_description_t &
+        (string_t("extracting a string_t array value from a colon-separated key/value pair"), extracts_string_array_value), &
       test_description_t &
         (string_t("extracting an real array value from a colon-separated key/value pair"), extracts_real_array_value), &
       test_description_t &
@@ -81,8 +83,10 @@ function results() result(test_results)
       check_allocation_ptr, supports_equivalence_ptr, supports_non_equivalence_ptr, supports_concatenation_ptr, &
       assigns_string_ptr, assigns_character_ptr, constructs_from_integer_ptr, constructs_from_real_ptr, concatenates_ptr, &
       extracts_key_ptr, extracts_real_ptr, extracts_string_ptr, extracts_logical_ptr, extracts_integer_array_ptr, &
-      extracts_real_array_ptr, extracts_integer_ptr, extracts_file_base_ptr, extracts_file_name_ptr, extracts_character_ptr, &
-      extracts_double_precision_value_ptr, extracts_dp_array_value_ptr
+      extracts_real_array_ptr, extracts_integer_ptr, extracts_file_base_ptr, extracts_file_name_ptr, &
+      ! Remove code that exposes a gfortran compiler bug:
+      ! extracts_string_array_ptr, &
+      extracts_character_ptr, extracts_double_precision_value_ptr, extracts_dp_array_value_ptr
 
     check_allocation_ptr => check_allocation
     supports_equivalence_ptr => supports_equivalence_operator
@@ -100,6 +104,8 @@ function results() result(test_results)
     extracts_character_ptr => extracts_character_value
     extracts_logical_ptr => extracts_logical_value
     extracts_integer_array_ptr  => extracts_integer_array_value
+   ! Remove code that exposes a gfortran compiler bug:
+   !extracts_string_array_ptr  => extracts_string_array_value
     extracts_real_array_ptr => extracts_real_array_value
     extracts_dp_array_value_ptr => extracts_dp_array_value
     extracts_integer_ptr => extracts_integer_value
@@ -128,6 +134,9 @@ function results() result(test_results)
       test_description_t(string_t("extracting a logical value from a colon-separated key/value pair"), extracts_logical_ptr), &
       test_description_t( &
         string_t("extracting an integer array value from a colon-separated key/value pair"), extracts_integer_array_ptr), &
+     ! Remove code that exposes a gfortran compiler bug:
+     !test_description_t( &
+     !  string_t("extracting an string array value from a colon-separated key/value pair"), extracts_string_array_ptr), &
       test_description_t( &
         string_t("extracting an real array value from a colon-separated key/value pair"), extracts_real_array_ptr), &
       test_description_t( &
@@ -291,6 +300,28 @@ function extracts_logical_value() result(passed)
 #endif
   end function
 
+#ifndef __GFORTRAN__
+  function extracts_string_array_value() result(passed)
+    logical passed
+
+#ifndef _CRAYFTN
+    associate(key_string_array_pair => string_t('"lead singer" : ["stevie", "ray", "vaughn"],'))
+      associate(string_array => key_string_array_pair%get_json_value(key=string_t("lead singer"), mold=[string_t::]))
+        passed = all(string_array == [string_t("stevie"), string_t("ray"), string_t("vaughn")])
+      end associate
+    end associate
+#else
+    block
+      type(string_t) key_string_array_pair
+      type(string_t), allocatable :: string_array(:)
+      key_string_array_pair = string_t('"lead singer" : ["ella", "fitzgerald"],')
+      string_array = key_string_array_pair%get_json_value(key=string_t("lead singer"), mold=[string_t::])
+      passed = all(string_array == [string_t("ella"), string_t("fitzgerald")])
+    end block
+#endif
+  end function
+#endif
+
   function extracts_integer_array_value() result(passed)
     logical passed