diff --git a/example/check-command-line-argument.f90 b/example/check-command-line-argument.f90 index 7cd7d4a..73e13ba 100644 --- a/example/check-command-line-argument.f90 +++ b/example/check-command-line-argument.f90 @@ -1,3 +1,5 @@ +! Copyright (c) 2024, The Regents of the University of California and Sourcery Institute +! Terms of use are as specified in LICENSE.txt program check_command_line_argument !! This program serves the dual purposes of !! 1. Showing how to use the command_line_t derived type to check whether a diff --git a/example/get-flag-value.f90 b/example/get-flag-value.f90 index a22b02c..6d3ec7e 100644 --- a/example/get-flag-value.f90 +++ b/example/get-flag-value.f90 @@ -1,3 +1,5 @@ +! Copyright (c) 2024, The Regents of the University of California and Sourcery Institute +! Terms of use are as specified in LICENSE.txt program get_flag_value !! Demonstrate how to find the value of a command-line flag !! Running this program as follows with the command diff --git a/example/handle-missing-flag.f90 b/example/handle-missing-flag.f90 index 413508e..7a6292a 100644 --- a/example/handle-missing-flag.f90 +++ b/example/handle-missing-flag.f90 @@ -1,3 +1,5 @@ +! Copyright (c) 2024, The Regents of the University of California and Sourcery Institute +! Terms of use are as specified in LICENSE.txt program handle_missing_flag !! This program serves the dual purposes of !! diff --git a/src/julienne/julienne_string_m.f90 b/src/julienne/julienne_string_m.f90 index 59c7755..9025a07 100644 --- a/src/julienne/julienne_string_m.f90 +++ b/src/julienne/julienne_string_m.f90 @@ -23,22 +23,26 @@ 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_real, get_real_with_character_key & - ,get_string, get_string_with_character_key & + generic :: get_json_value => get_string & + ,get_real, get_real_with_character_key & + ,get_character, get_character_with_character_key & ,get_logical, get_logical_with_character_key & ,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_integer, get_integer_with_character_key & + ,get_double_precision, get_double_precision_with_character_key procedure, private :: get_real, get_real_with_character_key - procedure, private :: get_string, get_string_with_character_key + procedure, private :: get_string 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 procedure, private :: get_integer_array, get_integer_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 - procedure, private :: string_t_cat_string_t, string_t_cat_character + procedure, private :: get_character, get_character_with_character_key + procedure :: get_double_precision, get_double_precision_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 + procedure, private :: string_t_cat_string_t, string_t_cat_character procedure, private, pass(rhs) :: character_cat_string_t procedure, private, pass(rhs) :: character_ne_string_t procedure, private, pass(rhs) :: character_eq_string_t @@ -129,11 +133,33 @@ pure module function get_real_with_character_key(self, key, mold) result(value_) real value_ end function - elemental module function get_string_with_character_key(self, key, mold) result(value_) + pure module function get_double_precision(self, key, mold) result(value_) implicit none - class(string_t), intent(in) :: self, mold + class(string_t), intent(in) :: self, key + double precision, intent(in) :: mold + double precision value_ + end function + + pure module function get_double_precision_with_character_key(self, key, mold) result(value_) + implicit none + class(string_t), intent(in) :: self character(len=*), intent(in) :: key - type(string_t) :: value_ + double precision, intent(in) :: mold + double precision value_ + end function + + pure module function get_character(self, key, mold) result(value_) + implicit none + class(string_t), intent(in) :: self, key + character(len=*), intent(in) :: mold + character(len=:), allocatable :: value_ + end function + + pure module function get_character_with_character_key(self, key, mold) result(value_) + implicit none + class(string_t), intent(in) :: self + character(len=*), intent(in) :: key, mold + character(len=:), allocatable :: value_ end function elemental module function get_string(self, key, mold) result(value_) diff --git a/src/julienne/julienne_string_s.f90 b/src/julienne/julienne_string_s.f90 index ad17709..0f3dfe3 100644 --- a/src/julienne/julienne_string_s.f90 +++ b/src/julienne/julienne_string_s.f90 @@ -106,11 +106,34 @@ value_ = self%get_real(string_t(key), mold) end procedure + module procedure get_double_precision_with_character_key + value_ = self%get_double_precision(string_t(key), mold) + end procedure + module procedure get_real character(len=:), allocatable :: raw_line, string_value call assert(key==self%get_json_key(), "string_s(get_real): key==self%get_json_key()", key) + raw_line = self%string() + associate(text_after_colon => raw_line(index(raw_line, ':')+1:)) + associate(trailing_comma => index(text_after_colon, ',')) + if (trailing_comma == 0) then + string_value = trim(adjustl((text_after_colon))) + else + string_value = trim(adjustl((text_after_colon(:trailing_comma-1)))) + end if + read(string_value, fmt=*) value_ + end associate + end associate + + end procedure + + module procedure get_double_precision + character(len=:), allocatable :: raw_line, string_value + + call assert(key==self%get_json_key(), "string_s(get_double_precision): key==self%get_json_key()", key) + raw_line = self%string() associate(text_after_colon => raw_line(index(raw_line, ':')+1:)) associate(trailing_comma => index(text_after_colon, ',')) @@ -125,8 +148,16 @@ end procedure - module procedure get_string_with_character_key - value_ = self%get_string(string_t(key), mold) + module procedure get_character + associate(string_value => self%get_string(key, string_t(mold))) + value_ = string_value%string() + end associate + end procedure + + module procedure get_character_with_character_key + associate(string_value => self%get_string(string_t(key), string_t(mold))) + value_ = string_value%string() + end associate end procedure module procedure get_string diff --git a/test/bin_test.F90 b/test/bin_test.F90 index d1826f8..8b81787 100644 --- a/test/bin_test.F90 +++ b/test/bin_test.F90 @@ -1,3 +1,5 @@ +! Copyright (c) 2024, The Regents of the University of California and Sourcery Institute +! Terms of use are as specified in LICENSE.txt module bin_test_m !! Check data partitioning across bins use julienne_m, only : bin_t, test_t, test_result_t, test_description_t, test_description_substring, string_t diff --git a/test/command_line_test.F90 b/test/command_line_test.F90 index 51cde1e..0922cfd 100644 --- a/test/command_line_test.F90 +++ b/test/command_line_test.F90 @@ -1,3 +1,5 @@ +! Copyright (c) 2024, The Regents of the University of California and Sourcery Institute +! Terms of use are as specified in LICENSE.txt module command_line_test_m !! Verify object pattern asbtract parent use julienne_m, only : test_t, test_result_t, command_line_t, test_description_substring, string_t, test_description_t diff --git a/test/formats_test.F90 b/test/formats_test.F90 index 7a10c4b..5f307ef 100644 --- a/test/formats_test.F90 +++ b/test/formats_test.F90 @@ -1,3 +1,5 @@ +! Copyright (c) 2024, The Regents of the University of California and Sourcery Institute +! Terms of use are as specified in LICENSE.txt module formats_test_m !! Verify that format strings provide the desired formatting use julienne_m, only : separated_values, test_t, test_result_t, test_description_t, test_description_substring, string_t diff --git a/test/main.F90 b/test/main.F90 index 0350d95..886a8b4 100644 --- a/test/main.F90 +++ b/test/main.F90 @@ -1,3 +1,5 @@ +! Copyright (c) 2024, The Regents of the University of California and Sourcery Institute +! Terms of use are as specified in LICENSE.txt program main use bin_test_m, only : bin_test_t use command_line_test_m, only : command_line_test_t diff --git a/test/string_test.F90 b/test/string_test.F90 index 92e3d4d..a8bc10e 100644 --- a/test/string_test.F90 +++ b/test/string_test.F90 @@ -1,3 +1,5 @@ +! Copyright (c) 2024, The Regents of the University of California and Sourcery Institute +! Terms of use are as specified in LICENSE.txt module string_test_m use julienne_m, only : test_t, test_result_t, string_t, operator(.cat.), test_description_t, test_description_substring #ifdef __GFORTRAN__ @@ -49,8 +51,12 @@ function results() result(test_results) (string_t("extracting a key string from a colon-separated key/value pair"), extracts_key), & test_description_t & (string_t("extracting a real value from a colon-separated key/value pair"), extracts_real_value), & + test_description_t & + (string_t("extracting a double-precision value from a colon-separated key/value pair"), extracts_double_precision_value), & test_description_t & (string_t("extracting a string value from a colon-separated key/value pair"), extracts_string_value), & + test_description_t & + (string_t("extracting a string value from a colon-separated key/value pair"), extracts_character_value), & test_description_t & (string_t("extracting a logical value from a colon-separated key/value pair"), extracts_logical_value), & test_description_t & @@ -70,7 +76,8 @@ 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_real_array_ptr, extracts_integer_ptr, extracts_file_base_ptr, extracts_file_name_ptr, extracts_character_ptr, & + extracts_double_precision_value_ptr check_allocation_ptr => check_allocation supports_equivalence_ptr => supports_equivalence_operator @@ -83,7 +90,9 @@ function results() result(test_results) concatenates_ptr => concatenates_elements extracts_key_ptr => extracts_key extracts_real_ptr => extracts_real_value + extracts_double_precision_value_ptr => extracts_double_precision_value extracts_string_ptr => extracts_string_value + extracts_character_ptr => extracts_character_value extracts_logical_ptr => extracts_logical_value extracts_integer_array_ptr => extracts_integer_array_value extracts_real_array_ptr => extracts_real_array_value @@ -106,7 +115,10 @@ function results() result(test_results) test_description_t(string_t('supporting unary operator(.cat.) for array arguments'), concatenates_ptr), & test_description_t(string_t("extracting a key string from a colon-separated key/value pair"), extracts_key_ptr), & test_description_t(string_t("extracting a real value from a colon-separated key/value pair"), extracts_real_ptr), & + test_description_t( & + string_t("extracting a double-precision value from a colon-separated key/value pair"), extracts_double_precision_value_ptr),& test_description_t(string_t("extracting a string value from a colon-separated key/value pair"), extracts_string_ptr), & + test_description_t(string_t("extracting a character value from a colon-separated key/value pair"), extracts_character_ptr), & 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), & @@ -149,6 +161,22 @@ function extracts_key() result(passed) #endif end function + function extracts_double_precision_value() result(passed) + logical passed + +#ifndef _CRAYFTN + associate(line => string_t('"pi" : 3.141592653589793D0')) + passed = line%get_json_value(key="pi", mold=0.D0) == 3.141592653589793D0 + end associate +#else + block + type(string_t) line + line = string_t('"pi" : 3.141592653589793D0') + passed = line%get_json_value(key="pi", mold=0.D0) == 3.141592653589793D0 + end block +#endif + end function + function extracts_real_value() result(passed) logical passed @@ -165,6 +193,29 @@ function extracts_real_value() result(passed) #endif end function + function extracts_character_value() result(passed) + logical passed + +#ifndef _CRAYFTN + associate(line => string_t('"foo" : "bar"'), line_with_comma => string_t('"foo" : "bar",')) + passed = line%get_json_value(key=string_t("foo"), mold="") == "bar" .and. & + line%get_json_value(key="foo" , mold="") == "bar" .and. & + line_with_comma%get_json_value(key=string_t("foo"), mold="") == "bar" .and. & + line_with_comma%get_json_value(key="foo" , mold="") == "bar" + end associate +#else + block + type(string_t) line, line_with_comma + line = string_t('"foo" : "bar"') + line_with_comma = string_t('"foo" : "bar",') + passed = line%get_json_value(key=string_t("foo"), mold="") == "bar" .and. & + line%get_json_value(key="foo" , mold="") == "bar" .and. & + line_with_comma%get_json_value(key=string_t("foo"), mold="") == "bar" .and. & + line_with_comma%get_json_value(key="foo" , mold="") == "bar" + end block +#endif + end function + function extracts_string_value() result(passed) logical passed diff --git a/test/test_description_test.F90 b/test/test_description_test.F90 index 518f326..0e17194 100644 --- a/test/test_description_test.F90 +++ b/test/test_description_test.F90 @@ -1,3 +1,5 @@ +! Copyright (c) 2024, The Regents of the University of California and Sourcery Institute +! Terms of use are as specified in LICENSE.txt module test_description_test_m !! Verify test_description_t object behavior use julienne_m, only : string_t, test_result_t, test_description_t, test_t, test_description_substring @@ -62,4 +64,4 @@ logical function tautology() end function end function -end module test_description_test_m \ No newline at end of file +end module test_description_test_m diff --git a/test/test_result_test.F90 b/test/test_result_test.F90 index 17d4b61..fc68299 100644 --- a/test/test_result_test.F90 +++ b/test/test_result_test.F90 @@ -1,3 +1,5 @@ +! Copyright (c) 2024, The Regents of the University of California and Sourcery Institute +! Terms of use are as specified in LICENSE.txt module test_result_test_m !! Verify test_result_t object behavior use julienne_m, only : string_t, test_result_t, test_description_t, test_t, test_description_substring @@ -72,4 +74,4 @@ function check_single_image_failure() result(passed) passed = .not. test_result%passed() end function -end module test_result_test_m \ No newline at end of file +end module test_result_test_m diff --git a/test/vector_test_description_test.f90 b/test/vector_test_description_test.f90 index 9ba2a4d..4b1daa4 100644 --- a/test/vector_test_description_test.f90 +++ b/test/vector_test_description_test.f90 @@ -1,3 +1,5 @@ +! Copyright (c) 2024, The Regents of the University of California and Sourcery Institute +! Terms of use are as specified in LICENSE.txt module vector_test_description_test_m !! Verify vector_test_description_t object behavior use julienne_m, only : & @@ -52,4 +54,4 @@ function results() result(test_results) end associate end function -end module vector_test_description_test_m \ No newline at end of file +end module vector_test_description_test_m