From 40b2e21accea9f1af601b7687745ad4bf434ffad Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Tue, 13 Aug 2024 09:21:37 -0700 Subject: [PATCH 1/4] chore(test): add copyright to each test file --- test/bin_test.F90 | 2 ++ test/command_line_test.F90 | 2 ++ test/formats_test.F90 | 2 ++ test/main.F90 | 2 ++ test/string_test.F90 | 2 ++ test/test_description_test.F90 | 4 +++- test/test_result_test.F90 | 4 +++- test/vector_test_description_test.f90 | 4 +++- 8 files changed, 19 insertions(+), 3 deletions(-) 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..5c04eb4 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__ 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 From 14619bc4a5c6da69622853489805678374aa4ec4 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Tue, 13 Aug 2024 09:23:08 -0700 Subject: [PATCH 2/4] chore(example): add copyright to all example files --- example/check-command-line-argument.f90 | 2 ++ example/get-flag-value.f90 | 2 ++ example/handle-missing-flag.f90 | 2 ++ 3 files changed, 6 insertions(+) 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 !! From 39bfd64247d54cb4a3afcc42caf5fbcf0cc9f9cb Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Tue, 13 Aug 2024 09:42:53 -0700 Subject: [PATCH 3/4] feat(get_json_value): add character getters +tests --- src/julienne/julienne_string_m.f90 | 31 +++++++++++++++++++----------- src/julienne/julienne_string_s.f90 | 12 ++++++++++-- test/string_test.F90 | 29 +++++++++++++++++++++++++++- 3 files changed, 58 insertions(+), 14 deletions(-) diff --git a/src/julienne/julienne_string_m.f90 b/src/julienne/julienne_string_m.f90 index 59c7755..03397ba 100644 --- a/src/julienne/julienne_string_m.f90 +++ b/src/julienne/julienne_string_m.f90 @@ -23,22 +23,24 @@ 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_real, get_real_with_character_key & + ,get_string & + ,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 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, 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 +131,18 @@ 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_character(self, key, mold) result(value_) implicit none - class(string_t), intent(in) :: self, mold - character(len=*), intent(in) :: key - type(string_t) :: value_ + 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..46e5399 100644 --- a/src/julienne/julienne_string_s.f90 +++ b/src/julienne/julienne_string_s.f90 @@ -125,8 +125,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/string_test.F90 b/test/string_test.F90 index 5c04eb4..8bf0fdd 100644 --- a/test/string_test.F90 +++ b/test/string_test.F90 @@ -53,6 +53,8 @@ function results() result(test_results) (string_t("extracting a real value from a colon-separated key/value pair"), extracts_real_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 & @@ -72,7 +74,7 @@ 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 check_allocation_ptr => check_allocation supports_equivalence_ptr => supports_equivalence_operator @@ -86,6 +88,7 @@ function results() result(test_results) extracts_key_ptr => extracts_key extracts_real_ptr => extracts_real_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 @@ -109,6 +112,7 @@ function results() result(test_results) 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 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), & @@ -167,6 +171,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 From ed57123b43b96d50a773a82236652dfdb1add8aa Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sat, 31 Aug 2024 23:24:38 -0700 Subject: [PATCH 4/4] feat(string_t):extract double-precision JSON value --- src/julienne/julienne_string_m.f90 | 23 ++++++++++++++++++++--- src/julienne/julienne_string_s.f90 | 23 +++++++++++++++++++++++ test/string_test.F90 | 24 +++++++++++++++++++++++- 3 files changed, 66 insertions(+), 4 deletions(-) diff --git a/src/julienne/julienne_string_m.f90 b/src/julienne/julienne_string_m.f90 index 03397ba..9025a07 100644 --- a/src/julienne/julienne_string_m.f90 +++ b/src/julienne/julienne_string_m.f90 @@ -23,13 +23,14 @@ 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 & + 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 procedure, private :: get_logical, get_logical_with_character_key @@ -37,6 +38,7 @@ 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 :: 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 @@ -131,6 +133,21 @@ pure module function get_real_with_character_key(self, key, mold) result(value_) real value_ end function + pure module function get_double_precision(self, key, mold) result(value_) + implicit none + 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 + 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 diff --git a/src/julienne/julienne_string_s.f90 b/src/julienne/julienne_string_s.f90 index 46e5399..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, ',')) diff --git a/test/string_test.F90 b/test/string_test.F90 index 8bf0fdd..a8bc10e 100644 --- a/test/string_test.F90 +++ b/test/string_test.F90 @@ -51,6 +51,8 @@ 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 & @@ -74,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_character_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 @@ -87,6 +90,7 @@ 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 @@ -111,6 +115,8 @@ 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), & @@ -155,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