Skip to content

Commit 8d23cf5

Browse files
rousonrouson
committed
feat(test_diagnosis): add comparison operators
This commit adds user-defined operators and corresponding unit tests. The operators that support statements of the form type(test_diagnosis_t) test_diagnosis test_diagnosis = x .approximates. y .within. tolerance for real and double-precsision operands x, y, and tolerance and test_diagnosis = i .equalsExpected. j for integer operand i and j. The right-hand side expressions above evaluate to test_diagnostics_t objects with diagnostics_string_ components formed with the assumption that x and i are actual computed values y and j corresponding expected values, respectively.
1 parent bd10da6 commit 8d23cf5

5 files changed

Lines changed: 230 additions & 19 deletions

File tree

src/julienne/julienne_test_diagnosis_m.F90 renamed to src/julienne/julienne_test_diagnosis_m.f90

Lines changed: 54 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,9 @@ module julienne_test_diagnosis_m
77

88
private
99
public :: test_diagnosis_t
10+
public :: operator(.approximates.)
11+
public :: operator(.within.)
12+
public :: operator(.equalsExpected.)
1013

1114
type test_diagnosis_t
1215
!! Encapsulate test outcome and diagnostic information
@@ -18,6 +21,57 @@ module julienne_test_diagnosis_m
1821
procedure diagnostics_string
1922
end type
2023

24+
integer, parameter :: default_real = kind(1.), double_precision = kind(1D0)
25+
26+
type operands_t(k)
27+
integer, kind :: k = default_real
28+
real(k) actual, expected
29+
end type
30+
31+
interface operator(.approximates.)
32+
33+
pure module function approximates_real(actual, expected) result(operands)
34+
implicit none
35+
real, intent(in) :: actual, expected
36+
type(operands_t) operands
37+
end function
38+
39+
pure module function approximates_double_precision(actual, expected) result(operands)
40+
implicit none
41+
double precision, intent(in) :: actual, expected
42+
type(operands_t(double_precision)) operands
43+
end function
44+
45+
end interface
46+
47+
interface operator(.equalsExpected.)
48+
49+
pure module function equals_expected_integer(actual, expected) result(test_diagnosis)
50+
implicit none
51+
integer, intent(in) :: actual, expected
52+
type(test_diagnosis_t) test_diagnosis
53+
end function
54+
55+
end interface
56+
57+
interface operator(.within.)
58+
59+
pure module function within_real(operands, tolerance) result(test_diagnosis)
60+
implicit none
61+
type(operands_t), intent(in) :: operands
62+
real, intent(in) :: tolerance
63+
type(test_diagnosis_t) test_diagnosis
64+
end function
65+
66+
pure module function within_double_precision(operands, tolerance) result(test_diagnosis)
67+
implicit none
68+
type(operands_t(double_precision)), intent(in) :: operands
69+
double precision, intent(in) :: tolerance
70+
type(test_diagnosis_t) test_diagnosis
71+
end function
72+
73+
end interface
74+
2175
interface test_diagnosis_t
2276

2377
elemental module function construct_from_string_t(test_passed, diagnostics_string) result(test_diagnosis)

‎src/julienne/julienne_test_diagnosis_s.F90‎

