From 13ed2500b69e6aca2047fa6ec82e0e023ab3addf Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sun, 29 Oct 2023 19:52:51 -0700 Subject: [PATCH] feat(string_t): defined assign to/from character --- src/sourcery/sourcery_string_m.f90 | 29 +++++++++++++++++++++-------- src/sourcery/sourcery_string_s.f90 | 8 ++++++++ test/string_test.f90 | 22 +++++++++++++++++++++- 3 files changed, 50 insertions(+), 9 deletions(-) diff --git a/src/sourcery/sourcery_string_m.f90 b/src/sourcery/sourcery_string_m.f90 index d90faf12..1fe9d2e3 100644 --- a/src/sourcery/sourcery_string_m.f90 +++ b/src/sourcery/sourcery_string_m.f90 @@ -14,16 +14,17 @@ module sourcery_string_m generic :: string => as_character procedure :: is_allocated procedure :: get_json_key - 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 :: get_json_value => & - get_json_integer_array, get_json_logical, get_json_integer, get_json_string, get_json_real - procedure, private :: & - get_json_integer_array, get_json_logical, get_json_integer, get_json_string, get_json_real - procedure, private :: string_t_ne_string_t, string_t_ne_character + 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_json_integer_array, get_json_logical, get_json_integer, get_json_string, get_json_real + procedure, private :: get_json_integer_array, get_json_logical, get_json_integer, get_json_string, get_json_real + 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, pass(rhs) :: character_ne_string_t - procedure, private :: string_t_eq_string_t, string_t_eq_character procedure, private, pass(rhs) :: character_eq_string_t + procedure, private, pass(rhs) :: assign_string_t_to_character end type interface string_t @@ -136,6 +137,18 @@ elemental module function character_ne_string_t(lhs, rhs) result(lhs_ne_rhs) logical lhs_ne_rhs end function + pure module subroutine assign_character_to_string_t(lhs, rhs) + implicit none + class(string_t), intent(inout) :: lhs + character(len=*), intent(in) :: rhs + end subroutine + + pure module subroutine assign_string_t_to_character(lhs, rhs) + implicit none + class(string_t), intent(in) :: rhs + character(len=:), intent(out), allocatable :: lhs + end subroutine + end interface end module sourcery_string_m diff --git a/src/sourcery/sourcery_string_s.f90 b/src/sourcery/sourcery_string_s.f90 index a71a2b4a..bab36f27 100644 --- a/src/sourcery/sourcery_string_s.f90 +++ b/src/sourcery/sourcery_string_s.f90 @@ -179,4 +179,12 @@ lhs_ne_rhs = lhs /= rhs%string() end procedure + module procedure assign_string_t_to_character + lhs = rhs%string() + end procedure + + module procedure assign_character_to_string_t + lhs%string_ = rhs + end procedure + end submodule sourcery_string_s diff --git a/test/string_test.f90 b/test/string_test.f90 index 0bbbef80..2fd2f758 100644 --- a/test/string_test.f90 +++ b/test/string_test.f90 @@ -31,7 +31,9 @@ function results() result(test_results) 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()), & test_result_t('supporting operator(==) for string_t and character operands', supports_equivalence_operator()), & - test_result_t('supporting operator(/=) for string_t and character operands', supports_non_equivalence_operator()) & + test_result_t('supporting operator(/=) for string_t and character operands', supports_non_equivalence_operator()), & + test_result_t('assigning a string_t object to a character variable', assigns_string_t_to_character()), & + test_result_t('assigning a character variable to a string_t object', assigns_character_to_string_t()) & ] end function @@ -121,4 +123,22 @@ function supports_non_equivalence_operator() result(passed) "123.456" /= string_t("456.123") end function + function assigns_string_t_to_character() result(passed) + logical passed + character(len=:), allocatable :: lhs + + associate(rhs => string_t("ya don't say")) + lhs = rhs + passed = lhs == rhs + end associate + end function + + function assigns_character_to_string_t() result(passed) + logical passed + character(len=*), parameter :: rhs = "well, alrighty then" + type(string_t) lhs + lhs = rhs + passed = lhs == rhs + end function + end module string_test_m