From 46a68affefaca469b3ce27597f99fc4a8c9e9d26 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Fri, 27 Oct 2023 07:54:08 -0700 Subject: [PATCH 1/9] feat(string): add functions to get key/value pairs --- src/sourcery/sourcery_string_m.f90 | 23 ++++++++++++++++++ src/sourcery/sourcery_string_s.f90 | 38 ++++++++++++++++++++++++++++++ test/string_test.f90 | 20 +++++++++++++++- 3 files changed, 80 insertions(+), 1 deletion(-) diff --git a/src/sourcery/sourcery_string_m.f90 b/src/sourcery/sourcery_string_m.f90 index 34c4ab9d..ce1977a0 100644 --- a/src/sourcery/sourcery_string_m.f90 +++ b/src/sourcery/sourcery_string_m.f90 @@ -11,6 +11,11 @@ module sourcery_string_m contains procedure :: string procedure :: is_allocated + procedure :: get_json_key + procedure :: get_json_string_scalar_value + generic :: get_json_value => get_json_string_scalar_value + procedure :: equivalent + generic :: operator(==) => equivalent end type interface string_t @@ -43,6 +48,24 @@ elemental module function is_allocated(self) result(string_allocated) logical string_allocated end function + elemental module function get_json_key(self) result(unquoted_key) + implicit none + class(string_t), intent(in) :: self + type(string_t) unquoted_key + end function + + elemental module function get_json_string_scalar_value(self, key, mold) result(value_) + implicit none + class(string_t), intent(in) :: self, key, mold + type(string_t) :: value_ + end function + + elemental module function equivalent(lhs, rhs) result(lhs_eqv_rhs) + implicit none + class(string_t), intent(in) :: lhs, rhs + logical lhs_eqv_rhs + end function + end interface end module sourcery_string_m diff --git a/src/sourcery/sourcery_string_s.f90 b/src/sourcery/sourcery_string_s.f90 index dc7dcfc2..5d9ef05f 100644 --- a/src/sourcery/sourcery_string_s.f90 +++ b/src/sourcery/sourcery_string_s.f90 @@ -1,4 +1,5 @@ submodule(sourcery_string_m) sourcery_string_s + use assert_m, only : assert implicit none contains @@ -37,4 +38,41 @@ end procedure + module procedure get_json_key + character(len=:), allocatable :: raw_line + + raw_line = self%string() + associate(opening_key_quotes => index(raw_line, '"'), separator => index(raw_line, ':')) + associate(closing_key_quotes => opening_key_quotes + index(raw_line(opening_key_quotes+1:), '"')) + unquoted_key = string_t(trim(raw_line(opening_key_quotes+1:closing_key_quotes-1))) + end associate + end associate + + end procedure + + module procedure get_json_string_scalar_value + + character(len=:), allocatable :: raw_line + + call assert(key==self%get_json_key(), "key==self%get_json_key()", key%string()) + + raw_line = self%string() + associate(text_after_colon => raw_line(index(raw_line, ':')+1:)) + associate(opening_value_quotes => index(text_after_colon, '"')) + associate(closing_value_quotes => opening_value_quotes + index(text_after_colon(opening_value_quotes+1:), '"')) + if (any([opening_value_quotes, closing_value_quotes] == 0)) then + value_ = string_t(trim(adjustl((text_after_colon)))) + else + value_ = string_t(text_after_colon(opening_value_quotes+1:closing_value_quotes-1)) + end if + end associate + end associate + end associate + + end procedure + + module procedure equivalent + lhs_eqv_rhs = lhs%string() == rhs%string() + end procedure + end submodule sourcery_string_s diff --git a/test/string_test.f90 b/test/string_test.f90 index 0d78037e..1f62e367 100644 --- a/test/string_test.f90 +++ b/test/string_test.f90 @@ -22,7 +22,9 @@ function results() result(test_results) type(test_result_t), allocatable :: test_results(:) test_results = [ & - test_result_t("is_allocated() result .true. if & only if the string_t component(s) is/are allocated", check_allocation()) & + test_result_t("is_allocated() result .true. if & only if the string_t component(s) is/are allocated", check_allocation()), & + test_result_t("extracting key string from colon-separated key/value pair", extracts_key()), & + test_result_t("extracting string value from colon-separated key/value pair", extracts_string_scalar_value()) & ] end function @@ -36,4 +38,20 @@ pure function check_allocation() result(passed) (all([scalar_allocated%is_allocated(), array_allocated%is_allocated()])) end function + function extracts_key() result(passed) + logical passed + + associate(line => string_t('"foo" : "bar"')) + passed = line%get_json_key() == string_t("foo") + end associate + end function + + function extracts_string_scalar_value() result(passed) + logical passed + + associate(line => string_t('"foo" : "bar"')) + passed = line%get_json_value(key=string_t("foo"), mold=string_t("")) == string_t("bar") + end associate + end function + end module string_test_m From 77b9a26a57905753b6c648b4038ebb55dff6623f Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sat, 28 Oct 2023 14:10:04 -0700 Subject: [PATCH 2/9] feat(string): string_t extends characterizable_t This enables string_t objects to be passed as the diagnostic_data argument in calls to the assert utility. --- src/sourcery/sourcery_string_m.f90 | 10 ++++++---- src/sourcery/sourcery_string_s.f90 | 4 ++-- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/src/sourcery/sourcery_string_m.f90 b/src/sourcery/sourcery_string_m.f90 index ce1977a0..77471280 100644 --- a/src/sourcery/sourcery_string_m.f90 +++ b/src/sourcery/sourcery_string_m.f90 @@ -1,15 +1,17 @@ module sourcery_string_m + use assert_m, only : characterizable_t implicit none private public :: string_t public :: array_of_strings - type string_t + type, extends(characterizable_t) :: string_t private character(len=:), allocatable :: string_ contains - procedure :: string + procedure :: as_character + generic :: string => as_character procedure :: is_allocated procedure :: get_json_key procedure :: get_json_string_scalar_value @@ -30,7 +32,7 @@ elemental module function construct(string) result(new_string) interface - pure module function string(self) result(raw_string) + pure module function as_character(self) result(raw_string) implicit none class(string_t), intent(in) :: self character(len=:), allocatable :: raw_string @@ -49,7 +51,7 @@ elemental module function is_allocated(self) result(string_allocated) end function elemental module function get_json_key(self) result(unquoted_key) - implicit none + implicit none class(string_t), intent(in) :: self type(string_t) unquoted_key end function diff --git a/src/sourcery/sourcery_string_s.f90 b/src/sourcery/sourcery_string_s.f90 index 5d9ef05f..21df2172 100644 --- a/src/sourcery/sourcery_string_s.f90 +++ b/src/sourcery/sourcery_string_s.f90 @@ -8,7 +8,7 @@ new_string%string_ = string end procedure - module procedure string + module procedure as_character raw_string = self%string_ end procedure @@ -54,7 +54,7 @@ character(len=:), allocatable :: raw_line - call assert(key==self%get_json_key(), "key==self%get_json_key()", key%string()) + call assert(key==self%get_json_key(), "key==self%get_json_key()", key) raw_line = self%string() associate(text_after_colon => raw_line(index(raw_line, ':')+1:)) From 81631db4304ccc66b4625e2c721ef6cd1b1d632d Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sat, 28 Oct 2023 14:20:22 -0700 Subject: [PATCH 3/9] refac(get_json_value): whitespace edits --- src/sourcery/sourcery_string_s.f90 | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/src/sourcery/sourcery_string_s.f90 b/src/sourcery/sourcery_string_s.f90 index 21df2172..7a9f7e07 100644 --- a/src/sourcery/sourcery_string_s.f90 +++ b/src/sourcery/sourcery_string_s.f90 @@ -52,22 +52,22 @@ module procedure get_json_string_scalar_value - character(len=:), allocatable :: raw_line + character(len=:), allocatable :: raw_line - call assert(key==self%get_json_key(), "key==self%get_json_key()", key) + call assert(key==self%get_json_key(), "key==self%get_json_key()", key) - raw_line = self%string() - associate(text_after_colon => raw_line(index(raw_line, ':')+1:)) - associate(opening_value_quotes => index(text_after_colon, '"')) - associate(closing_value_quotes => opening_value_quotes + index(text_after_colon(opening_value_quotes+1:), '"')) - if (any([opening_value_quotes, closing_value_quotes] == 0)) then - value_ = string_t(trim(adjustl((text_after_colon)))) - else - value_ = string_t(text_after_colon(opening_value_quotes+1:closing_value_quotes-1)) - end if - end associate - end associate - end associate + raw_line = self%string() + associate(text_after_colon => raw_line(index(raw_line, ':')+1:)) + associate(opening_value_quotes => index(text_after_colon, '"')) + associate(closing_value_quotes => opening_value_quotes + index(text_after_colon(opening_value_quotes+1:), '"')) + if (any([opening_value_quotes, closing_value_quotes] == 0)) then + value_ = string_t(trim(adjustl((text_after_colon)))) + else + value_ = string_t(text_after_colon(opening_value_quotes+1:closing_value_quotes-1)) + end if + end associate + end associate + end associate end procedure From 4107d0dde7047ce5b298fecc542519d568892b2a Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sat, 28 Oct 2023 17:15:21 -0700 Subject: [PATCH 4/9] feat(string_t): get_json_value logical mold/result --- src/sourcery/sourcery_string_m.f90 | 11 ++++++++++- src/sourcery/sourcery_string_s.f90 | 23 ++++++++++++++++++++++- test/string_test.f90 | 22 +++++++++++++++++++++- 3 files changed, 53 insertions(+), 3 deletions(-) diff --git a/src/sourcery/sourcery_string_m.f90 b/src/sourcery/sourcery_string_m.f90 index 77471280..967ffe42 100644 --- a/src/sourcery/sourcery_string_m.f90 +++ b/src/sourcery/sourcery_string_m.f90 @@ -15,7 +15,9 @@ module sourcery_string_m procedure :: is_allocated procedure :: get_json_key procedure :: get_json_string_scalar_value - generic :: get_json_value => get_json_string_scalar_value + procedure :: get_json_logical_scalar_value + generic :: get_json_value => & + get_json_string_scalar_value, get_json_logical_scalar_value procedure :: equivalent generic :: operator(==) => equivalent end type @@ -62,6 +64,13 @@ elemental module function get_json_string_scalar_value(self, key, mold) result(v type(string_t) :: value_ end function + elemental module function get_json_logical_scalar_value(self, key, mold) result(value_) + implicit none + class(string_t), intent(in) :: self, key + logical, intent(in) :: mold + logical value_ + end function + elemental module function equivalent(lhs, rhs) result(lhs_eqv_rhs) implicit none class(string_t), intent(in) :: lhs, rhs diff --git a/src/sourcery/sourcery_string_s.f90 b/src/sourcery/sourcery_string_s.f90 index 7a9f7e07..15e5f81b 100644 --- a/src/sourcery/sourcery_string_s.f90 +++ b/src/sourcery/sourcery_string_s.f90 @@ -54,7 +54,7 @@ character(len=:), allocatable :: raw_line - call assert(key==self%get_json_key(), "key==self%get_json_key()", key) + call assert(key==self%get_json_key(), "key==self%get_string_scalar_json_value()", key) raw_line = self%string() associate(text_after_colon => raw_line(index(raw_line, ':')+1:)) @@ -71,6 +71,27 @@ end procedure + module procedure get_json_logical_scalar_value + character(len=:), allocatable :: raw_line, string_value + + call assert(key==self%get_json_key(), "get_json_logical_scalar_value: key==self%get_json_key()", key) + + raw_line = self%string() + associate(text_after_colon => raw_line(index(raw_line, ':')+1:)) + associate(comma => index(text_after_colon, ',')) + if (comma == 0) then + string_value = trim(adjustl((text_after_colon))) + else + string_value = trim(adjustl((text_after_colon(:comma-1)))) + end if + call assert(string_value=="true" .or. string_value=="false", & + 'get_json_logical_scalar_value: string_value=="true" .or. string_value="false"', string_value) + value_ = string_value == "true" + end associate + end associate + + end procedure + module procedure equivalent lhs_eqv_rhs = lhs%string() == rhs%string() end procedure diff --git a/test/string_test.f90 b/test/string_test.f90 index 1f62e367..4b01e5b1 100644 --- a/test/string_test.f90 +++ b/test/string_test.f90 @@ -2,6 +2,7 @@ module string_test_m use sourcery_m, only : test_t, test_result_t, string_t implicit none + private public :: string_test_t @@ -24,7 +25,8 @@ function results() result(test_results) test_results = [ & test_result_t("is_allocated() result .true. if & only if the string_t component(s) is/are allocated", check_allocation()), & test_result_t("extracting key string from colon-separated key/value pair", extracts_key()), & - test_result_t("extracting string value from colon-separated key/value pair", extracts_string_scalar_value()) & + test_result_t("extracting string value from colon-separated key/value pair", extracts_string_scalar_value()), & + test_result_t("extracting logical value from colon-separated key/value pair", extracts_logical_scalar_value()) & ] end function @@ -54,4 +56,22 @@ function extracts_string_scalar_value() result(passed) end associate end function + function extracts_logical_scalar_value() result(passed) + logical passed + + associate( & + key_true_pair => string_t('"yada yada" : true'), & + key_false_pair => string_t('"blah blah" : false'), & + trailing_comma => string_t('"trailing comma" : true,') & + ) + associate( & + true => key_true_pair%get_json_value(key=string_t("yada yada"), mold=.true.), & + false => key_false_pair%get_json_value(key=string_t("blah blah"), mold=.true.), & + true_too => trailing_comma%get_json_value(key=string_t("trailing comma"), mold=.true.) & + ) + passed = true .and. true_too .and. .not. false + end associate + end associate + end function + end module string_test_m From ef0d03acaabff80cc84307015e61a8d8f17ebfd3 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sat, 28 Oct 2023 18:38:40 -0700 Subject: [PATCH 5/9] feat(string): get_json_value int array mold/result --- src/sourcery/sourcery_string_m.f90 | 10 +++++++++- src/sourcery/sourcery_string_s.f90 | 29 +++++++++++++++++++++++++++-- test/string_test.f90 | 17 ++++++++++++++--- 3 files changed, 50 insertions(+), 6 deletions(-) diff --git a/src/sourcery/sourcery_string_m.f90 b/src/sourcery/sourcery_string_m.f90 index 967ffe42..47866a84 100644 --- a/src/sourcery/sourcery_string_m.f90 +++ b/src/sourcery/sourcery_string_m.f90 @@ -16,8 +16,9 @@ module sourcery_string_m procedure :: get_json_key procedure :: get_json_string_scalar_value procedure :: get_json_logical_scalar_value + procedure :: get_json_integer_array_value generic :: get_json_value => & - get_json_string_scalar_value, get_json_logical_scalar_value + get_json_string_scalar_value, get_json_logical_scalar_value, get_json_integer_array_value procedure :: equivalent generic :: operator(==) => equivalent end type @@ -71,6 +72,13 @@ elemental module function get_json_logical_scalar_value(self, key, mold) result( logical value_ end function + pure module function get_json_integer_array_value(self, key, mold) result(value_) + implicit none + class(string_t), intent(in) :: self, key + integer, intent(in) :: mold(:) + integer, allocatable :: value_(:) + end function + elemental module function equivalent(lhs, rhs) result(lhs_eqv_rhs) implicit none class(string_t), intent(in) :: lhs, rhs diff --git a/src/sourcery/sourcery_string_s.f90 b/src/sourcery/sourcery_string_s.f90 index 15e5f81b..4b764a32 100644 --- a/src/sourcery/sourcery_string_s.f90 +++ b/src/sourcery/sourcery_string_s.f90 @@ -1,5 +1,6 @@ submodule(sourcery_string_m) sourcery_string_s use assert_m, only : assert + use sourcery_m, only : csv implicit none contains @@ -74,7 +75,7 @@ module procedure get_json_logical_scalar_value character(len=:), allocatable :: raw_line, string_value - call assert(key==self%get_json_key(), "get_json_logical_scalar_value: key==self%get_json_key()", key) + call assert(key==self%get_json_key(), "string_s(get_json_logical_scalar_value): key==self%get_json_key()", key) raw_line = self%string() associate(text_after_colon => raw_line(index(raw_line, ':')+1:)) @@ -85,13 +86,37 @@ string_value = trim(adjustl((text_after_colon(:comma-1)))) end if call assert(string_value=="true" .or. string_value=="false", & - 'get_json_logical_scalar_value: string_value=="true" .or. string_value="false"', string_value) + 'string_s(get_json_logical_scalar_value): string_value=="true" .or. string_value="false"', string_value) value_ = string_value == "true" end associate end associate end procedure + module procedure get_json_integer_array_value + character(len=:), allocatable :: raw_line + real, allocatable :: real_array(:) + integer i + + call assert(key==self%get_json_key(), "string_s(get_json_integer_array_value): 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 equivalent lhs_eqv_rhs = lhs%string() == rhs%string() end procedure diff --git a/test/string_test.f90 b/test/string_test.f90 index 4b01e5b1..76a516ce 100644 --- a/test/string_test.f90 +++ b/test/string_test.f90 @@ -24,9 +24,10 @@ function results() result(test_results) test_results = [ & test_result_t("is_allocated() result .true. if & only if the string_t component(s) is/are allocated", check_allocation()), & - test_result_t("extracting key string from colon-separated key/value pair", extracts_key()), & - test_result_t("extracting string value from colon-separated key/value pair", extracts_string_scalar_value()), & - test_result_t("extracting logical value from colon-separated key/value pair", extracts_logical_scalar_value()) & + test_result_t("extracting a key string from colon-separated key/value pair", extracts_key()), & + test_result_t("extracting a string value from colon-separated key/value pair", extracts_string_scalar_value()), & + test_result_t("extracting a logical value from colon-separated key/value pair", extracts_logical_scalar_value()), & + test_result_t("extracting an integer array value from colon-separated key/value pair", extracts_integer_array_value()) & ] end function @@ -74,4 +75,14 @@ function extracts_logical_scalar_value() result(passed) end associate end function + function extracts_integer_array_value() result(passed) + logical passed + + associate(key_integer_array_pair => string_t('"some key" : [1, 2, 3],')) + associate(integer_array => key_integer_array_pair%get_json_value(key=string_t("some key"), mold=[integer::])) + passed = all(integer_array == [1, 2, 3]) + end associate + end associate + end function + end module string_test_m From 3b1d30e9e120459b771273e070ddc2f2111c5493 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sat, 28 Oct 2023 19:16:18 -0700 Subject: [PATCH 6/9] feat(string): get_json_value integer mold/result --- src/sourcery/sourcery_string_m.f90 | 18 +++++++++++---- src/sourcery/sourcery_string_s.f90 | 37 ++++++++++++++++++++++-------- test/string_test.f90 | 21 ++++++++++++----- 3 files changed, 56 insertions(+), 20 deletions(-) diff --git a/src/sourcery/sourcery_string_m.f90 b/src/sourcery/sourcery_string_m.f90 index 47866a84..96c9ff1d 100644 --- a/src/sourcery/sourcery_string_m.f90 +++ b/src/sourcery/sourcery_string_m.f90 @@ -14,11 +14,12 @@ module sourcery_string_m generic :: string => as_character procedure :: is_allocated procedure :: get_json_key - procedure :: get_json_string_scalar_value - procedure :: get_json_logical_scalar_value + procedure :: get_json_string_value + procedure :: get_json_logical_value + procedure :: get_json_integer_value procedure :: get_json_integer_array_value generic :: get_json_value => & - get_json_string_scalar_value, get_json_logical_scalar_value, get_json_integer_array_value + get_json_string_value, get_json_logical_value, get_json_integer_array_value, get_json_integer_value procedure :: equivalent generic :: operator(==) => equivalent end type @@ -59,13 +60,20 @@ elemental module function get_json_key(self) result(unquoted_key) type(string_t) unquoted_key end function - elemental module function get_json_string_scalar_value(self, key, mold) result(value_) + elemental module function get_json_string_value(self, key, mold) result(value_) implicit none class(string_t), intent(in) :: self, key, mold type(string_t) :: value_ end function - elemental module function get_json_logical_scalar_value(self, key, mold) result(value_) + elemental module function get_json_integer_value(self, key, mold) result(value_) + implicit none + class(string_t), intent(in) :: self, key + integer, intent(in) :: mold + integer value_ + end function + + elemental module function get_json_logical_value(self, key, mold) result(value_) implicit none class(string_t), intent(in) :: self, key logical, intent(in) :: mold diff --git a/src/sourcery/sourcery_string_s.f90 b/src/sourcery/sourcery_string_s.f90 index 4b764a32..4c412c8c 100644 --- a/src/sourcery/sourcery_string_s.f90 +++ b/src/sourcery/sourcery_string_s.f90 @@ -51,11 +51,11 @@ end procedure - module procedure get_json_string_scalar_value + module procedure get_json_string_value character(len=:), allocatable :: raw_line - call assert(key==self%get_json_key(), "key==self%get_string_scalar_json_value()", key) + call assert(key==self%get_json_key(), "key==self%get_string_json_value()", key) raw_line = self%string() associate(text_after_colon => raw_line(index(raw_line, ':')+1:)) @@ -72,27 +72,46 @@ end procedure - module procedure get_json_logical_scalar_value + module procedure get_json_logical_value character(len=:), allocatable :: raw_line, string_value - call assert(key==self%get_json_key(), "string_s(get_json_logical_scalar_value): key==self%get_json_key()", key) + call assert(key==self%get_json_key(), "string_s(get_json_logical_value): key==self%get_json_key()", key) raw_line = self%string() associate(text_after_colon => raw_line(index(raw_line, ':')+1:)) - associate(comma => index(text_after_colon, ',')) - if (comma == 0) then + 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(:comma-1)))) + string_value = trim(adjustl((text_after_colon(:trailing_comma-1)))) end if call assert(string_value=="true" .or. string_value=="false", & - 'string_s(get_json_logical_scalar_value): string_value=="true" .or. string_value="false"', string_value) + 'string_s(get_json_logical_value): string_value=="true" .or. string_value="false"', string_value) value_ = string_value == "true" end associate end associate end procedure + module procedure get_json_integer_value + character(len=:), allocatable :: raw_line, string_value + + call assert(key==self%get_json_key(), "string_s(get_json_logical_value): 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_json_integer_array_value character(len=:), allocatable :: raw_line real, allocatable :: real_array(:) @@ -108,7 +127,7 @@ 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 + value_ = int(real_array) end associate end associate end associate diff --git a/test/string_test.f90 b/test/string_test.f90 index 76a516ce..cc6c90b8 100644 --- a/test/string_test.f90 +++ b/test/string_test.f90 @@ -24,10 +24,11 @@ function results() result(test_results) test_results = [ & test_result_t("is_allocated() result .true. if & only if the string_t component(s) is/are allocated", check_allocation()), & - test_result_t("extracting a key string from colon-separated key/value pair", extracts_key()), & - test_result_t("extracting a string value from colon-separated key/value pair", extracts_string_scalar_value()), & - test_result_t("extracting a logical value from colon-separated key/value pair", extracts_logical_scalar_value()), & - test_result_t("extracting an integer array value from colon-separated key/value pair", extracts_integer_array_value()) & + test_result_t("extracting a key string from a colon-separated key/value pair", extracts_key()), & + 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 integer value from a colon-separated key/value pair", extracts_integer_value()) & ] end function @@ -49,7 +50,7 @@ function extracts_key() result(passed) end associate end function - function extracts_string_scalar_value() result(passed) + function extracts_string_value() result(passed) logical passed associate(line => string_t('"foo" : "bar"')) @@ -57,7 +58,15 @@ function extracts_string_scalar_value() result(passed) end associate end function - function extracts_logical_scalar_value() result(passed) + function extracts_integer_value() result(passed) + logical passed + + associate(line => string_t('"an integer" : 99')) + passed = line%get_json_value(key=string_t("an integer"), mold=0) == 99 + end associate + end function + + function extracts_logical_value() result(passed) logical passed associate( & From 51f1a01b9447da71a5e923c0a3b52a4902839f7a Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sat, 28 Oct 2023 19:56:36 -0700 Subject: [PATCH 7/9] feat(string): get_json_value real mold/result --- src/sourcery/sourcery_string_m.f90 | 10 +++++++++- src/sourcery/sourcery_string_s.f90 | 19 +++++++++++++++++++ test/string_test.f90 | 9 +++++++++ 3 files changed, 37 insertions(+), 1 deletion(-) diff --git a/src/sourcery/sourcery_string_m.f90 b/src/sourcery/sourcery_string_m.f90 index 96c9ff1d..919c0770 100644 --- a/src/sourcery/sourcery_string_m.f90 +++ b/src/sourcery/sourcery_string_m.f90 @@ -14,12 +14,13 @@ module sourcery_string_m generic :: string => as_character procedure :: is_allocated procedure :: get_json_key + procedure :: get_json_real_value procedure :: get_json_string_value procedure :: get_json_logical_value procedure :: get_json_integer_value procedure :: get_json_integer_array_value generic :: get_json_value => & - get_json_string_value, get_json_logical_value, get_json_integer_array_value, get_json_integer_value + get_json_string_value, get_json_logical_value, get_json_integer_array_value, get_json_integer_value, get_json_real_value procedure :: equivalent generic :: operator(==) => equivalent end type @@ -60,6 +61,13 @@ elemental module function get_json_key(self) result(unquoted_key) type(string_t) unquoted_key end function + elemental module function get_json_real_value(self, key, mold) result(value_) + implicit none + class(string_t), intent(in) :: self, key + real, intent(in) :: mold + real value_ + end function + elemental module function get_json_string_value(self, key, mold) result(value_) implicit none class(string_t), intent(in) :: self, key, mold diff --git a/src/sourcery/sourcery_string_s.f90 b/src/sourcery/sourcery_string_s.f90 index 4c412c8c..c4e570d9 100644 --- a/src/sourcery/sourcery_string_s.f90 +++ b/src/sourcery/sourcery_string_s.f90 @@ -51,6 +51,25 @@ end procedure + module procedure get_json_real_value + character(len=:), allocatable :: raw_line, string_value + + call assert(key==self%get_json_key(), "string_s(get_json_real_value): 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_json_string_value character(len=:), allocatable :: raw_line diff --git a/test/string_test.f90 b/test/string_test.f90 index cc6c90b8..763e7127 100644 --- a/test/string_test.f90 +++ b/test/string_test.f90 @@ -25,6 +25,7 @@ function results() result(test_results) test_results = [ & test_result_t("is_allocated() result .true. if & only if the string_t component(s) is/are allocated", check_allocation()), & test_result_t("extracting a key string from a colon-separated key/value pair", extracts_key()), & + test_result_t("extracting a real value from a colon-separated key/value pair", extracts_real_value()), & 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()), & @@ -50,6 +51,14 @@ function extracts_key() result(passed) end associate end function + function extracts_real_value() result(passed) + logical passed + + associate(line => string_t('"pi" : 3.14159')) + passed = line%get_json_value(key=string_t("pi"), mold=2.71828) == 3.14159 + end associate + end function + function extracts_string_value() result(passed) logical passed From 7cc17bae3eb86a2f28cde7b866a9abeab2609fda Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sat, 28 Oct 2023 20:43:14 -0700 Subject: [PATCH 8/9] refac(string): eliminate redundant nomenclature --- src/sourcery/sourcery_string_m.f90 | 22 +++++++++++----------- src/sourcery/sourcery_string_s.f90 | 22 +++++++++++----------- 2 files changed, 22 insertions(+), 22 deletions(-) diff --git a/src/sourcery/sourcery_string_m.f90 b/src/sourcery/sourcery_string_m.f90 index 919c0770..282e89ba 100644 --- a/src/sourcery/sourcery_string_m.f90 +++ b/src/sourcery/sourcery_string_m.f90 @@ -14,13 +14,13 @@ module sourcery_string_m generic :: string => as_character procedure :: is_allocated procedure :: get_json_key - procedure :: get_json_real_value - procedure :: get_json_string_value - procedure :: get_json_logical_value - procedure :: get_json_integer_value - procedure :: get_json_integer_array_value + procedure :: get_json_real + procedure :: get_json_string + procedure :: get_json_logical + procedure :: get_json_integer + procedure :: get_json_integer_array generic :: get_json_value => & - get_json_string_value, get_json_logical_value, get_json_integer_array_value, get_json_integer_value, get_json_real_value + get_json_string, get_json_logical, get_json_integer_array, get_json_integer, get_json_real procedure :: equivalent generic :: operator(==) => equivalent end type @@ -61,34 +61,34 @@ elemental module function get_json_key(self) result(unquoted_key) type(string_t) unquoted_key end function - elemental module function get_json_real_value(self, key, mold) result(value_) + elemental module function get_json_real(self, key, mold) result(value_) implicit none class(string_t), intent(in) :: self, key real, intent(in) :: mold real value_ end function - elemental module function get_json_string_value(self, key, mold) result(value_) + elemental module function get_json_string(self, key, mold) result(value_) implicit none class(string_t), intent(in) :: self, key, mold type(string_t) :: value_ end function - elemental module function get_json_integer_value(self, key, mold) result(value_) + elemental module function get_json_integer(self, key, mold) result(value_) implicit none class(string_t), intent(in) :: self, key integer, intent(in) :: mold integer value_ end function - elemental module function get_json_logical_value(self, key, mold) result(value_) + elemental module function get_json_logical(self, key, mold) result(value_) implicit none class(string_t), intent(in) :: self, key logical, intent(in) :: mold logical value_ end function - pure module function get_json_integer_array_value(self, key, mold) result(value_) + pure module function get_json_integer_array(self, key, mold) result(value_) implicit none class(string_t), intent(in) :: self, key integer, intent(in) :: mold(:) diff --git a/src/sourcery/sourcery_string_s.f90 b/src/sourcery/sourcery_string_s.f90 index c4e570d9..c72f263c 100644 --- a/src/sourcery/sourcery_string_s.f90 +++ b/src/sourcery/sourcery_string_s.f90 @@ -51,10 +51,10 @@ end procedure - module procedure get_json_real_value + module procedure get_json_real character(len=:), allocatable :: raw_line, string_value - call assert(key==self%get_json_key(), "string_s(get_json_real_value): key==self%get_json_key()", key) + call assert(key==self%get_json_key(), "string_s(get_json_real): key==self%get_json_key()", key) raw_line = self%string() associate(text_after_colon => raw_line(index(raw_line, ':')+1:)) @@ -70,11 +70,11 @@ end procedure - module procedure get_json_string_value + module procedure get_json_string character(len=:), allocatable :: raw_line - call assert(key==self%get_json_key(), "key==self%get_string_json_value()", key) + call assert(key==self%get_json_key(), "key==self%get_string_json()", key) raw_line = self%string() associate(text_after_colon => raw_line(index(raw_line, ':')+1:)) @@ -91,10 +91,10 @@ end procedure - module procedure get_json_logical_value + module procedure get_json_logical character(len=:), allocatable :: raw_line, string_value - call assert(key==self%get_json_key(), "string_s(get_json_logical_value): key==self%get_json_key()", key) + call assert(key==self%get_json_key(), "string_s(get_json_logical): key==self%get_json_key()", key) raw_line = self%string() associate(text_after_colon => raw_line(index(raw_line, ':')+1:)) @@ -105,17 +105,17 @@ string_value = trim(adjustl((text_after_colon(:trailing_comma-1)))) end if call assert(string_value=="true" .or. string_value=="false", & - 'string_s(get_json_logical_value): string_value=="true" .or. string_value="false"', string_value) + 'string_s(get_json_logical): string_value=="true" .or. string_value="false"', string_value) value_ = string_value == "true" end associate end associate end procedure - module procedure get_json_integer_value + module procedure get_json_integer character(len=:), allocatable :: raw_line, string_value - call assert(key==self%get_json_key(), "string_s(get_json_logical_value): key==self%get_json_key()", key) + call assert(key==self%get_json_key(), "string_s(get_json_logical): key==self%get_json_key()", key) raw_line = self%string() associate(text_after_colon => raw_line(index(raw_line, ':')+1:)) @@ -131,12 +131,12 @@ end procedure - module procedure get_json_integer_array_value + module procedure get_json_integer_array character(len=:), allocatable :: raw_line real, allocatable :: real_array(:) integer i - call assert(key==self%get_json_key(), "string_s(get_json_integer_array_value): key==self%get_json_key()", key) + call assert(key==self%get_json_key(), "string_s(get_json_integer_array): key==self%get_json_key()", key) raw_line = self%string() associate(colon => index(raw_line, ":")) From 4c7dd116bc9192917251e5fb4093f6d99d4f3c31 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sat, 28 Oct 2023 21:08:38 -0700 Subject: [PATCH 9/9] refac(string): collapse TBP binding, make private --- src/sourcery/sourcery_string_m.f90 | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/src/sourcery/sourcery_string_m.f90 b/src/sourcery/sourcery_string_m.f90 index 282e89ba..0c3b0b3f 100644 --- a/src/sourcery/sourcery_string_m.f90 +++ b/src/sourcery/sourcery_string_m.f90 @@ -14,14 +14,11 @@ module sourcery_string_m generic :: string => as_character procedure :: is_allocated procedure :: get_json_key - procedure :: get_json_real - procedure :: get_json_string - procedure :: get_json_logical - procedure :: get_json_integer - procedure :: get_json_integer_array + procedure, private :: & + get_json_integer_array, get_json_logical, get_json_integer, get_json_string, get_json_real generic :: get_json_value => & - get_json_string, get_json_logical, get_json_integer_array, get_json_integer, get_json_real - procedure :: equivalent + get_json_integer_array, get_json_logical, get_json_integer, get_json_string, get_json_real + procedure, private :: equivalent generic :: operator(==) => equivalent end type