feat(test_diagnosis): fraction/percent tolerances

This commit adds

1. operator(.withinFraction.) for real & double precision operands
2. operator(.withinPercentage.) for real & double precision operands
3. unit tests for each operator.

Author: rouson

src/julienne/julienne_test_diagnosis_m.F90

@@ -14,6 +14,8 @@ module julienne_test_diagnosis_m
   public :: operator(.and.)
   public :: operator(.approximates.)
   public :: operator(.within.)
+  public :: operator(.withinFraction.)
+  public :: operator(.withinPercentage.)
   public :: operator(.equalsExpected.)
   public :: operator(.lessThan.)
   public :: operator(.lessThanOrEqualTo.)
@@ -183,6 +185,50 @@ elemental module function within_double_precision(operands, tolerance) result(te
 
   end interface
 
+  interface operator(.withinFraction.)
+
+    elemental module function within_real_fraction(operands, fractional_tolerance) result(test_diagnosis)
+      implicit none
+      type(operands_t), intent(in) :: operands
+      real, intent(in) :: fractional_tolerance
+      type(test_diagnosis_t) test_diagnosis
+    end function
+   
+    elemental module function within_double_precision_fraction(operands, fractional_tolerance) result(test_diagnosis)
+      implicit none
+#if HAVE_DERIVED_TYPE_KIND_PARAMETERS
+      type(operands_t(double_precision)), intent(in) :: operands
+#else
+      type(double_precision_operands_t), intent(in) :: operands
+#endif
+      double precision, intent(in) :: fractional_tolerance
+      type(test_diagnosis_t) test_diagnosis
+    end function
+   
+  end interface
+
+  interface operator(.withinPercentage.)
+
+    elemental module function within_real_percentage(operands, percentage_tolerance) result(test_diagnosis)
+      implicit none
+      type(operands_t), intent(in) :: operands
+      real, intent(in) :: percentage_tolerance
+      type(test_diagnosis_t) test_diagnosis
+    end function
+   
+    elemental module function within_double_precision_percentage(operands, percentage_tolerance) result(test_diagnosis)
+      implicit none
+#if HAVE_DERIVED_TYPE_KIND_PARAMETERS
+      type(operands_t(double_precision)), intent(in) :: operands
+#else
+      type(double_precision_operands_t), intent(in) :: operands
+#endif
+      double precision, intent(in) :: percentage_tolerance
+      type(test_diagnosis_t) test_diagnosis
+    end function
+   
+  end interface
+
   interface test_diagnosis_t
 
     elemental module function construct_from_string_t(test_passed, diagnostics_string) result(test_diagnosis)

src/julienne/julienne_test_diagnosis_s.F90

@@ -164,13 +164,43 @@
     else
       test_diagnosis = test_diagnosis_t(test_passed=.false. &
         ,diagnostics_string = "expected "              // string_t(operands%expected) &
-                           // "within a tolerance of " // string_t(tolerance)          &
+                           // " within a tolerance of " // string_t(tolerance)          &
                            // "; actual value is "     // string_t(operands%actual)   &
       )
     end if
 
   end procedure
 
+  module procedure within_real_fraction
+
+    if (abs(operands%actual - operands%expected) <= abs(fractional_tolerance*operands%expected)) then
+      ! We use <= to allow for fractional_tolerance=0, which could never be satisfied if we used < instead:
+      test_diagnosis = test_diagnosis_t(test_passed=.true., diagnostics_string="")
+    else
+      test_diagnosis = test_diagnosis_t(test_passed=.false. &
+        ,diagnostics_string = "expected "              // string_t(operands%expected) &
+                           // " within a fractional tolerance of " // string_t(fractional_tolerance)          &
+                           // "; actual value is "     // string_t(operands%actual)   &
+      )
+    end if
+
+  end procedure
+
+  module procedure within_real_percentage
+
+    if (abs(operands%actual - operands%expected) <= abs(operands%expected*percentage_tolerance/1D02)) then
+      ! We use <= to allow for fractional_tolerance=0, which could never be satisfied if we used < instead:
+      test_diagnosis = test_diagnosis_t(test_passed=.true., diagnostics_string="")
+    else
+      test_diagnosis = test_diagnosis_t(test_passed=.false. &
+        ,diagnostics_string = "expected " // string_t(operands%expected) &
+                           // " within a tolerance of " // string_t(percentage_tolerance) // " percent;" &
+                           // " actual value is " // string_t(operands%actual)   &
+      )
+    end if
+
+  end procedure
+
   module procedure within_double_precision
 
     if (abs(operands%actual - operands%expected) <= tolerance) then
@@ -179,13 +209,43 @@
     else
       test_diagnosis = test_diagnosis_t(test_passed=.false. &
         ,diagnostics_string = "expected "              // string_t(operands%expected) &
-                           // "within a tolerance of " // string_t(tolerance)          &
+                           // " within a tolerance of " // string_t(tolerance)          &
+                           // "; actual value is "     // string_t(operands%actual)   &
+      )
+    end if
+
+  end procedure
+
+  module procedure within_double_precision_fraction
+
+    if (abs(operands%actual - operands%expected) <= abs(fractional_tolerance*operands%expected)) then
+      ! We use <= to allow for tolerance=0, which could never be satisfied if we used < instead:
+      test_diagnosis = test_diagnosis_t(test_passed=.true., diagnostics_string="")
+    else
+      test_diagnosis = test_diagnosis_t(test_passed=.false. &
+        ,diagnostics_string = "expected "              // string_t(operands%expected) &
+                           // " within a fractional tolerance of " // string_t(fractional_tolerance)          &
                            // "; actual value is "     // string_t(operands%actual)   &
       )
     end if
 
   end procedure
 
+  module procedure within_double_precision_percentage
+
+    if (abs((operands%actual - operands%expected)) <= abs(operands%expected*percentage_tolerance/1D02)) then
+      ! We use <= to allow for tolerance=0, which could never be satisfied if we used < instead:
+      test_diagnosis = test_diagnosis_t(test_passed=.true., diagnostics_string="")
+    else
+      test_diagnosis = test_diagnosis_t(test_passed=.false. &
+        ,diagnostics_string = "expected "               // string_t(operands%expected) &
+                           // " within a tolerance of " // string_t(percentage_tolerance) // " percent;" &
+                           // " actual value is "       // string_t(operands%actual)   &
+      )
+    end if
+
+  end procedure
+
   module procedure construct_from_string_t
     test_diagnosis%test_passed_ = test_passed
     test_diagnosis%diagnostics_string_ = diagnostics_string

src/julienne_m.f90

@@ -20,7 +20,9 @@ module julienne_m
     ,operator(.lessThan.) &
     ,operator(.lessThanOrEqualTo.) &
     ,operator(.greaterThan.) &
-    ,operator(.greaterThanOrEqualTo.)
+    ,operator(.greaterThanOrEqualTo.) &
+    ,operator(.withinFraction.) &
+    ,operator(.withinPercentage.)
   use julienne_test_result_m, only : test_result_t
   use julienne_vector_test_description_m, only : vector_test_description_t, vector_diagnosis_function_i
   implicit none

test/test_diagnosis_test_m.F90

@@ -21,6 +21,8 @@ module test_diagnosis_test_m
     ,operator(.equalsExpected.) &
     ,operator(.approximates.) &
     ,operator(.within.) &
+    ,operator(.withinFraction.) &
+    ,operator(.withinPercentage.) &
     ,operator(.lessThan.) &
     ,operator(.lessThanOrEqualTo.) &
     ,operator(.greaterThan.) &
@@ -50,6 +52,10 @@ function results() result(test_results)
     associate(descriptions => [ &
        test_description_t("construction from a real expression of the form 'x .approximates. y .within. tolerance'", check_approximates_real) &
       ,test_description_t("construction from a double precision expression of the form 'x .approximates. y .within. tolerance'", check_approximates_double) &
+      ,test_description_t("construction from the real expression 'x .approximates. y .withinFraction. tolerance'", check_approximates_real_fraction) &
+      ,test_description_t("construction from the double precision expression 'x .approximates. y .withinFraction. tolerance'", check_approximates_double_fraction) &
+      ,test_description_t("construction from the real expression 'x .approximates. y .withinPercentage. tolerance'", check_approximates_real_percentage) &
+      ,test_description_t("construction from the double precision expression 'x .approximates. y .withinPercentage. tolerance'", check_approximates_double_percentage) &
       ,test_description_t("construction from an integer expression of the form 'i .equalsExpected. j", check_equals_integer) &
       ,test_description_t("construction from a real expression of the form 'x .lessThan. y", check_less_than_real) &
       ,test_description_t("construction from a double precision expression of the form 'x .lessThan. y", check_less_than_double) &
@@ -66,32 +72,29 @@ function results() result(test_results)
      ! Work around missing Fortran 2008 feature: associating a procedure actual argument with a procedure pointer dummy argument:
      type(test_description_t), allocatable :: descriptions(:)
      procedure(diagnosis_function_i), pointer :: &
-        check_approximates_real_ptr &
-       ,check_approximates_double_ptr          , check_equals_integer_ptr &
-       ,check_less_than_real_ptr               , check_greater_than_real_ptr &
-       ,check_less_than_double_ptr             , check_greater_than_double_ptr &
-       ,check_less_than_integer_ptr            , check_greater_than_integer_ptr &
-       ,check_less_than_or_equal_to_integer_ptr, check_greater_than_or_equal_to_integer_ptr &
-       ,check_and_with_scalar_operands_ptr &
-       ,check_and_with_vector_operands_ptr
-
-     check_approximates_real_ptr                => check_approximates_real
-     check_approximates_double_ptr             => check_approximates_double
-     check_equals_integer_ptr                   => check_equals_integer
-     check_less_than_real_ptr                   => check_less_than_real
-     check_less_than_double_ptr                 => check_less_than_double
-     check_less_than_integer_ptr                => check_less_than_integer
-     check_less_than_or_equal_to_integer_ptr    => check_less_than_or_equal_to_integer
-     check_greater_than_real_ptr                => check_greater_than_real
-     check_greater_than_double_ptr              => check_greater_than_double
-     check_greater_than_integer_ptr             => check_greater_than_integer
-     check_greater_than_or_equal_to_integer_ptr => check_greater_than_or_equal_to_integer
-     check_and_with_scalar_operands_ptr         => check_and_with_scalar_operands
-     check_and_with_vector_operands_ptr         => check_and_with_vector_operands
+        check_approximates_real_ptr                => check_approximates_real &
+       ,check_approximates_double_ptr              => check_approximates_double &
+       ,check_approximates_real_fraction_ptr       => check_approximates_real_fraction &
+       ,check_approximates_double_fraction_ptr     => check_approximates_double_fraction &
+       ,check_approximates_real_percentage_ptr     => check_approximates_real_percentage &
+       ,check_approximates_double_percentage_ptr   => check_approximates_double_percentage &
+       ,check_equals_integer_ptr                   => check_equals_integer &
+       ,check_less_than_real_ptr                   => check_less_than_real &
+       ,check_less_than_double_ptr                 => check_less_than_double &
+       ,check_less_than_integer_ptr                => check_less_than_integer &
+       ,check_less_than_or_equal_to_integer_ptr    => check_less_than_or_equal_to_integer &
+       ,check_greater_than_real_ptr                => check_greater_than_real &
+       ,check_greater_than_double_ptr              => check_greater_than_double &
+       ,check_greater_than_integer_ptr             => check_greater_than_integer &
+       ,check_greater_than_or_equal_to_integer_ptr => check_greater_than_or_equal_to_integer &
+       ,check_and_with_scalar_operands_ptr         => check_and_with_scalar_operands &
+       ,check_and_with_vector_operands_ptr         => check_and_with_vector_operands
 
      descriptions = [ &
        test_description_t("construction from a real expression of the form `x .approximates. y .within. tolerance`"            , check_approximates_real_ptr) &
       ,test_description_t("construction from a double-precision expression of the form `x .approximates. y .within. tolerance`", check_approximates_double_ptr) &
+       test_description_t("construction from the real expression 'x .approximates. y .withinFraction. tolerance'", check_approximates_real_fraction_ptr) &
+      ,test_description_t("construction from the double precision expression 'x .approximates. y .withinFraction. tolerance'", check_approximates_double_fraction_ptr) &
       ,test_description_t("construction from an integer expression of the form `i .equalsExpected. j`"                         , check_equals_integer_ptr) &
       ,test_description_t("construction from a real expression of the form 'x .lessThan. y"                                    , check_less_than_real_ptr) &
       ,test_description_t("construction from a double precision expression of the form 'x .lessThan. y"                        , check_less_than_double_ptr) &
@@ -143,6 +146,30 @@ function check_approximates_double() result(test_diagnosis)
     test_diagnosis = 1D0 .approximates. expected_value .within. tolerance
   end function
 
+  function check_approximates_real_fraction() result(test_diagnosis)
+    type(test_diagnosis_t) test_diagnosis
+    real, parameter :: actual_value = 1.1, expected_value = 1., fraction_ = 2.E-01
+    test_diagnosis = actual_value .approximates. expected_value .withinFraction. fraction_
+  end function
+
+  function check_approximates_double_fraction() result(test_diagnosis)
+    type(test_diagnosis_t) test_diagnosis
+    double precision, parameter :: actual_value = 1.1D0, expected_value = 1D0, fraction_ = 2D-01
+    test_diagnosis = actual_value .approximates. expected_value .withinFraction. fraction_
+  end function
+
+  function check_approximates_real_percentage() result(test_diagnosis)
+    type(test_diagnosis_t) test_diagnosis
+    real, parameter :: actual_value = 1.01, expected_value = 1., percentage = 2.
+    test_diagnosis = actual_value .approximates. expected_value .withinPercentage. percentage
+  end function
+
+  function check_approximates_double_percentage() result(test_diagnosis)
+    type(test_diagnosis_t) test_diagnosis
+    double precision, parameter :: actual_value = 1.01D0, expected_value = 1D0, percentage = 2D0
+    test_diagnosis = actual_value .approximates. expected_value .withinPercentage. percentage
+  end function
+
   function check_equals_integer() result(test_diagnosis)
     type(test_diagnosis_t) test_diagnosis
     integer, parameter :: expected_value = 1