diff --git a/src/sourcery/sourcery_string_m.f90 b/src/sourcery/sourcery_string_m.f90 index 0c3b0b3f..d90faf12 100644 --- a/src/sourcery/sourcery_string_m.f90 +++ b/src/sourcery/sourcery_string_m.f90 @@ -14,12 +14,16 @@ module sourcery_string_m generic :: string => as_character procedure :: is_allocated procedure :: get_json_key - procedure, private :: & - get_json_integer_array, get_json_logical, get_json_integer, get_json_string, get_json_real + 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 :: equivalent - generic :: operator(==) => equivalent + 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, 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 end type interface string_t @@ -92,10 +96,44 @@ pure module function get_json_integer_array(self, key, mold) result(value_) integer, allocatable :: value_(:) end function - elemental module function equivalent(lhs, rhs) result(lhs_eqv_rhs) + elemental module function string_t_eq_string_t(lhs, rhs) result(lhs_eq_rhs) + implicit none + class(string_t), intent(in) :: lhs, rhs + logical lhs_eq_rhs + end function + + elemental module function string_t_eq_character(lhs, rhs) result(lhs_eq_rhs) + implicit none + class(string_t), intent(in) :: lhs + character(len=*), intent(in) :: rhs + logical lhs_eq_rhs + end function + + elemental module function character_eq_string_t(lhs, rhs) result(lhs_eq_rhs) + implicit none + class(string_t), intent(in) :: rhs + character(len=*), intent(in) :: lhs + logical lhs_eq_rhs + end function + + elemental module function string_t_ne_string_t(lhs, rhs) result(lhs_ne_rhs) implicit none class(string_t), intent(in) :: lhs, rhs - logical lhs_eqv_rhs + logical lhs_ne_rhs + end function + + elemental module function string_t_ne_character(lhs, rhs) result(lhs_ne_rhs) + implicit none + class(string_t), intent(in) :: lhs + character(len=*), intent(in) :: rhs + logical lhs_ne_rhs + end function + + elemental module function character_ne_string_t(lhs, rhs) result(lhs_ne_rhs) + implicit none + class(string_t), intent(in) :: rhs + character(len=*), intent(in) :: lhs + logical lhs_ne_rhs end function end interface diff --git a/src/sourcery/sourcery_string_s.f90 b/src/sourcery/sourcery_string_s.f90 index c72f263c..a71a2b4a 100644 --- a/src/sourcery/sourcery_string_s.f90 +++ b/src/sourcery/sourcery_string_s.f90 @@ -155,8 +155,28 @@ end procedure - module procedure equivalent - lhs_eqv_rhs = lhs%string() == rhs%string() + module procedure string_t_eq_string_t + lhs_eq_rhs = lhs%string() == rhs%string() + end procedure + + module procedure string_t_eq_character + lhs_eq_rhs = lhs%string() == rhs + end procedure + + module procedure character_eq_string_t + lhs_eq_rhs = lhs == rhs%string() + end procedure + + module procedure string_t_ne_string_t + lhs_ne_rhs = lhs%string() /= rhs%string() + end procedure + + module procedure string_t_ne_character + lhs_ne_rhs = lhs%string() /= rhs + end procedure + + module procedure character_ne_string_t + lhs_ne_rhs = lhs /= rhs%string() end procedure end submodule sourcery_string_s diff --git a/test/string_test.f90 b/test/string_test.f90 index 763e7127..0bbbef80 100644 --- a/test/string_test.f90 +++ b/test/string_test.f90 @@ -29,7 +29,9 @@ function results() result(test_results) 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()) & + 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()) & ] end function @@ -55,7 +57,7 @@ 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 + passed = line%get_json_value(key=string_t("pi"), mold=1.) == 3.14159 end associate end function @@ -103,4 +105,20 @@ function extracts_integer_array_value() result(passed) end associate end function + function supports_equivalence_operator() result(passed) + logical passed + passed = & + string_t("abcdefg") == string_t("abcdefg") .and. & + string_t("xyz pdq") == "xyz pdq" .and. & + "123.456" == string_t("123.456") + end function + + function supports_non_equivalence_operator() result(passed) + logical passed + passed = & + string_t("abcdefg") /= string_t("xyz pdq") .and. & + string_t("xyz pdq") /= "abcdefg" .and. & + "123.456" /= string_t("456.123") + end function + end module string_test_m