Merge pull request #151 from bonachea/Dec-10-misc

Misc improvements

Author: bonachea

src/julienne/julienne_test_diagnosis_m.F90

@@ -201,16 +201,32 @@ pure module function aggregate_rank15_diagnosis(diagnoses) result(diagnosis)
 
   interface operator(.also.)
 
-    elemental module function also(lhs, rhs) result(diagnosis)
+    elemental module function also_DD(lhs, rhs) result(diagnosis)
       implicit none
       type(test_diagnosis_t), intent(in) :: lhs, rhs
       type(test_diagnosis_t) diagnosis
     end function
 
+    elemental module function also_DL(lhs, rhs) result(diagnosis)
+      implicit none
+      type(test_diagnosis_t), intent(in) :: lhs
+      logical, intent(in) :: rhs
+      type(test_diagnosis_t) diagnosis
+    end function
+
+    elemental module function also_LD(lhs, rhs) result(diagnosis)
+      implicit none
+      logical, intent(in) :: lhs
+      type(test_diagnosis_t), intent(in) :: rhs
+      type(test_diagnosis_t) diagnosis
+    end function
+
   end interface
 
   interface operator(.and.)
-     module procedure also
+     module procedure also_DD
+     module procedure also_LD
+     module procedure also_DL
   end interface
 
   interface operator(.approximates.)
@@ -245,6 +261,12 @@ elemental module function expect(expected_true) result(test_diagnosis)
 
   interface operator(.equalsExpected.)
 
+    elemental module function equals_expected_logical(actual, expected) result(test_diagnosis)
+      implicit none
+      logical, intent(in) :: actual, expected
+      type(test_diagnosis_t) test_diagnosis
+    end function
+
     elemental module function equals_expected_c_ptr(actual, expected) result(test_diagnosis)
       implicit none
       type(c_ptr), intent(in) :: actual, expected

src/julienne/julienne_test_diagnosis_s.F90

@@ -37,10 +37,18 @@
     end if
   end procedure
 
-  module procedure also
+  module procedure also_DD
      diagnosis = .all. ([lhs,rhs])
   end procedure 
 
+  module procedure also_LD
+     diagnosis = .all. ([.expect.(lhs),rhs])
+  end procedure 
+
+  module procedure also_DL
+     diagnosis = .all. ([lhs,.expect.(rhs)])
+  end procedure 
+
 #ifndef __GFORTRAN__
 
   module procedure aggregate_diagnosis
@@ -280,18 +288,33 @@ pure function aggregate_vector_diagnosis(diagnoses) result(diagnosis)
     else
       block
         integer(c_intptr_t), parameter :: mold = 0_c_intptr_t
+        character(len=18) :: str_actual, str_expect
 
-        associate(actual_c_loc => transfer(actual, mold), expected_c_loc => transfer(expected, mold))
+        associate(actual_c_loc => transfer(actual, mold), expect_c_loc => transfer(expected, mold))
+          write(str_actual, '(A2,Z16.16)') '0x',actual_c_loc
+          write(str_expect, '(A2,Z16.16)') '0x',expect_c_loc
           test_diagnosis = test_diagnosis_t( &
              test_passed = .false. &
-            ,diagnostics_string = "expected " // string_t(expected_c_loc) // "; actual value is " // string_t(actual_c_loc) &
+            ,diagnostics_string = "expected " // str_expect // "; actual value is " // str_actual &
           )
         end associate
      end block
     end if
 
   end procedure
 
+  module procedure equals_expected_logical
+
+    if (actual .EQV. expected) then
+      test_diagnosis = test_diagnosis_t(test_passed=.true., diagnostics_string="")
+    else
+      test_diagnosis = test_diagnosis_t(test_passed = .false. &
+        ,diagnostics_string = "expected " // string_t(expected) // "; actual value is " // string_t(actual) &
+      )
+    end if
+
+  end procedure
+
   module procedure equals_expected_integer
 
     if (actual == expected) then

test/modules/test_diagnosis_test_m.F90

@@ -71,6 +71,7 @@ function results() result(test_results)
       ,test_description_t("construction from string_t/character expressions 'a .equalsExpected. b'"                            , usher(check_equals_character_vs_string)) &
       ,test_description_t("construction from the character expression 'a .equalsExpected. b'"                                  , usher(check_equals_character)) &
       ,test_description_t("construction from the type(c_ptr) expression 'p .equalsExpected. q'"                                , usher(check_equals_c_ptr)) &
+      ,test_description_t("construction from the logical expression 't .equalsExpected. t'"                                    , usher(check_equals_logical)) &
       ,test_description_t("construction from the string_t expression 'a .equalsExpected. b'"                                   , usher(check_equals_string)) &
       ,test_description_t("construction from the integer expression 'i .equalsExpected. j'"                                    , usher(check_equals_integer)) &
       ,test_description_t("construction from integer(int64) relational operators"                                              , usher(check_int64_comparisons)) &
@@ -85,6 +86,7 @@ function results() result(test_results)
       ,test_description_t("construction from (.expects. logical-expression) // 'user-defined message'"                         , usher(check_expects_logical)) &
       ,test_description_t("construction from (.expects. logical-expression) // 'user-defined message'"                         , usher(check_expects_logical)) &
       ,test_description_t("defining a test_diagnosis_t object by assigning a logical value"                                    , usher(check_assigns_logical)) &
+      ,test_description_t("aggregating a test_diagnosis_t object using .also. with a logical value"                                    , usher(check_also_logical)) &
       ,test_description_t("hardwiring a test to pass via the passing_test() function"                                          , usher(check_passing_test_function)) &
     ]
     test_results = test_diagnosis_test%run(test_descriptions)
@@ -157,6 +159,12 @@ function check_equals_c_ptr() result(test_diagnosis)
     test_diagnosis = t_ptr .equalsExpected. c_loc(t)
   end function
 
+  function check_equals_logical() result(test_diagnosis)
+    type(test_diagnosis_t) test_diagnosis
+    logical, parameter :: t = .true., f = .false.
+    test_diagnosis = (t .equalsExpected. t) .also. (f .equalsExpected. f)
+  end function
+
   function check_equals_string() result(test_diagnosis)
     type(test_diagnosis_t) test_diagnosis
     type(string_t) expected_value
@@ -303,6 +311,13 @@ function check_assigns_logical() result(test_diagnosis)
     test_diagnosis = .true.
   end function
 
+  function check_also_logical() result(test_diagnosis)
+    type(test_diagnosis_t) test_diagnosis
+    test_diagnosis = .true.
+    test_diagnosis = test_diagnosis .also. .true.
+    test_diagnosis = .true. .also. test_diagnosis
+  end function
+
   function check_passing_test_function() result(test_diagnosis)
     type(test_diagnosis_t) test_diagnosis
     test_diagnosis = passing_test()