Merge pull request #57 from sourceryinstitute/string-equivalence

Feature: support operator(==) and operator(/=) for string_t and character operands

Author: rouson

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

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

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