From 9250b7a13974af2185ecca7db09df81ecc7fe72a Mon Sep 17 00:00:00 2001 From: Kurt Sansom Date: Wed, 12 May 2021 13:57:29 -0500 Subject: [PATCH 1/5] feat: add relative equals that defaults to direct equals for small values --- bin/funit/pFUnitParser.py | 3 +- src/funit/asserts/Assert.F90 | 1 + src/funit/asserts/AssertUtilities.F90 | 29 ++- src/funit/asserts/Assert_Real.tmpl | 167 ++++++++++++++++++ tests/funit-core/CMakeLists.txt | 1 + .../funit-core/Test_AssertRelMinEqual_Real.pf | 165 +++++++++++++++++ tests/funit-core/testSuites.inc | 1 + 7 files changed, 365 insertions(+), 2 deletions(-) create mode 100644 tests/funit-core/Test_AssertRelMinEqual_Real.pf diff --git a/bin/funit/pFUnitParser.py b/bin/funit/pFUnitParser.py index 7097f33e..57e5794d 100755 --- a/bin/funit/pFUnitParser.py +++ b/bin/funit/pFUnitParser.py @@ -21,7 +21,8 @@ def __str__(self): 'relativelyequal': 2, 'isinfinite': 1, 'isfinite': 1, 'isnan': 1, 'ismemberof': 2, 'contains': 2, 'any': 1, 'all': 1, 'notall': 1, 'none': 1, 'ispermutationof': 2, - 'exceptionraised': 0, 'sameshape': 2, 'that': 2, '_that': 2} + 'exceptionraised': 0, 'sameshape': 2, 'that': 2, '_that': 2, + 'relminequal': 2} def cppSetLineAndFile(line, file): if sysconfig.get_platform() == 'mingw': diff --git a/src/funit/asserts/Assert.F90 b/src/funit/asserts/Assert.F90 index 17321084..a52c6b12 100644 --- a/src/funit/asserts/Assert.F90 +++ b/src/funit/asserts/Assert.F90 @@ -44,6 +44,7 @@ module PF_Assert public :: assertLessThan, assertLessThanOrEqual public :: assertGreaterThan, assertGreaterThanOrEqual public :: assertRelativelyEqual + public :: assertRelMinEqual public :: assertIsNan, assertIsFinite diff --git a/src/funit/asserts/AssertUtilities.F90 b/src/funit/asserts/AssertUtilities.F90 index e318190a..61d785d6 100644 --- a/src/funit/asserts/AssertUtilities.F90 +++ b/src/funit/asserts/AssertUtilities.F90 @@ -21,6 +21,7 @@ module pf_AssertUtilities public :: fail_not_greater_than public :: fail_not_greater_than_or_equal public :: fail_not_relatively_equal + public :: fail_not_relatively_min_equal contains @@ -342,7 +343,33 @@ subroutine fail_not_relatively_equal(expected, actual, difference, unused, index call throw(fail_message, location) end subroutine fail_not_relatively_equal - + + subroutine fail_not_relatively_min_equal(expected, actual, difference, unused, index, message, location) + character(*), intent(in) :: expected + character(*), intent(in) :: actual + character(*), intent(in) :: difference + ! Separator + class (KeywordEnforcer), optional, intent(in) :: unused + ! Keyword arguments + integer, optional, intent(in) :: index(:) + character(*), optional, intent(in) :: message + type (SourceLocation), optional, intent(in) :: location + + character(len=:), allocatable :: fail_message + + _UNUSED_DUMMY(unused) + + fail_message = base_message('assertRelMinEqual', message, index) + fail_message = fail_message // new_line('A') // ' Expected: <' // expected // '>' + fail_message = fail_message // new_line('A') // ' Actual: <' // actual // '>' + fail_message = fail_message // new_line('A') // ' Rel. difference: ' // difference + if (present(index)) then + fail_message = fail_message // new_line('A') // ' at index: ' // toString(index) + end if + + call throw(fail_message, location) + + end subroutine fail_not_relatively_min_equal function base_message(failure_type, user_message, index) result(message) character(:), allocatable :: message diff --git a/src/funit/asserts/Assert_Real.tmpl b/src/funit/asserts/Assert_Real.tmpl index 52f45c15..bf1d0ed4 100644 --- a/src/funit/asserts/Assert_Real.tmpl +++ b/src/funit/asserts/Assert_Real.tmpl @@ -122,6 +122,79 @@ [(real, 128, 0), (real, 128, rank), (real, 128, 0)] @end tkr_parameters +@tkr_parameters with_rel_tol +! Tolerance is default real +[(integer, default, rank), (real, default, rank), (real, default, 0), (real, default, 0)] +[(real, default, rank), (real, default, rank), (real, default, 0), (real, default, 0)] +[(integer, default, rank), (real, double, rank), (real, default, 0), (real, default, 0)] +[(real, default, rank), (real, double, rank), (real, default, 0), (real, default, 0)] +[(real, double, rank), (real, double, rank), (real, default, 0), (real, default, 0)] +[(integer, default, rank), (real, 32, rank), (real, default, 0), (real, default, 0)] +[(real, default, rank), (real, 32, rank), (real, default, 0), (real, default, 0)] +[(real, 32, rank), (real, 32, rank), (real, default, 0), (real, default, 0)] +[(integer, default, rank), (real, 64, rank), (real, default, 0), (real, default, 0)] +[(real, default, rank), (real, 64, rank), (real, default, 0), (real, default, 0)] +[(real, 64, rank), (real, 64, rank), (real, default, 0), (real, default, 0)] +[(integer, default, rank), (real, 80, rank), (real, default, 0), (real, default, 0)] +[(real, default, rank), (real, 80, rank), (real, default, 0), (real, default, 0)] +[(real, 80, rank), (real, 80, rank), (real, default, 0), (real, default, 0)] +[(integer, default, rank), (real, 128, rank), (real, default, 0), (real, default, 0)] +[(real, default, rank), (real, 128, rank), (real, default, 0), (real, default, 0)] +[(real, 128, rank), (real, 128, rank), (real, default, 0), (real, default, 0)] +! Tolerance is same kind as actual +[(integer, default, rank), (real, default, rank), (real, default, 0), (real, default, 0)] +[(real, default, rank), (real, default, rank), (real, default, 0), (real, default, 0)] +[(integer, default, rank), (real, double, rank), (real, double, 0), (real, double, 0)] +[(real, default, rank), (real, double, rank), (real, double, 0), (real, double, 0)] +[(real, double, rank), (real, double, rank), (real, double, 0), (real, double, 0)] +[(integer, default, rank), (real, 32, rank), (real, 32, 0), (real, 32, 0)] +[(real, default, rank), (real, 32, rank), (real, 32, 0), (real, 32, 0)] +[(real, 32, rank), (real, 32, rank), (real, 32, 0), (real, 32, 0)] +[(integer, default, rank), (real, 64, rank), (real, 64, 0), (real, 64, 0)] +[(real, default, rank), (real, 64, rank), (real, 64, 0), (real, 64, 0)] +[(real, 64, rank), (real, 64, rank), (real, 64, 0), (real, 64, 0)] +[(integer, default, rank), (real, 80, rank), (real, 80, 0), (real, 80, 0)] +[(real, default, rank), (real, 80, rank), (real, 80, 0), (real, 80, 0)] +[(real, 80, rank), (real, 80, rank), (real, 80, 0), (real, 80, 0)] +[(integer, default, rank), (real, 128, rank), (real, 128, 0), (real, 128, 0)] +[(real, default, rank), (real, 128, rank), (real, 128, 0), (real, 128, 0)] +[(real, 128, rank), (real, 128, rank), (real, 128, 0), (real, 128, 0)] +! And again with conformable rank 0 +[(integer, default, 0), (real, default, rank), (real, default, 0), (real, default, 0)] +[(real, default, 0), (real, default, rank), (real, default, 0), (real, default, 0)] +[(integer, default, 0), (real, double, rank), (real, default, 0), (real, default, 0)] +[(real, default, 0), (real, double, rank), (real, default, 0), (real, default, 0)] +[(real, double, 0), (real, double, rank), (real, default, 0), (real, default, 0)] +[(integer, default, 0), (real, 32, rank), (real, default, 0), (real, default, 0)] +[(real, default, 0), (real, 32, rank), (real, default, 0), (real, default, 0)] +[(real, 32, 0), (real, 32, rank), (real, default, 0), (real, default, 0)] +[(integer, default, 0), (real, 64, rank), (real, default, 0), (real, default, 0)] +[(real, default, 0), (real, 64, rank), (real, default, 0), (real, default, 0)] +[(real, 64, 0), (real, 64, rank), (real, default, 0), (real, default, 0)] +[(integer, default, 0), (real, 80, rank), (real, default, 0), (real, default, 0)] +[(real, default, 0), (real, 80, rank), (real, default, 0), (real, default, 0)] +[(real, 80, 0), (real, 80, rank), (real, default, 0), (real, default, 0)] +[(integer, default, 0), (real, 128, rank), (real, default, 0), (real, default, 0)] +[(real, default, 0), (real, 128, rank), (real, default, 0), (real, default, 0)] +[(real, 128, 0), (real, 128, rank), (real, default, 0), (real, default, 0)] +[(integer, default, 0), (real, default, rank), (real, default, 0), (real, default, 0)] +[(real, default, 0), (real, default, rank), (real, default, 0), (real, default, 0)] +[(integer, default, 0), (real, double, rank), (real, double, 0), (real, double, 0)] +[(real, default, 0), (real, double, rank), (real, double, 0), (real, double, 0)] +[(real, double, 0), (real, double, rank), (real, double, 0), (real, double, 0)] +[(integer, default, 0), (real, 32, rank), (real, 32, 0), (real, 32, 0)] +[(real, default, 0), (real, 32, rank), (real, 32, 0), (real, 32, 0)] +[(real, 32, 0), (real, 32, rank), (real, 32, 0), (real, 32, 0)] +[(integer, default, 0), (real, 64, rank), (real, 64, 0), (real, 64, 0)] +[(real, default, 0), (real, 64, rank), (real, 64, 0), (real, 64, 0)] +[(real, 64, 0), (real, 64, rank), (real, 64, 0), (real, 64, 0)] +[(integer, default, 0), (real, 80, rank), (real, 80, 0), (real, 80, 0)] +[(real, default, 0), (real, 80, rank), (real, 80, 0), (real, 80, 0)] +[(real, 80, 0), (real, 80, rank), (real, 80, 0), (real, 80, 0)] +[(integer, default, 0), (real, 128, rank), (real, 128, 0), (real, 128, 0)] +[(real, default, 0), (real, 128, rank), (real, 128, 0), (real, 128, 0)] +[(real, 128, 0), (real, 128, rank), (real, 128, 0), (real, 128, 0)] +@end tkr_parameters #include "unused_dummy.fh" @@ -176,6 +249,7 @@ module pf_AssertReal_{rank}d @overload(AssertGreaterThanOrEqual, no_tol) @overload(AssertRelativelyEqual, with_tol) + @overload(assertRelMinEqual, with_rel_tol) @overload(AssertAssociated, minimal) @overload(assert_equal, minimal) @@ -185,6 +259,7 @@ module pf_AssertReal_{rank}d @overload(assert_greater_than, minimal) @overload(assert_greater_than_or_equal, minimal) @overload(assert_relatively_equal, minimal) + @overload(assert_rel_min_equal, minimal) integer, parameter :: MAX_LEN_REAL_AS_STRING = 40 @@ -981,7 +1056,97 @@ contains end subroutine {name} @end template + @template(assertRelMinEqual,[expected,actual,rel_tolerance,tolerance]) + subroutine {name}(expected, actual, rel_tolerance, tolerance, message, location) + {expected.type} (kind={expected.kind}), intent(in) :: expected {expected.dims} + {actual.type} (kind={actual.kind}), intent(in) :: actual {actual.dims} + {rel_tolerance.type} (kind={rel_tolerance.kind}), intent(in) :: rel_tolerance + {tolerance.type} (kind={tolerance.kind}), intent(in) :: tolerance + character(*), optional, intent(in) :: message + type (SourceLocation), optional, intent(in) :: location + + real(kind=kind(actual)) :: rel_t + real(kind=kind(actual)) :: t + real(kind=kind(actual)), allocatable :: e {actual.dims} + + if (.not. conformable(shape(expected), shape(actual))) then + call fail_not_conformable(shape(expected), shape(actual), message=message, location=location) + return + end if + + ! Trick to get e to have the right shape even if "expected" is a scalar. + e = 0*actual + expected + + if (any([e] == 0)) then + call fail_generic('Zero denominator detected in assertRelMinEqual.',message=message, location=location) + return + end if + + rel_t = real(rel_tolerance, kind(actual)) + t = real(tolerance, kind(actual)) + + call assert_rel_min_equal(e, actual, rel_t, t, message=message, location=location) + + end subroutine {name} + @end template + @template(assert_rel_min_equal,[actual]) + subroutine {name}(expected, actual, rel_tolerance, tolerance, unused, message, location) + {actual.type} (kind={actual.kind}), intent(in) :: expected {actual.dims} + {actual.type} (kind={actual.kind}), intent(in) :: actual {actual.dims} + {actual.type} (kind={actual.kind}), intent(in) :: rel_tolerance + {actual.type} (kind={actual.kind}), intent(in) :: tolerance + class (KeywordEnforcer), optional, intent(in) :: unused + character(*), optional, intent(in) :: message + type (SourceLocation), optional, intent(in) :: location + + real(kind=kind(actual)) :: e, a, rd, calc_eps + +#if {actual.rank} != 0 + integer, allocatable :: i(:) +#endif + character(len=MAX_LEN_REAL_AS_STRING) :: expected_str + character(len=MAX_LEN_REAL_AS_STRING) :: actual_str + character(len=3*MAX_LEN_REAL_AS_STRING) :: diff_str + + _UNUSED_DUMMY(unused) + +#if {actual.rank} == 0 + ! scalar + if (.not. (abs(actual - expected) <= max(rel_tolerance*abs(expected), tolerance))) then + e = expected + a = actual + else + return + end if + +#else + if (.not. all(abs(actual - expected) <= max(rel_tolerance*abs(expected), tolerance))) then + ! index of first difference is + i = maxloc(merge(1,0, .not. abs(actual-expected) <= max(rel_tolerance*abs(expected), tolerance))) + e = expected({actual.multi_index}) + a = actual({actual.multi_index}) + else + return + end if +#endif + calc_eps = max(rel_tolerance*abs(e), tolerance) + rd = (a - e)/e + + ! Wish: allocatable strings were useful as internal files ... + write(expected_str,'(g0)') e + write(actual_str,'(g0)') a + write(diff_str,'("<",g0,"> (greater than calculated tolerance of ",g0,")")') rd, calc_eps + +#if {actual.rank} == 0 + call fail_not_relatively_min_equal(trim(expected_str), trim(actual_str), trim(diff_str), & + & message=message, location=location) +#else + call fail_not_relatively_equal(trim(expected_str), trim(actual_str), trim(diff_str), index=i, & + & message=message, location=location) +#endif + end subroutine {name} + @end template @instantiate(AssertEqual, with_tol) @instantiate(AssertNotEqual, with_tol) @@ -990,6 +1155,7 @@ contains @instantiate(AssertGreaterThan, with_tol) @instantiate(AssertGreaterThanOrEqual, with_tol) @instantiate(AssertRelativelyEqual, with_tol) + @instantiate(assertRelMinEqual, with_rel_tol) @instantiate(AssertEqual, no_tol) @instantiate(AssertNotEqual, no_tol) @@ -1007,6 +1173,7 @@ contains @instantiate(assert_greater_than, minimal) @instantiate(assert_greater_than_or_equal, minimal) @instantiate(assert_relatively_equal, minimal) + @instantiate(assert_rel_min_equal, minimal) end module pf_AssertReal_{rank}d diff --git a/tests/funit-core/CMakeLists.txt b/tests/funit-core/CMakeLists.txt index 47f633a1..4d41403c 100644 --- a/tests/funit-core/CMakeLists.txt +++ b/tests/funit-core/CMakeLists.txt @@ -28,6 +28,7 @@ set(pf_tests Test_AssertEqual_Real.pf Test_AssertNotEqual_Real.pf Test_AssertRelativelyEqual_Real.pf + Test_AssertRelMinEqual_Real.pf Test_AssertLessThan_Real.pf Test_AssertLessThanOrEqual_Real.pf Test_AssertGreaterThan_Real.pf diff --git a/tests/funit-core/Test_AssertRelMinEqual_Real.pf b/tests/funit-core/Test_AssertRelMinEqual_Real.pf new file mode 100644 index 00000000..38093072 --- /dev/null +++ b/tests/funit-core/Test_AssertRelMinEqual_Real.pf @@ -0,0 +1,165 @@ +! Goal is not to exhaustively test all combinations, but rather at least +! one variant along each axis: +! Reference comparison: default real scalar + + +module Test_assertRelMinEqual_Real + use, intrinsic :: iso_fortran_env, only: REAL32, REAL64 + use, intrinsic :: iso_fortran_env, only: REAL128 + use pf_StringUtilities + use pf_SourceLocation + use pf_Exceptionlist + use FUnit, only: SourceLocation, throw, anyExceptions, AssertExceptionRaised + use pf_AssertBasic + use pf_AssertReal_0d + use pf_AssertReal_1d + use pf_AssertReal_2d + use pf_AssertReal_3d +#ifdef _REAL32_IEEE_SUPPORT + use MakeInf, only: makeInf_32 +#endif +#ifdef _REAL64_IEEE_SUPPORT + use MakeInf, only: makeInf_64 +#endif +#ifdef _REAL128_IEEE_SUPPORT + use MakeInf, only: makeInf_128 +#endif + implicit none + + @suite(name='assertRelMinEqual_Real_suite') + + real(kind=REAL32), parameter :: good = 1 + real(kind=REAL32), parameter :: bad = -999 + + character(len=1), parameter :: NL = new_line('a') +contains + + + ! First a series of tests that should not raise exceptions. + + + @test + subroutine test_relatively_equal_scalar() + @assertRelMinEqual(1, 1.1, 0.2, 0.2) + @assertRelMinEqual(1.0, 1.1, 0.2, 0.2) + @assertRelMinEqual(1.0, 1.1, 0.2, 0.2) + +#ifdef _REAL32 + @assertRelMinEqual(1, 1.1_REAL32, 0.2, 0.2) + @assertRelMinEqual(1.0, 1.1_REAL32, 0.2, 0.2) + @assertRelMinEqual(1.0_REAL32, 1.1_REAL32, 0.2, 0.2) + + @assertRelMinEqual(1, 1.1_REAL32, 0.2_REAL32, 0.2_REAL32) + @assertRelMinEqual(1.0, 1.1_REAL32, 0.2_REAL32, 0.2_REAL32) + @assertRelMinEqual(1.0_REAL32, 1.1_REAL32, 0.2_REAL32, 0.2_REAL32) +#endif + +#ifdef _REAL64 + @assertRelMinEqual(1, 1.1_REAL64, 0.2, 0.2) + @assertRelMinEqual(1.0, 1.1_REAL64, 0.2, 0.2) + @assertRelMinEqual(1.0_REAL64, 1.1_REAL64, 0.2, 0.2) + + @assertRelMinEqual(1, 1.1_REAL64, 0.2_REAL64, 0.2_REAL64) + @assertRelMinEqual(1.0, 1.1_REAL64, 0.2_REAL64, 0.2_REAL64) + @assertRelMinEqual(1.0_REAL64, 1.1_REAL64, 0.2_REAL64, 0.2_REAL64) +#endif + +#ifdef _REAL128 + @assertRelMinEqual(1, 1.1_REAL128, 0.2, 0.2) + @assertRelMinEqual(1.0, 1.1_REAL128, 0.2, 0.2) + @assertRelMinEqual(1.0_REAL128, 1.1_REAL128, 0.2, 0.2) + + @assertRelMinEqual(1, 1.1_REAL128, 0.2_REAL128, 0.2_REAL128) + @assertRelMinEqual(1.0, 1.1_REAL128, 0.2_REAL128, 0.2_REAL128) + @assertRelMinEqual(1.0_REAL128, 1.1_REAL128, 0.2_REAL128, 0.2_REAL128) +#endif + + end subroutine test_relatively_equal_scalar + + @test + subroutine test_relatively_equal_1D_actual + + @assertRelMinEqual(1, [1.1], 0.2, 0.2) + @assertRelMinEqual(1.0, [1.1,1.1,1.1], 0.2, 0.2) + @assertRelMinEqual(1.1, [1.1,1.1,1.1],0.2,0.2) + @assertRelMinEqual([1,2], [1.1,2.1], 0.2, 0.2) + @assertRelMinEqual([1.0,2.0], [1.1,2.1], 0.2, 0.2) + @assertRelMinEqual([1.1,2.1], [1.1,2.1], 0.2, 0.2) + +#ifdef _REAL32 + @assertRelMinEqual(1, [1.1_REAL32], 0.2, 0.2) + @assertRelMinEqual(1.0, [1.1_REAL32,1.1_REAL32,1.1_REAL32], 0.2, 0.2) + @assertRelMinEqual(1.1_REAL32, [1.1_REAL32,1.1_REAL32,1.1_REAL32],0.2,0.2) + @assertRelMinEqual([1,2], [1.1_REAL32,2.1_REAL32], 0.2, 0.2) + @assertRelMinEqual([1.0,2.0], [1.1_REAL32,2.1_REAL32], 0.2, 0.2) + @assertRelMinEqual([1.1_REAL32,2.1_REAL32], [1.1_REAL32,2.1_REAL32], 0.2, 0.2) + + @assertRelMinEqual(1, [1.1_REAL32], 0.2_REAL32, 0.2_REAL32) + @assertRelMinEqual(1.0, [1.1_REAL32,1.1_REAL32,1.1_REAL32], 0.2_REAL32, 0.2_REAL32) + @assertRelMinEqual(1.1_REAL32, [1.1_REAL32,1.1_REAL32,1.1_REAL32],0.2_REAL32,0.2_REAL32) + @assertRelMinEqual([1,2], [1.1_REAL32,2.1_REAL32], 0.2_REAL32, 0.2_REAL32) + @assertRelMinEqual([1.0,2.0], [1.1_REAL32,2.1_REAL32], 0.2_REAL32, 0.2_REAL32) + @assertRelMinEqual([1.1_REAL32,2.1_REAL32], [1.1_REAL32,2.1_REAL32], 0.2_REAL32, 0.2_REAL32) +#endif + +#ifdef _REAL64 + @assertRelMinEqual(1, [1.1_REAL64], 0.2, 0.2) + @assertRelMinEqual(1.0, [1.1_REAL64,1.1_REAL64,1.1_REAL64], 0.2, 0.2) + @assertRelMinEqual(1.1_REAL64, [1.1_REAL64,1.1_REAL64,1.1_REAL64],0.2,0.2) + @assertRelMinEqual([1,2], [1.1_REAL64,2.1_REAL64], 0.2, 0.2) + @assertRelMinEqual([1.0,2.0], [1.1_REAL64,2.1_REAL64], 0.2, 0.2) + @assertRelMinEqual([1.1_REAL64,2.1_REAL64], [1.1_REAL64,2.1_REAL64], 0.2, 0.2) + + @assertRelMinEqual(1, [1.1_REAL64], 0.2_REAL64, 0.2_REAL64) + @assertRelMinEqual(1.0, [1.1_REAL64,1.1_REAL64,1.1_REAL64], 0.2_REAL64, 0.2_REAL64) + @assertRelMinEqual(1.1_REAL64, [1.1_REAL64,1.1_REAL64,1.1_REAL64],0.2_REAL64,0.2_REAL64) + @assertRelMinEqual([1,2], [1.1_REAL64,2.1_REAL64], 0.2_REAL64, 0.2_REAL64) + @assertRelMinEqual([1.0,2.0], [1.1_REAL64,2.1_REAL64], 0.2_REAL64, 0.2_REAL64) + @assertRelMinEqual([1.1_REAL64,2.1_REAL64], [1.1_REAL64,2.1_REAL64], 0.2_REAL64, 0.2_REAL64) +#endif + +#ifdef _REAL128 + @assertRelMinEqual(1, [1.1_REAL128], 0.2, 0.2) + @assertRelMinEqual(1.0, [1.1_REAL128,1.1_REAL128,1.1_REAL128], 0.2, 0.2) + @assertRelMinEqual(1.1_REAL128, [1.1_REAL128,1.1_REAL128,1.1_REAL128],0.2,0.2) + @assertRelMinEqual([1,2], [1.1_REAL128,2.1_REAL128], 0.2, 0.2) + @assertRelMinEqual([1.0,2.0], [1.1_REAL128,2.1_REAL128], 0.2, 0.2) + @assertRelMinEqual([1.1_REAL128,2.1_REAL128], [1.1_REAL128,2.1_REAL128], 0.2, 0.2) + + @assertRelMinEqual(1, [1.1_REAL128], 0.2_REAL128, 0.2_REAL128) + @assertRelMinEqual(1.0, [1.1_REAL128,1.1_REAL128,1.1_REAL128], 0.2_REAL128, 0.2_REAL128) + @assertRelMinEqual(1.1_REAL128, [1.1_REAL128,1.1_REAL128,1.1_REAL128],0.2_REAL128,0.2_REAL128) + @assertRelMinEqual([1,2], [1.1_REAL128,2.1_REAL128], 0.2_REAL128, 0.2_REAL128) + @assertRelMinEqual([1.0,2.0], [1.1_REAL128,2.1_REAL128], 0.2_REAL128, 0.2_REAL128) + @assertRelMinEqual([1.1_REAL128,2.1_REAL128], [1.1_REAL128,2.1_REAL128], 0.2_REAL128, 0.2_REAL128) +#endif + + end subroutine test_relatively_equal_1D_actual + + + @test + subroutine test_rel_equal_fail_scalar_with_tolerance() + ! This should succeed. + call assertRelMinEqual(10.0, 11.0, 0.2, 0.2) + ! But this should fail + call assertRelMinEqual(10.0, 12.0, 0.1, 0.1) + call assertExceptionRaised(& + & 'assertRelMinEqual failure:' // NL // & + & ' Expected: <'//to_string(10.)//'>' // NL // & + & ' Actual: <'//to_string(12.)//'>' // NL // & + & ' Rel. difference: <'//to_string(0.2)//'> (greater than calculated tolerance of '//to_string(1.0)//')' & + & ) + end subroutine test_rel_equal_fail_scalar_with_tolerance + +function to_string(x) result(str) + real, intent(in) :: x + character(len=:), allocatable :: str + + character(255) :: buffer + write(buffer,'(g0)') x + str = trim(buffer) + +end function to_string + +end module Test_assertRelMinEqual_Real + diff --git a/tests/funit-core/testSuites.inc b/tests/funit-core/testSuites.inc index cfaffd80..6314cda0 100644 --- a/tests/funit-core/testSuites.inc +++ b/tests/funit-core/testSuites.inc @@ -3,6 +3,7 @@ ADD_TEST_SUITE(AssertEqual_Real_suite) ADD_TEST_SUITE(AssertNotEqual_Real_suite) ADD_TEST_SUITE(AssertRelativelyEqual_Real_suite) + ADD_TEST_SUITE(AssertRelMinEqual_Real_suite) ADD_TEST_SUITE(AssertLessThan_Real_suite) ADD_TEST_SUITE(AssertLessThanOrEqual_Real_suite) ADD_TEST_SUITE(AssertGreaterThan_Real_suite) From 20a419c09b68b8945598a2b07ef433066346f7fe Mon Sep 17 00:00:00 2001 From: Kurt Sansom Date: Wed, 12 May 2021 14:12:04 -0500 Subject: [PATCH 2/5] fix: add assert for small comparisons --- tests/funit-core/Test_AssertRelMinEqual_Real.pf | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/funit-core/Test_AssertRelMinEqual_Real.pf b/tests/funit-core/Test_AssertRelMinEqual_Real.pf index 38093072..15e4bd3d 100644 --- a/tests/funit-core/Test_AssertRelMinEqual_Real.pf +++ b/tests/funit-core/Test_AssertRelMinEqual_Real.pf @@ -43,6 +43,7 @@ contains @assertRelMinEqual(1, 1.1, 0.2, 0.2) @assertRelMinEqual(1.0, 1.1, 0.2, 0.2) @assertRelMinEqual(1.0, 1.1, 0.2, 0.2) + @assertRelMinEqual(0.005, 0.006, 0.1, 0.01) #ifdef _REAL32 @assertRelMinEqual(1, 1.1_REAL32, 0.2, 0.2) From e2b27e79ca54224a67b551c6b36af79f77d972a4 Mon Sep 17 00:00:00 2001 From: Kurt Sansom Date: Wed, 12 May 2021 15:52:57 -0500 Subject: [PATCH 3/5] fix: remove error handling for expected value --- src/funit/asserts/AssertUtilities.F90 | 2 +- src/funit/asserts/Assert_Real.tmpl | 20 +++++++++++-------- .../funit-core/Test_AssertRelMinEqual_Real.pf | 9 +++++---- 3 files changed, 18 insertions(+), 13 deletions(-) diff --git a/src/funit/asserts/AssertUtilities.F90 b/src/funit/asserts/AssertUtilities.F90 index 61d785d6..45a4b06e 100644 --- a/src/funit/asserts/AssertUtilities.F90 +++ b/src/funit/asserts/AssertUtilities.F90 @@ -359,7 +359,7 @@ subroutine fail_not_relatively_min_equal(expected, actual, difference, unused, i _UNUSED_DUMMY(unused) - fail_message = base_message('assertRelMinEqual', message, index) + fail_message = base_message('AssertRelMinEqual', message, index) fail_message = fail_message // new_line('A') // ' Expected: <' // expected // '>' fail_message = fail_message // new_line('A') // ' Actual: <' // actual // '>' fail_message = fail_message // new_line('A') // ' Rel. difference: ' // difference diff --git a/src/funit/asserts/Assert_Real.tmpl b/src/funit/asserts/Assert_Real.tmpl index bf1d0ed4..ed8a0b80 100644 --- a/src/funit/asserts/Assert_Real.tmpl +++ b/src/funit/asserts/Assert_Real.tmpl @@ -249,7 +249,7 @@ module pf_AssertReal_{rank}d @overload(AssertGreaterThanOrEqual, no_tol) @overload(AssertRelativelyEqual, with_tol) - @overload(assertRelMinEqual, with_rel_tol) + @overload(AssertRelMinEqual, with_rel_tol) @overload(AssertAssociated, minimal) @overload(assert_equal, minimal) @@ -1056,7 +1056,7 @@ contains end subroutine {name} @end template - @template(assertRelMinEqual,[expected,actual,rel_tolerance,tolerance]) + @template(AssertRelMinEqual,[expected,actual,rel_tolerance,tolerance]) subroutine {name}(expected, actual, rel_tolerance, tolerance, message, location) {expected.type} (kind={expected.kind}), intent(in) :: expected {expected.dims} {actual.type} (kind={actual.kind}), intent(in) :: actual {actual.dims} @@ -1077,10 +1077,10 @@ contains ! Trick to get e to have the right shape even if "expected" is a scalar. e = 0*actual + expected - if (any([e] == 0)) then - call fail_generic('Zero denominator detected in assertRelMinEqual.',message=message, location=location) - return - end if + !if (any([e] == 0)) then + ! call fail_generic('Small denominator detected in AssertRelMinEqual.',message=message, location=location) + ! return + !end if rel_t = real(rel_tolerance, kind(actual)) t = real(tolerance, kind(actual)) @@ -1131,7 +1131,11 @@ contains end if #endif calc_eps = max(rel_tolerance*abs(e), tolerance) - rd = (a - e)/e + if ( e > 0) then + rd = (a - e)/e + else + rd = HUGE(e) + end if ! Wish: allocatable strings were useful as internal files ... write(expected_str,'(g0)') e @@ -1155,7 +1159,7 @@ contains @instantiate(AssertGreaterThan, with_tol) @instantiate(AssertGreaterThanOrEqual, with_tol) @instantiate(AssertRelativelyEqual, with_tol) - @instantiate(assertRelMinEqual, with_rel_tol) + @instantiate(AssertRelMinEqual, with_rel_tol) @instantiate(AssertEqual, no_tol) @instantiate(AssertNotEqual, no_tol) diff --git a/tests/funit-core/Test_AssertRelMinEqual_Real.pf b/tests/funit-core/Test_AssertRelMinEqual_Real.pf index 15e4bd3d..cb0296e8 100644 --- a/tests/funit-core/Test_AssertRelMinEqual_Real.pf +++ b/tests/funit-core/Test_AssertRelMinEqual_Real.pf @@ -3,7 +3,7 @@ ! Reference comparison: default real scalar -module Test_assertRelMinEqual_Real +module Test_AssertRelMinEqual_Real use, intrinsic :: iso_fortran_env, only: REAL32, REAL64 use, intrinsic :: iso_fortran_env, only: REAL128 use pf_StringUtilities @@ -26,7 +26,7 @@ module Test_assertRelMinEqual_Real #endif implicit none - @suite(name='assertRelMinEqual_Real_suite') + @suite(name='AssertRelMinEqual_Real_suite') real(kind=REAL32), parameter :: good = 1 real(kind=REAL32), parameter :: bad = -999 @@ -44,6 +44,7 @@ contains @assertRelMinEqual(1.0, 1.1, 0.2, 0.2) @assertRelMinEqual(1.0, 1.1, 0.2, 0.2) @assertRelMinEqual(0.005, 0.006, 0.1, 0.01) + @assertRelMinEqual(0.0, 0.0, 0.1, 0.01) #ifdef _REAL32 @assertRelMinEqual(1, 1.1_REAL32, 0.2, 0.2) @@ -145,7 +146,7 @@ contains ! But this should fail call assertRelMinEqual(10.0, 12.0, 0.1, 0.1) call assertExceptionRaised(& - & 'assertRelMinEqual failure:' // NL // & + & 'AssertRelMinEqual failure:' // NL // & & ' Expected: <'//to_string(10.)//'>' // NL // & & ' Actual: <'//to_string(12.)//'>' // NL // & & ' Rel. difference: <'//to_string(0.2)//'> (greater than calculated tolerance of '//to_string(1.0)//')' & @@ -162,5 +163,5 @@ function to_string(x) result(str) end function to_string -end module Test_assertRelMinEqual_Real +end module Test_AssertRelMinEqual_Real From 6ab80566ede260519036206b0f1e8c768d6b448b Mon Sep 17 00:00:00 2001 From: Kurt Sansom Date: Mon, 17 May 2021 14:16:54 -0500 Subject: [PATCH 4/5] fix: simplify name, remove relative difference calc --- bin/funit/pFUnitParser.py | 2 +- src/funit/asserts/Assert.F90 | 2 +- src/funit/asserts/AssertUtilities.F90 | 8 +- src/funit/asserts/Assert_Real.tmpl | 63 ++++--- tests/funit-core/CMakeLists.txt | 2 +- tests/funit-core/Test_AssertApprox_Real.pf | 167 ++++++++++++++++++ .../funit-core/Test_AssertRelMinEqual_Real.pf | 167 ------------------ tests/funit-core/testSuites.inc | 2 +- 8 files changed, 212 insertions(+), 201 deletions(-) create mode 100644 tests/funit-core/Test_AssertApprox_Real.pf delete mode 100644 tests/funit-core/Test_AssertRelMinEqual_Real.pf diff --git a/bin/funit/pFUnitParser.py b/bin/funit/pFUnitParser.py index 57e5794d..c625ae6c 100755 --- a/bin/funit/pFUnitParser.py +++ b/bin/funit/pFUnitParser.py @@ -22,7 +22,7 @@ def __str__(self): 'isnan': 1, 'ismemberof': 2, 'contains': 2, 'any': 1, 'all': 1, 'notall': 1, 'none': 1, 'ispermutationof': 2, 'exceptionraised': 0, 'sameshape': 2, 'that': 2, '_that': 2, - 'relminequal': 2} + 'approx': 2} def cppSetLineAndFile(line, file): if sysconfig.get_platform() == 'mingw': diff --git a/src/funit/asserts/Assert.F90 b/src/funit/asserts/Assert.F90 index a52c6b12..7934ae12 100644 --- a/src/funit/asserts/Assert.F90 +++ b/src/funit/asserts/Assert.F90 @@ -44,7 +44,7 @@ module PF_Assert public :: assertLessThan, assertLessThanOrEqual public :: assertGreaterThan, assertGreaterThanOrEqual public :: assertRelativelyEqual - public :: assertRelMinEqual + public :: assertApprox public :: assertIsNan, assertIsFinite diff --git a/src/funit/asserts/AssertUtilities.F90 b/src/funit/asserts/AssertUtilities.F90 index 45a4b06e..cde64b44 100644 --- a/src/funit/asserts/AssertUtilities.F90 +++ b/src/funit/asserts/AssertUtilities.F90 @@ -21,7 +21,7 @@ module pf_AssertUtilities public :: fail_not_greater_than public :: fail_not_greater_than_or_equal public :: fail_not_relatively_equal - public :: fail_not_relatively_min_equal + public :: fail_not_approx contains @@ -344,7 +344,7 @@ subroutine fail_not_relatively_equal(expected, actual, difference, unused, index end subroutine fail_not_relatively_equal - subroutine fail_not_relatively_min_equal(expected, actual, difference, unused, index, message, location) + subroutine fail_not_approx(expected, actual, difference, unused, index, message, location) character(*), intent(in) :: expected character(*), intent(in) :: actual character(*), intent(in) :: difference @@ -359,7 +359,7 @@ subroutine fail_not_relatively_min_equal(expected, actual, difference, unused, i _UNUSED_DUMMY(unused) - fail_message = base_message('AssertRelMinEqual', message, index) + fail_message = base_message('AssertApprox', message, index) fail_message = fail_message // new_line('A') // ' Expected: <' // expected // '>' fail_message = fail_message // new_line('A') // ' Actual: <' // actual // '>' fail_message = fail_message // new_line('A') // ' Rel. difference: ' // difference @@ -369,7 +369,7 @@ subroutine fail_not_relatively_min_equal(expected, actual, difference, unused, i call throw(fail_message, location) - end subroutine fail_not_relatively_min_equal + end subroutine fail_not_approx function base_message(failure_type, user_message, index) result(message) character(:), allocatable :: message diff --git a/src/funit/asserts/Assert_Real.tmpl b/src/funit/asserts/Assert_Real.tmpl index ed8a0b80..359b6313 100644 --- a/src/funit/asserts/Assert_Real.tmpl +++ b/src/funit/asserts/Assert_Real.tmpl @@ -249,7 +249,7 @@ module pf_AssertReal_{rank}d @overload(AssertGreaterThanOrEqual, no_tol) @overload(AssertRelativelyEqual, with_tol) - @overload(AssertRelMinEqual, with_rel_tol) + @overload(AssertApprox, with_rel_tol) @overload(AssertAssociated, minimal) @overload(assert_equal, minimal) @@ -259,7 +259,7 @@ module pf_AssertReal_{rank}d @overload(assert_greater_than, minimal) @overload(assert_greater_than_or_equal, minimal) @overload(assert_relatively_equal, minimal) - @overload(assert_rel_min_equal, minimal) + @overload(assert_approx, minimal) integer, parameter :: MAX_LEN_REAL_AS_STRING = 40 @@ -1056,7 +1056,7 @@ contains end subroutine {name} @end template - @template(AssertRelMinEqual,[expected,actual,rel_tolerance,tolerance]) + @template(AssertApprox,[expected,actual,rel_tolerance,tolerance]) subroutine {name}(expected, actual, rel_tolerance, tolerance, message, location) {expected.type} (kind={expected.kind}), intent(in) :: expected {expected.dims} {actual.type} (kind={actual.kind}), intent(in) :: actual {actual.dims} @@ -1078,19 +1078,19 @@ contains e = 0*actual + expected !if (any([e] == 0)) then - ! call fail_generic('Small denominator detected in AssertRelMinEqual.',message=message, location=location) + ! call fail_generic('Small denominator detected in AssertApprox.',message=message, location=location) ! return !end if rel_t = real(rel_tolerance, kind(actual)) t = real(tolerance, kind(actual)) - call assert_rel_min_equal(e, actual, rel_t, t, message=message, location=location) + call assert_approx(e, actual, rel_t, t, message=message, location=location) end subroutine {name} @end template - @template(assert_rel_min_equal,[actual]) + @template(assert_approx,[actual]) subroutine {name}(expected, actual, rel_tolerance, tolerance, unused, message, location) {actual.type} (kind={actual.kind}), intent(in) :: expected {actual.dims} {actual.type} (kind={actual.kind}), intent(in) :: actual {actual.dims} @@ -1100,10 +1100,11 @@ contains character(*), optional, intent(in) :: message type (SourceLocation), optional, intent(in) :: location - real(kind=kind(actual)) :: e, a, rd, calc_eps + real(kind=kind(actual)) :: e, a, d, calc_eps #if {actual.rank} != 0 integer, allocatable :: i(:) + logical, allocatable :: within_tolerance {actual.dims} #endif character(len=MAX_LEN_REAL_AS_STRING) :: expected_str character(len=MAX_LEN_REAL_AS_STRING) :: actual_str @@ -1112,7 +1113,11 @@ contains _UNUSED_DUMMY(unused) #if {actual.rank} == 0 - ! scalar + ! Scalar + ! Handle exact equality separately to avoid subtracting Inf values. + ! (Inf - Inf is undefined.) + if (actual == expected) return + if (.not. (abs(actual - expected) <= max(rel_tolerance*abs(expected), tolerance))) then e = expected a = actual @@ -1121,32 +1126,38 @@ contains end if #else - if (.not. all(abs(actual - expected) <= max(rel_tolerance*abs(expected), tolerance))) then - ! index of first difference is - i = maxloc(merge(1,0, .not. abs(actual-expected) <= max(rel_tolerance*abs(expected), tolerance))) - e = expected({actual.multi_index}) - a = actual({actual.multi_index}) - else - return - end if + ! Handle exact equality separately to avoid subtracting Inf values. + ! (Inf - Inf is undefined.) + + allocate(within_tolerance, mold=(actual==actual)) + where (actual == expected) + within_tolerance = .true. + elsewhere (abs(actual-expected) <= max(rel_tolerance*abs(expected), tolerance)) + within_tolerance = .true. + elsewhere + within_tolerance = .false. + end where + + if (all(within_tolerance)) return + + ! index of first difference is + i = maxloc(merge(1,0, .not. abs(actual-expected) <= max(rel_tolerance*abs(expected), tolerance))) + e = expected({actual.multi_index}) + a = actual({actual.multi_index}) #endif calc_eps = max(rel_tolerance*abs(e), tolerance) - if ( e > 0) then - rd = (a - e)/e - else - rd = HUGE(e) - end if + d = (a - e) ! Wish: allocatable strings were useful as internal files ... write(expected_str,'(g0)') e write(actual_str,'(g0)') a - write(diff_str,'("<",g0,"> (greater than calculated tolerance of ",g0,")")') rd, calc_eps + write(diff_str,'("<",g0,"> (greater than calculated tolerance of ",g0,")")') d, calc_eps #if {actual.rank} == 0 - call fail_not_relatively_min_equal(trim(expected_str), trim(actual_str), trim(diff_str), & + call fail_not_approx(trim(expected_str), trim(actual_str), trim(diff_str), & & message=message, location=location) #else - call fail_not_relatively_equal(trim(expected_str), trim(actual_str), trim(diff_str), index=i, & + call fail_not_approx(trim(expected_str), trim(actual_str), trim(diff_str), index=i, & & message=message, location=location) #endif end subroutine {name} @@ -1159,7 +1170,7 @@ contains @instantiate(AssertGreaterThan, with_tol) @instantiate(AssertGreaterThanOrEqual, with_tol) @instantiate(AssertRelativelyEqual, with_tol) - @instantiate(AssertRelMinEqual, with_rel_tol) + @instantiate(AssertApprox, with_rel_tol) @instantiate(AssertEqual, no_tol) @instantiate(AssertNotEqual, no_tol) @@ -1177,7 +1188,7 @@ contains @instantiate(assert_greater_than, minimal) @instantiate(assert_greater_than_or_equal, minimal) @instantiate(assert_relatively_equal, minimal) - @instantiate(assert_rel_min_equal, minimal) + @instantiate(assert_approx, minimal) end module pf_AssertReal_{rank}d diff --git a/tests/funit-core/CMakeLists.txt b/tests/funit-core/CMakeLists.txt index 4d41403c..84b64965 100644 --- a/tests/funit-core/CMakeLists.txt +++ b/tests/funit-core/CMakeLists.txt @@ -28,7 +28,7 @@ set(pf_tests Test_AssertEqual_Real.pf Test_AssertNotEqual_Real.pf Test_AssertRelativelyEqual_Real.pf - Test_AssertRelMinEqual_Real.pf + Test_AssertApprox_Real.pf Test_AssertLessThan_Real.pf Test_AssertLessThanOrEqual_Real.pf Test_AssertGreaterThan_Real.pf diff --git a/tests/funit-core/Test_AssertApprox_Real.pf b/tests/funit-core/Test_AssertApprox_Real.pf new file mode 100644 index 00000000..efc05120 --- /dev/null +++ b/tests/funit-core/Test_AssertApprox_Real.pf @@ -0,0 +1,167 @@ +! Goal is not to exhaustively test all combinations, but rather at least +! one variant along each axis: +! Reference comparison: default real scalar + + +module Test_AssertApprox_Real + use, intrinsic :: iso_fortran_env, only: REAL32, REAL64 + use, intrinsic :: iso_fortran_env, only: REAL128 + use pf_StringUtilities + use pf_SourceLocation + use pf_Exceptionlist + use FUnit, only: SourceLocation, throw, anyExceptions, AssertExceptionRaised + use pf_AssertBasic + use pf_AssertReal_0d + use pf_AssertReal_1d + use pf_AssertReal_2d + use pf_AssertReal_3d +#ifdef _REAL32_IEEE_SUPPORT + use MakeInf, only: makeInf_32 +#endif +#ifdef _REAL64_IEEE_SUPPORT + use MakeInf, only: makeInf_64 +#endif +#ifdef _REAL128_IEEE_SUPPORT + use MakeInf, only: makeInf_128 +#endif + implicit none + + @suite(name='AssertApprox_Real_suite') + + real(kind=REAL32), parameter :: good = 1 + real(kind=REAL32), parameter :: bad = -999 + + character(len=1), parameter :: NL = new_line('a') +contains + + + ! First a series of tests that should not raise exceptions. + + + @test + subroutine test_relatively_equal_scalar() + @assertApprox(1, 1.1, 0.2, 0.2) + @assertApprox(1.0, 1.1, 0.2, 0.2) + @assertApprox(1.0, 1.1, 0.2, 0.2) + @assertApprox(0.005, 0.006, 0.1, 0.01) + @assertApprox(0.0, 0.0, 0.1, 0.01) + +#ifdef _REAL32 + @assertApprox(1, 1.1_REAL32, 0.2, 0.2) + @assertApprox(1.0, 1.1_REAL32, 0.2, 0.2) + @assertApprox(1.0_REAL32, 1.1_REAL32, 0.2, 0.2) + + @assertApprox(1, 1.1_REAL32, 0.2_REAL32, 0.2_REAL32) + @assertApprox(1.0, 1.1_REAL32, 0.2_REAL32, 0.2_REAL32) + @assertApprox(1.0_REAL32, 1.1_REAL32, 0.2_REAL32, 0.2_REAL32) +#endif + +#ifdef _REAL64 + @assertApprox(1, 1.1_REAL64, 0.2, 0.2) + @assertApprox(1.0, 1.1_REAL64, 0.2, 0.2) + @assertApprox(1.0_REAL64, 1.1_REAL64, 0.2, 0.2) + + @assertApprox(1, 1.1_REAL64, 0.2_REAL64, 0.2_REAL64) + @assertApprox(1.0, 1.1_REAL64, 0.2_REAL64, 0.2_REAL64) + @assertApprox(1.0_REAL64, 1.1_REAL64, 0.2_REAL64, 0.2_REAL64) +#endif + +#ifdef _REAL128 + @assertApprox(1, 1.1_REAL128, 0.2, 0.2) + @assertApprox(1.0, 1.1_REAL128, 0.2, 0.2) + @assertApprox(1.0_REAL128, 1.1_REAL128, 0.2, 0.2) + + @assertApprox(1, 1.1_REAL128, 0.2_REAL128, 0.2_REAL128) + @assertApprox(1.0, 1.1_REAL128, 0.2_REAL128, 0.2_REAL128) + @assertApprox(1.0_REAL128, 1.1_REAL128, 0.2_REAL128, 0.2_REAL128) +#endif + + end subroutine test_relatively_equal_scalar + + @test + subroutine test_relatively_equal_1D_actual + + @assertApprox(1, [1.1], 0.2, 0.2) + @assertApprox(1.0, [1.1,1.1,1.1], 0.2, 0.2) + @assertApprox(1.1, [1.1,1.1,1.1],0.2,0.2) + @assertApprox([1,2], [1.1,2.1], 0.2, 0.2) + @assertApprox([1.0,2.0], [1.1,2.1], 0.2, 0.2) + @assertApprox([1.1,2.1], [1.1,2.1], 0.2, 0.2) + +#ifdef _REAL32 + @assertApprox(1, [1.1_REAL32], 0.2, 0.2) + @assertApprox(1.0, [1.1_REAL32,1.1_REAL32,1.1_REAL32], 0.2, 0.2) + @assertApprox(1.1_REAL32, [1.1_REAL32,1.1_REAL32,1.1_REAL32],0.2,0.2) + @assertApprox([1,2], [1.1_REAL32,2.1_REAL32], 0.2, 0.2) + @assertApprox([1.0,2.0], [1.1_REAL32,2.1_REAL32], 0.2, 0.2) + @assertApprox([1.1_REAL32,2.1_REAL32], [1.1_REAL32,2.1_REAL32], 0.2, 0.2) + + @assertApprox(1, [1.1_REAL32], 0.2_REAL32, 0.2_REAL32) + @assertApprox(1.0, [1.1_REAL32,1.1_REAL32,1.1_REAL32], 0.2_REAL32, 0.2_REAL32) + @assertApprox(1.1_REAL32, [1.1_REAL32,1.1_REAL32,1.1_REAL32],0.2_REAL32,0.2_REAL32) + @assertApprox([1,2], [1.1_REAL32,2.1_REAL32], 0.2_REAL32, 0.2_REAL32) + @assertApprox([1.0,2.0], [1.1_REAL32,2.1_REAL32], 0.2_REAL32, 0.2_REAL32) + @assertApprox([1.1_REAL32,2.1_REAL32], [1.1_REAL32,2.1_REAL32], 0.2_REAL32, 0.2_REAL32) +#endif + +#ifdef _REAL64 + @assertApprox(1, [1.1_REAL64], 0.2, 0.2) + @assertApprox(1.0, [1.1_REAL64,1.1_REAL64,1.1_REAL64], 0.2, 0.2) + @assertApprox(1.1_REAL64, [1.1_REAL64,1.1_REAL64,1.1_REAL64],0.2,0.2) + @assertApprox([1,2], [1.1_REAL64,2.1_REAL64], 0.2, 0.2) + @assertApprox([1.0,2.0], [1.1_REAL64,2.1_REAL64], 0.2, 0.2) + @assertApprox([1.1_REAL64,2.1_REAL64], [1.1_REAL64,2.1_REAL64], 0.2, 0.2) + + @assertApprox(1, [1.1_REAL64], 0.2_REAL64, 0.2_REAL64) + @assertApprox(1.0, [1.1_REAL64,1.1_REAL64,1.1_REAL64], 0.2_REAL64, 0.2_REAL64) + @assertApprox(1.1_REAL64, [1.1_REAL64,1.1_REAL64,1.1_REAL64],0.2_REAL64,0.2_REAL64) + @assertApprox([1,2], [1.1_REAL64,2.1_REAL64], 0.2_REAL64, 0.2_REAL64) + @assertApprox([1.0,2.0], [1.1_REAL64,2.1_REAL64], 0.2_REAL64, 0.2_REAL64) + @assertApprox([1.1_REAL64,2.1_REAL64], [1.1_REAL64,2.1_REAL64], 0.2_REAL64, 0.2_REAL64) +#endif + +#ifdef _REAL128 + @assertApprox(1, [1.1_REAL128], 0.2, 0.2) + @assertApprox(1.0, [1.1_REAL128,1.1_REAL128,1.1_REAL128], 0.2, 0.2) + @assertApprox(1.1_REAL128, [1.1_REAL128,1.1_REAL128,1.1_REAL128],0.2,0.2) + @assertApprox([1,2], [1.1_REAL128,2.1_REAL128], 0.2, 0.2) + @assertApprox([1.0,2.0], [1.1_REAL128,2.1_REAL128], 0.2, 0.2) + @assertApprox([1.1_REAL128,2.1_REAL128], [1.1_REAL128,2.1_REAL128], 0.2, 0.2) + + @assertApprox(1, [1.1_REAL128], 0.2_REAL128, 0.2_REAL128) + @assertApprox(1.0, [1.1_REAL128,1.1_REAL128,1.1_REAL128], 0.2_REAL128, 0.2_REAL128) + @assertApprox(1.1_REAL128, [1.1_REAL128,1.1_REAL128,1.1_REAL128],0.2_REAL128,0.2_REAL128) + @assertApprox([1,2], [1.1_REAL128,2.1_REAL128], 0.2_REAL128, 0.2_REAL128) + @assertApprox([1.0,2.0], [1.1_REAL128,2.1_REAL128], 0.2_REAL128, 0.2_REAL128) + @assertApprox([1.1_REAL128,2.1_REAL128], [1.1_REAL128,2.1_REAL128], 0.2_REAL128, 0.2_REAL128) +#endif + + end subroutine test_relatively_equal_1D_actual + + + @test + subroutine test_rel_equal_fail_scalar_with_tolerance() + ! This should succeed. + call assertApprox(10.0, 11.0, 0.2, 0.2) + ! But this should fail + call assertApprox(10.0, 12.0, 0.1, 0.1) + call assertExceptionRaised(& + & 'AssertApprox failure:' // NL // & + & ' Expected: <'//to_string(10.)//'>' // NL // & + & ' Actual: <'//to_string(12.)//'>' // NL // & + & ' Rel. difference: <'//to_string(2.0)//'> (greater than calculated tolerance of '//to_string(1.0)//')' & + & ) + end subroutine test_rel_equal_fail_scalar_with_tolerance + +function to_string(x) result(str) + real, intent(in) :: x + character(len=:), allocatable :: str + + character(255) :: buffer + write(buffer,'(g0)') x + str = trim(buffer) + +end function to_string + +end module Test_AssertApprox_Real + diff --git a/tests/funit-core/Test_AssertRelMinEqual_Real.pf b/tests/funit-core/Test_AssertRelMinEqual_Real.pf deleted file mode 100644 index cb0296e8..00000000 --- a/tests/funit-core/Test_AssertRelMinEqual_Real.pf +++ /dev/null @@ -1,167 +0,0 @@ -! Goal is not to exhaustively test all combinations, but rather at least -! one variant along each axis: -! Reference comparison: default real scalar - - -module Test_AssertRelMinEqual_Real - use, intrinsic :: iso_fortran_env, only: REAL32, REAL64 - use, intrinsic :: iso_fortran_env, only: REAL128 - use pf_StringUtilities - use pf_SourceLocation - use pf_Exceptionlist - use FUnit, only: SourceLocation, throw, anyExceptions, AssertExceptionRaised - use pf_AssertBasic - use pf_AssertReal_0d - use pf_AssertReal_1d - use pf_AssertReal_2d - use pf_AssertReal_3d -#ifdef _REAL32_IEEE_SUPPORT - use MakeInf, only: makeInf_32 -#endif -#ifdef _REAL64_IEEE_SUPPORT - use MakeInf, only: makeInf_64 -#endif -#ifdef _REAL128_IEEE_SUPPORT - use MakeInf, only: makeInf_128 -#endif - implicit none - - @suite(name='AssertRelMinEqual_Real_suite') - - real(kind=REAL32), parameter :: good = 1 - real(kind=REAL32), parameter :: bad = -999 - - character(len=1), parameter :: NL = new_line('a') -contains - - - ! First a series of tests that should not raise exceptions. - - - @test - subroutine test_relatively_equal_scalar() - @assertRelMinEqual(1, 1.1, 0.2, 0.2) - @assertRelMinEqual(1.0, 1.1, 0.2, 0.2) - @assertRelMinEqual(1.0, 1.1, 0.2, 0.2) - @assertRelMinEqual(0.005, 0.006, 0.1, 0.01) - @assertRelMinEqual(0.0, 0.0, 0.1, 0.01) - -#ifdef _REAL32 - @assertRelMinEqual(1, 1.1_REAL32, 0.2, 0.2) - @assertRelMinEqual(1.0, 1.1_REAL32, 0.2, 0.2) - @assertRelMinEqual(1.0_REAL32, 1.1_REAL32, 0.2, 0.2) - - @assertRelMinEqual(1, 1.1_REAL32, 0.2_REAL32, 0.2_REAL32) - @assertRelMinEqual(1.0, 1.1_REAL32, 0.2_REAL32, 0.2_REAL32) - @assertRelMinEqual(1.0_REAL32, 1.1_REAL32, 0.2_REAL32, 0.2_REAL32) -#endif - -#ifdef _REAL64 - @assertRelMinEqual(1, 1.1_REAL64, 0.2, 0.2) - @assertRelMinEqual(1.0, 1.1_REAL64, 0.2, 0.2) - @assertRelMinEqual(1.0_REAL64, 1.1_REAL64, 0.2, 0.2) - - @assertRelMinEqual(1, 1.1_REAL64, 0.2_REAL64, 0.2_REAL64) - @assertRelMinEqual(1.0, 1.1_REAL64, 0.2_REAL64, 0.2_REAL64) - @assertRelMinEqual(1.0_REAL64, 1.1_REAL64, 0.2_REAL64, 0.2_REAL64) -#endif - -#ifdef _REAL128 - @assertRelMinEqual(1, 1.1_REAL128, 0.2, 0.2) - @assertRelMinEqual(1.0, 1.1_REAL128, 0.2, 0.2) - @assertRelMinEqual(1.0_REAL128, 1.1_REAL128, 0.2, 0.2) - - @assertRelMinEqual(1, 1.1_REAL128, 0.2_REAL128, 0.2_REAL128) - @assertRelMinEqual(1.0, 1.1_REAL128, 0.2_REAL128, 0.2_REAL128) - @assertRelMinEqual(1.0_REAL128, 1.1_REAL128, 0.2_REAL128, 0.2_REAL128) -#endif - - end subroutine test_relatively_equal_scalar - - @test - subroutine test_relatively_equal_1D_actual - - @assertRelMinEqual(1, [1.1], 0.2, 0.2) - @assertRelMinEqual(1.0, [1.1,1.1,1.1], 0.2, 0.2) - @assertRelMinEqual(1.1, [1.1,1.1,1.1],0.2,0.2) - @assertRelMinEqual([1,2], [1.1,2.1], 0.2, 0.2) - @assertRelMinEqual([1.0,2.0], [1.1,2.1], 0.2, 0.2) - @assertRelMinEqual([1.1,2.1], [1.1,2.1], 0.2, 0.2) - -#ifdef _REAL32 - @assertRelMinEqual(1, [1.1_REAL32], 0.2, 0.2) - @assertRelMinEqual(1.0, [1.1_REAL32,1.1_REAL32,1.1_REAL32], 0.2, 0.2) - @assertRelMinEqual(1.1_REAL32, [1.1_REAL32,1.1_REAL32,1.1_REAL32],0.2,0.2) - @assertRelMinEqual([1,2], [1.1_REAL32,2.1_REAL32], 0.2, 0.2) - @assertRelMinEqual([1.0,2.0], [1.1_REAL32,2.1_REAL32], 0.2, 0.2) - @assertRelMinEqual([1.1_REAL32,2.1_REAL32], [1.1_REAL32,2.1_REAL32], 0.2, 0.2) - - @assertRelMinEqual(1, [1.1_REAL32], 0.2_REAL32, 0.2_REAL32) - @assertRelMinEqual(1.0, [1.1_REAL32,1.1_REAL32,1.1_REAL32], 0.2_REAL32, 0.2_REAL32) - @assertRelMinEqual(1.1_REAL32, [1.1_REAL32,1.1_REAL32,1.1_REAL32],0.2_REAL32,0.2_REAL32) - @assertRelMinEqual([1,2], [1.1_REAL32,2.1_REAL32], 0.2_REAL32, 0.2_REAL32) - @assertRelMinEqual([1.0,2.0], [1.1_REAL32,2.1_REAL32], 0.2_REAL32, 0.2_REAL32) - @assertRelMinEqual([1.1_REAL32,2.1_REAL32], [1.1_REAL32,2.1_REAL32], 0.2_REAL32, 0.2_REAL32) -#endif - -#ifdef _REAL64 - @assertRelMinEqual(1, [1.1_REAL64], 0.2, 0.2) - @assertRelMinEqual(1.0, [1.1_REAL64,1.1_REAL64,1.1_REAL64], 0.2, 0.2) - @assertRelMinEqual(1.1_REAL64, [1.1_REAL64,1.1_REAL64,1.1_REAL64],0.2,0.2) - @assertRelMinEqual([1,2], [1.1_REAL64,2.1_REAL64], 0.2, 0.2) - @assertRelMinEqual([1.0,2.0], [1.1_REAL64,2.1_REAL64], 0.2, 0.2) - @assertRelMinEqual([1.1_REAL64,2.1_REAL64], [1.1_REAL64,2.1_REAL64], 0.2, 0.2) - - @assertRelMinEqual(1, [1.1_REAL64], 0.2_REAL64, 0.2_REAL64) - @assertRelMinEqual(1.0, [1.1_REAL64,1.1_REAL64,1.1_REAL64], 0.2_REAL64, 0.2_REAL64) - @assertRelMinEqual(1.1_REAL64, [1.1_REAL64,1.1_REAL64,1.1_REAL64],0.2_REAL64,0.2_REAL64) - @assertRelMinEqual([1,2], [1.1_REAL64,2.1_REAL64], 0.2_REAL64, 0.2_REAL64) - @assertRelMinEqual([1.0,2.0], [1.1_REAL64,2.1_REAL64], 0.2_REAL64, 0.2_REAL64) - @assertRelMinEqual([1.1_REAL64,2.1_REAL64], [1.1_REAL64,2.1_REAL64], 0.2_REAL64, 0.2_REAL64) -#endif - -#ifdef _REAL128 - @assertRelMinEqual(1, [1.1_REAL128], 0.2, 0.2) - @assertRelMinEqual(1.0, [1.1_REAL128,1.1_REAL128,1.1_REAL128], 0.2, 0.2) - @assertRelMinEqual(1.1_REAL128, [1.1_REAL128,1.1_REAL128,1.1_REAL128],0.2,0.2) - @assertRelMinEqual([1,2], [1.1_REAL128,2.1_REAL128], 0.2, 0.2) - @assertRelMinEqual([1.0,2.0], [1.1_REAL128,2.1_REAL128], 0.2, 0.2) - @assertRelMinEqual([1.1_REAL128,2.1_REAL128], [1.1_REAL128,2.1_REAL128], 0.2, 0.2) - - @assertRelMinEqual(1, [1.1_REAL128], 0.2_REAL128, 0.2_REAL128) - @assertRelMinEqual(1.0, [1.1_REAL128,1.1_REAL128,1.1_REAL128], 0.2_REAL128, 0.2_REAL128) - @assertRelMinEqual(1.1_REAL128, [1.1_REAL128,1.1_REAL128,1.1_REAL128],0.2_REAL128,0.2_REAL128) - @assertRelMinEqual([1,2], [1.1_REAL128,2.1_REAL128], 0.2_REAL128, 0.2_REAL128) - @assertRelMinEqual([1.0,2.0], [1.1_REAL128,2.1_REAL128], 0.2_REAL128, 0.2_REAL128) - @assertRelMinEqual([1.1_REAL128,2.1_REAL128], [1.1_REAL128,2.1_REAL128], 0.2_REAL128, 0.2_REAL128) -#endif - - end subroutine test_relatively_equal_1D_actual - - - @test - subroutine test_rel_equal_fail_scalar_with_tolerance() - ! This should succeed. - call assertRelMinEqual(10.0, 11.0, 0.2, 0.2) - ! But this should fail - call assertRelMinEqual(10.0, 12.0, 0.1, 0.1) - call assertExceptionRaised(& - & 'AssertRelMinEqual failure:' // NL // & - & ' Expected: <'//to_string(10.)//'>' // NL // & - & ' Actual: <'//to_string(12.)//'>' // NL // & - & ' Rel. difference: <'//to_string(0.2)//'> (greater than calculated tolerance of '//to_string(1.0)//')' & - & ) - end subroutine test_rel_equal_fail_scalar_with_tolerance - -function to_string(x) result(str) - real, intent(in) :: x - character(len=:), allocatable :: str - - character(255) :: buffer - write(buffer,'(g0)') x - str = trim(buffer) - -end function to_string - -end module Test_AssertRelMinEqual_Real - diff --git a/tests/funit-core/testSuites.inc b/tests/funit-core/testSuites.inc index 6314cda0..097216ea 100644 --- a/tests/funit-core/testSuites.inc +++ b/tests/funit-core/testSuites.inc @@ -3,7 +3,7 @@ ADD_TEST_SUITE(AssertEqual_Real_suite) ADD_TEST_SUITE(AssertNotEqual_Real_suite) ADD_TEST_SUITE(AssertRelativelyEqual_Real_suite) - ADD_TEST_SUITE(AssertRelMinEqual_Real_suite) + ADD_TEST_SUITE(AssertApprox_Real_suite) ADD_TEST_SUITE(AssertLessThan_Real_suite) ADD_TEST_SUITE(AssertLessThanOrEqual_Real_suite) ADD_TEST_SUITE(AssertGreaterThan_Real_suite) From 0dd5b88c4a1518541b4562f06f0611f524066bb9 Mon Sep 17 00:00:00 2001 From: Kurt Sansom Date: Mon, 17 May 2021 14:22:41 -0500 Subject: [PATCH 5/5] fix: update not_approx error message --- src/funit/asserts/AssertUtilities.F90 | 2 +- tests/funit-core/Test_AssertApprox_Real.pf | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/funit/asserts/AssertUtilities.F90 b/src/funit/asserts/AssertUtilities.F90 index cde64b44..4b7c2291 100644 --- a/src/funit/asserts/AssertUtilities.F90 +++ b/src/funit/asserts/AssertUtilities.F90 @@ -362,7 +362,7 @@ subroutine fail_not_approx(expected, actual, difference, unused, index, message, fail_message = base_message('AssertApprox', message, index) fail_message = fail_message // new_line('A') // ' Expected: <' // expected // '>' fail_message = fail_message // new_line('A') // ' Actual: <' // actual // '>' - fail_message = fail_message // new_line('A') // ' Rel. difference: ' // difference + fail_message = fail_message // new_line('A') // ' Difference: ' // difference if (present(index)) then fail_message = fail_message // new_line('A') // ' at index: ' // toString(index) end if diff --git a/tests/funit-core/Test_AssertApprox_Real.pf b/tests/funit-core/Test_AssertApprox_Real.pf index efc05120..409e29d3 100644 --- a/tests/funit-core/Test_AssertApprox_Real.pf +++ b/tests/funit-core/Test_AssertApprox_Real.pf @@ -149,7 +149,7 @@ contains & 'AssertApprox failure:' // NL // & & ' Expected: <'//to_string(10.)//'>' // NL // & & ' Actual: <'//to_string(12.)//'>' // NL // & - & ' Rel. difference: <'//to_string(2.0)//'> (greater than calculated tolerance of '//to_string(1.0)//')' & + & ' Difference: <'//to_string(2.0)//'> (greater than calculated tolerance of '//to_string(1.0)//')' & & ) end subroutine test_rel_equal_fail_scalar_with_tolerance