Lines changed: 67 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -7,22 +7,71 @@
77
use assert_m
88
implicit none
99
contains
10-
module procedure construct_from_string_t
11-
test_diagnosis%test_passed_ = test_passed
12-
test_diagnosis%diagnostics_string_ = diagnostics_string
13-
end procedure
14-
15-
module procedure construct_from_character
16-
test_diagnosis%test_passed_ = test_passed
17-
test_diagnosis%diagnostics_string_ = diagnostics_string
18-
end procedure
19-
20-
module procedure test_passed
21-
passed = self%test_passed_
22-
end procedure
23-
24-
module procedure diagnostics_string
25-
call_assert(allocated(self%diagnostics_string_))
26-
string_ = string_t(self%diagnostics_string_)
27-
end procedure
10+
11+
module procedure approximates_real
12+
operands = operands_t(actual, expected)
13+
end procedure
14+
15+
module procedure approximates_double_precision
16+
operands = operands_t(double_precision)(actual, expected)
17+
end procedure
18+
19+
module procedure equals_expected_integer
20+
21+
if (actual == expected) then
22+
test_diagnosis = test_diagnosis_t(test_passed=.true., diagnostics_string="")
23+
else
24+
test_diagnosis = test_diagnosis_t(test_passed = .false. &
25+
,diagnostics_string = "expected " // string_t(expected) // "; actual value is " // string_t(actual) &
26+
)
27+
end if
28+
29+
end procedure
30+
31+
module procedure within_real
32+
33+
if (abs(operands%actual - operands%expected) < tolerance) then
34+
test_diagnosis = test_diagnosis_t(test_passed=.true., diagnostics_string="")
35+
else
36+
test_diagnosis = test_diagnosis_t(test_passed=.false. &
37+
,diagnostics_string = "expected " // string_t(operands%expected) &
38+
// "within a tolerance of " // string_t(tolerance) &
39+
// "; actual value is " // string_t(operands%actual) &
40+
)
41+
end if
42+
43+
end procedure
44+
45+
module procedure within_double_precision
46+
47+
if (abs(operands%actual - operands%expected) < tolerance) then
48+
test_diagnosis = test_diagnosis_t(test_passed=.true., diagnostics_string="")
49+
else
50+
test_diagnosis = test_diagnosis_t(test_passed=.false. &
51+
,diagnostics_string = "expected " // string_t(operands%expected) &
52+
// "within a tolerance of " // string_t(tolerance) &
53+
// "; actual value is " // string_t(operands%actual) &
54+
)
55+
end if
56+
57+
end procedure
58+
59+
module procedure construct_from_string_t
60+
test_diagnosis%test_passed_ = test_passed
61+
test_diagnosis%diagnostics_string_ = diagnostics_string
62+
end procedure
63+
64+
module procedure construct_from_character
65+
test_diagnosis%test_passed_ = test_passed
66+
test_diagnosis%diagnostics_string_ = diagnostics_string
67+
end procedure
68+
69+
module procedure test_passed
70+
passed = self%test_passed_
71+
end procedure
72+
73+
module procedure diagnostics_string
74+
call_assert(allocated(self%diagnostics_string_))
75+
string_ = string_t(self%diagnostics_string_)
76+
end procedure
2877
end submodule julienne_test_diagnosis_s

‎src/julienne_m.f90‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,7 @@ module julienne_m
1010
use julienne_string_m, only : string_t, operator(.cat.), operator(.csv.), operator(.sv.)
1111
use julienne_test_m, only : test_t, test_description_substring
1212
use julienne_test_description_m, only : test_description_t, diagnosis_function_i
13-
use julienne_test_diagnosis_m, only : test_diagnosis_t
13+
use julienne_test_diagnosis_m, only : test_diagnosis_t, operator(.approximates.), operator(.within.), operator(.equalsExpected.)
1414
use julienne_test_result_m, only : test_result_t
1515
use julienne_vector_test_description_m, only : vector_test_description_t, vector_diagnosis_function_i
1616
implicit none

‎test/main.F90‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -16,6 +16,7 @@ program main
1616
use string_test_m ,only : string_test_t
1717
use test_result_test_m ,only : test_result_test_t
1818
use test_description_test_m ,only : test_description_test_t
19+
use test_diagnosis_test_m ,only : test_diagnosis_test_t
1920
use vector_test_description_test_m ,only : vector_test_description_test_t
2021
implicit none
2122

@@ -25,6 +26,7 @@ program main
2526
type(string_test_t) string_test
2627
type(test_result_test_t) test_result_test
2728
type(test_description_test_t) test_description_test
29+
type(test_diagnosis_test_t) test_diagnosis_test
2830
type(vector_test_description_test_t) vector_test_description_test
2931

3032
type(command_line_t) command_line
@@ -48,6 +50,7 @@ program main
4850
call string_test%report(passes, tests, skips)
4951
call test_result_test%report(passes, tests, skips)
5052
call test_description_test%report(passes, tests, skips)
53+
call test_diagnosis_test%report(passes, tests, skips)
5154
call vector_test_description_test%report(passes,tests, skips)
5255

5356
if (.not. GitHub_CI()) then

‎test/test_diagnosis_test_m.F90‎

