diff --git a/src/julienne/julienne_string_m.f90 b/src/julienne/julienne_string_m.f90 index 9025a07d..0719f20f 100644 --- a/src/julienne/julienne_string_m.f90 +++ b/src/julienne/julienne_string_m.f90 @@ -30,7 +30,8 @@ module julienne_string_m ,get_real_array ,get_real_array_with_character_key & ,get_integer_array, get_integer_array_with_character_key & ,get_integer, get_integer_with_character_key & - ,get_double_precision, get_double_precision_with_character_key + ,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_logical, get_logical_with_character_key @@ -38,7 +39,8 @@ module julienne_string_m procedure, private :: get_real_array, get_real_array_with_character_key procedure, private :: get_integer_array, get_integer_array_with_character_key procedure, private :: get_character, get_character_with_character_key - procedure :: get_double_precision, get_double_precision_with_character_key + procedure, private :: get_double_precision, get_double_precision_with_character_key + procedure, private :: get_double_precision_array, get_double_precision_array_with_character_key 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 @@ -148,6 +150,21 @@ pure module function get_double_precision_with_character_key(self, key, mold) re double precision value_ end function + pure module function get_double_precision_array(self, key, mold) result(value_) + implicit none + class(string_t), intent(in) :: self, key + double precision, intent(in) :: mold(:) + double precision, allocatable :: value_(:) + end function + + pure module function get_double_precision_array_with_character_key(self, key, mold) result(value_) + implicit none + class(string_t), intent(in) :: self + character(len=*), intent(in) :: key + double precision, intent(in) :: mold(:) + double precision, allocatable :: value_(:) + end function + pure module function get_character(self, key, mold) result(value_) implicit none class(string_t), intent(in) :: self, key diff --git a/src/julienne/julienne_string_s.f90 b/src/julienne/julienne_string_s.f90 index 0f3dfe32..c76a2330 100644 --- a/src/julienne/julienne_string_s.f90 +++ b/src/julienne/julienne_string_s.f90 @@ -241,6 +241,10 @@ value_ = self%get_real_array(string_t(key), mold) end procedure + module procedure get_double_precision_array_with_character_key + value_ = self%get_double_precision_array(string_t(key), mold) + end procedure + module procedure get_real_array character(len=:), allocatable :: raw_line real, allocatable :: real_array(:) @@ -265,6 +269,30 @@ end procedure + module procedure get_double_precision_array + character(len=:), allocatable :: raw_line + double precision, allocatable :: double_precision_array(:) + integer i + + call assert(key==self%get_json_key(), "string_s(get_{double precision,integer}_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(double_precision_array(num_inputs)) + read(raw_line(opening_bracket+1:closing_bracket-1), fmt=*) double_precision_array + value_ = double_precision_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 diff --git a/test/string_test.F90 b/test/string_test.F90 index a8bc10e0..55403121 100644 --- a/test/string_test.F90 +++ b/test/string_test.F90 @@ -63,6 +63,8 @@ function results() result(test_results) (string_t("extracting an integer array value from a colon-separated key/value pair"), extracts_integer_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 & + (string_t("extracting an double-precision array value from a colon-separated key/value pair"), extracts_dp_array_value), & test_description_t & (string_t("extracting an integer value from a colon-separated key/value pair"), extracts_integer_value), & test_description_t & @@ -77,7 +79,7 @@ function results() result(test_results) 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_double_precision_value_ptr, extracts_dp_array_value_ptr check_allocation_ptr => check_allocation supports_equivalence_ptr => supports_equivalence_operator @@ -96,6 +98,7 @@ function results() result(test_results) extracts_logical_ptr => extracts_logical_value extracts_integer_array_ptr => extracts_integer_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 extracts_file_base_ptr => extracts_file_base_name extracts_file_name_ptr => extracts_file_name_extension @@ -124,6 +127,8 @@ function results() result(test_results) string_t("extracting an integer array value from a colon-separated key/value pair"), extracts_integer_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( & + string_t("extracting an double-precision array value from a colon-separated key/value pair"), extracts_dp_array_value_ptr), & test_description_t(string_t("extracting an integer value from a colon-separated key/value pair"), extracts_integer_ptr), & test_description_t(string_t('extracting a file base name'), extracts_file_base_ptr), & test_description_t(string_t('extracting a file name extension'), extracts_file_name_ptr) & @@ -323,6 +328,26 @@ function extracts_real_array_value() result(passed) #endif end function + function extracts_dp_array_value() result(passed) + logical passed + +#ifndef _CRAYFTN + associate(key_dp_array_pair => string_t('"a key" : [1.D0, 2.D0, 4.D0],')) + associate(dp_array => key_dp_array_pair%get_json_value(key=string_t("a key"), mold=[double precision::])) + passed = all(dp_array == [1.D0, 2.D0, 4.D0]) + end associate + end associate +#else + block + type(string_t) key_dp_array_pair + double precision, allocatable :: dp_array(:) + key_dp_array_pair = string_t('"a key" : [1., 2., 4.],') + dp_array = key_dp_array_pair%get_json_value(key=string_t("a key"), mold=[double precision::]) + passed = all(dp_array == [1D0, 2D0, 4D0]) + end block +#endif + end function + function supports_equivalence_operator() result(passed) logical passed passed = &