Merge pull request #58 from sourceryinstitute/defined-assignments

feat(string_t): defined assign to/from character

Author: rouson

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

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

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