Lines changed: 105 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,105 @@
1+
! Copyright (c) 2024, The Regents of the University of California and Sourcery Institute
2+
! Terms of use are as specified in LICENSE.txt
3+
4+
#include "language-support.F90"
5+
6+
module test_diagnosis_test_m
7+
!! Verify test_diagnosis_t object behavior
8+
9+
use julienne_m, only : &
10+
string_t &
11+
,test_t &
12+
,test_description_t &
13+
,test_description_substring &
14+
,test_diagnosis_t &
15+
,test_result_t &
16+
#if ! HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY
17+
,diagnosis_function_i &
18+
#endif
19+
,operator(.equalsExpected.) &
20+
,operator(.approximates.) &
21+
,operator(.within.)
22+
implicit none
23+
24+
private
25+
public :: test_diagnosis_test_t
26+
27+
type, extends(test_t) :: test_diagnosis_test_t
28+
contains
29+
procedure, nopass :: subject
30+
procedure, nopass :: results
31+
end type
32+
33+
contains
34+
35+
pure function subject() result(specimen)
36+
character(len=:), allocatable :: specimen
37+
specimen = "The test_diagnosis_t type"
38+
end function
39+
40+
function results() result(test_results)
41+
type(test_result_t), allocatable :: test_results(:)
42+
43+
#if HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY
44+
associate(descriptions => [ &
45+
test_description_t("contruction from a real expression of the form 'x .approximates. y .within. tolerance'", check_real_approximates) &
46+
,test_description_t("contruction from a double precision expression of the form 'x .approximates. y .within. tolerance'", check_double_approximates) &
47+
,test_description_t("contruction from an integer expression of the form 'i .equalsExpected. j", check_integer_equals) &
48+
] )
49+
#else
50+
! Work around missing Fortran 2008 feature: associating a procedure actual argument with a procedure pointer dummy argument:
51+
type(test_diagnosis_t), allocatable :: descriptions(:)
52+
procedure(diagnosis_function_i), pointer :: check_real_approximates_ptr, check_double_approximates, check_integer_equals
53+
check_real_approximates_ptr => check_real_approximates
54+
check_double_approximates_ptr => check_double_approximates
55+
56+
descriptions = [ &
57+
test_description_t("contruction from a real expression of the form 'x .approximates. y .within. tolerance'", check_real_approximates_ptr) &
58+
,test_description_t("contruction from a double-precision expression of the form 'x .approximates. y .within. tolerance'", check_double_approximates_ptr) &
59+
,test_description_t("contruction from an integer expression of the form 'i .equalsExpected. j", check_integer_equals_ptr) &
60+
]
61+
#endif
62+
63+
#ifndef __GFORTRAN__
64+
associate(substring_in_subject => index(subject(), test_description_substring) /= 0)
65+
associate(substring_in_test_diagnosis => descriptions%contains_text(test_description_substring))
66+
associate(matching_descriptions => pack(descriptions, substring_in_subject .or. substring_in_test_diagnosis))
67+
test_results = matching_descriptions%run()
68+
end associate
69+
end associate
70+
end associate
71+
end associate
72+
#else
73+
block
74+
logical substring_in_subject
75+
logical, allocatable :: substring_in_test_diagnosis(:)
76+
type(test_diagnosis_t), allocatable :: matching_descriptions(:)
77+
78+
substring_in_subject = index(subject(), test_description_substring) /= 0
79+
substring_in_test_diagnosis = descriptions%contains_text(test_description_substring)
80+
matching_descriptions = pack(descriptions, substring_in_subject .or. substring_in_test_diagnosis)
81+
test_results = matching_descriptions%run()
82+
end block
83+
#endif
84+
85+
end function
86+
87+
function check_real_approximates() result(test_diagnosis)
88+
type(test_diagnosis_t) test_diagnosis
89+
real, parameter :: expected_value = 1., tolerance = 1.E-08
90+
test_diagnosis = 1. .approximates. expected_value .within. tolerance
91+
end function
92+
93+
function check_double_approximates() result(test_diagnosis)
94+
type(test_diagnosis_t) test_diagnosis
95+
double precision, parameter :: expected_value = 1D0, tolerance = 1D-16
96+
test_diagnosis = 1D0 .approximates. expected_value .within. tolerance
97+
end function
98+
99+
function check_integer_equals() result(test_diagnosis)
100+
type(test_diagnosis_t) test_diagnosis
101+
integer, parameter :: expected_value = 1
102+
test_diagnosis = 1 .equalsExpected. expected_value
103+
end function
104+
105+
end module test_diagnosis_test_m

0 commit comments

Comments
 (0)