Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

chore(string_m): make specific binding private #13

Merged
merged 2 commits into from
Sep 2, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
21 changes: 19 additions & 2 deletions src/julienne/julienne_string_m.f90
Original file line number Diff line number Diff line change
Expand Up @@ -30,15 +30,17 @@ 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
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 :: 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
Expand Down Expand Up @@ -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
Expand Down
28 changes: 28 additions & 0 deletions src/julienne/julienne_string_s.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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(:)
Expand All @@ -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
Expand Down
27 changes: 26 additions & 1 deletion test/string_test.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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 &
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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) &
Expand Down Expand Up @@ -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 = &
Expand Down
Loading