Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
46 changes: 46 additions & 0 deletions src/julienne/julienne_test_diagnosis_m.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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.)
Expand Down Expand Up @@ -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)
Expand Down
64 changes: 62 additions & 2 deletions src/julienne/julienne_test_diagnosis_s.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down
4 changes: 3 additions & 1 deletion src/julienne_m.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
73 changes: 51 additions & 22 deletions test/test_diagnosis_test_m.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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.) &
Expand Down Expand Up @@ -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) &
Expand All @@ -66,32 +72,31 @@ 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 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 .withinPercentage. tolerance'", check_approximates_real_percentage_ptr) &
,test_description_t("construction from the double precision expression 'x .approximates. y .withinPercentage. tolerance'", check_approximates_double_percentage_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) &
Expand Down Expand Up @@ -143,6 +148,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
Expand Down