11! Copyright (c) 2024-2025, The Regents of the University of California and Sourcery Institute
22! Terms of use are as specified in LICENSE.txt
3+
4+ #include " language-support.F90"
5+
36module julienne_test_diagnosis_m
47 ! ! Define an abstraction for describing test outcomes and diagnostic information
58 use julienne_string_m, only : string_t
69 implicit none
710
811 private
912 public :: test_diagnosis_t
13+ public :: operator (.all.)
14+ public :: operator (.and. )
15+ public :: operator (.approximates.)
16+ public :: operator (.within.)
17+ public :: operator (.equalsExpected.)
18+ public :: operator (.lessThan.)
19+ public :: operator (.lessThanOrEqualTo.)
20+ public :: operator (.greaterThan.)
21+ public :: operator (.greaterThanOrEqualTo.)
1022
1123 type test_diagnosis_t
1224 ! ! Encapsulate test outcome and diagnostic information
@@ -18,6 +30,159 @@ module julienne_test_diagnosis_m
1830 procedure diagnostics_string
1931 end type
2032
33+ integer , parameter :: default_real = kind (1 .), double_precision = kind (1D0 )
34+
35+ #if HAVE_DERIVED_TYPE_KIND_PARAMETERS
36+ type operands_t (k)
37+ integer , kind :: k = default_real
38+ real (k) actual, expected
39+ end type
40+ #else
41+ type operands_t
42+ real actual, expected
43+ end type
44+
45+ type double_precision_operands_t
46+ double precision actual, expected
47+ end type
48+ #endif
49+
50+ interface operator (.all. )
51+
52+ pure module function aggregate_diagnosis(diagnoses) result(diagnosis)
53+ implicit none
54+ type (test_diagnosis_t), intent (in ) :: diagnoses(..)
55+ type (test_diagnosis_t) diagnosis
56+ end function
57+
58+ end interface
59+
60+ interface operator (.and. )
61+
62+ elemental module function and(lhs, rhs) result(diagnosis)
63+ implicit none
64+ type (test_diagnosis_t), intent (in ) :: lhs, rhs
65+ type (test_diagnosis_t) diagnosis
66+ end function
67+
68+ end interface
69+
70+ interface operator (.approximates. )
71+
72+ elemental module function approximates_real(actual, expected) result(operands)
73+ implicit none
74+ real , intent (in ) :: actual, expected
75+ type (operands_t) operands
76+ end function
77+
78+ elemental module function approximates_double_precision(actual, expected) result(operands)
79+ implicit none
80+ double precision , intent (in ) :: actual, expected
81+ #if HAVE_DERIVED_TYPE_KIND_PARAMETERS
82+ type (operands_t(double_precision)) operands
83+ #else
84+ type (double_precision_operands_t) operands
85+ #endif
86+ end function
87+
88+ end interface
89+
90+ interface operator (.equalsExpected. )
91+
92+ elemental module function equals_expected_integer(actual, expected) result(test_diagnosis)
93+ implicit none
94+ integer , intent (in ) :: actual, expected
95+ type (test_diagnosis_t) test_diagnosis
96+ end function
97+
98+ end interface
99+
100+ interface operator (.lessThan. )
101+
102+ elemental module function less_than_real(actual, expected_ceiling) result(test_diagnosis)
103+ implicit none
104+ real , intent (in ) :: actual, expected_ceiling
105+ type (test_diagnosis_t) test_diagnosis
106+ end function
107+
108+ elemental module function less_than_double(actual, expected_ceiling) result(test_diagnosis)
109+ implicit none
110+ double precision , intent (in ) :: actual, expected_ceiling
111+ type (test_diagnosis_t) test_diagnosis
112+ end function
113+
114+ elemental module function less_than_integer(actual, expected_ceiling) result(test_diagnosis)
115+ implicit none
116+ integer , intent (in ) :: actual, expected_ceiling
117+ type (test_diagnosis_t) test_diagnosis
118+ end function
119+
120+ end interface
121+
122+ interface operator (.lessThanOrEqualTo. )
123+
124+ elemental module function less_than_or_equal_to_integer(actual, expected_max) result(test_diagnosis)
125+ implicit none
126+ integer , intent (in ) :: actual, expected_max
127+ type (test_diagnosis_t) test_diagnosis
128+ end function
129+
130+ end interface
131+
132+ interface operator (.greaterThanOrEqualTo. )
133+
134+ elemental module function greater_than_or_equal_to_integer(actual, expected_min) result(test_diagnosis)
135+ implicit none
136+ integer , intent (in ) :: actual, expected_min
137+ type (test_diagnosis_t) test_diagnosis
138+ end function
139+
140+ end interface
141+
142+ interface operator (.greaterThan. )
143+
144+ elemental module function greater_than_real(actual, expected_floor) result(test_diagnosis)
145+ implicit none
146+ real , intent (in ) :: actual, expected_floor
147+ type (test_diagnosis_t) test_diagnosis
148+ end function
149+
150+ elemental module function greater_than_double(actual, expected_floor) result(test_diagnosis)
151+ implicit none
152+ double precision , intent (in ) :: actual, expected_floor
153+ type (test_diagnosis_t) test_diagnosis
154+ end function
155+
156+ elemental module function greater_than_integer(actual, expected_floor) result(test_diagnosis)
157+ implicit none
158+ integer , intent (in ) :: actual, expected_floor
159+ type (test_diagnosis_t) test_diagnosis
160+ end function
161+
162+ end interface
163+
164+ interface operator (.within. )
165+
166+ elemental module function within_real(operands, tolerance) result(test_diagnosis)
167+ implicit none
168+ type (operands_t), intent (in ) :: operands
169+ real , intent (in ) :: tolerance
170+ type (test_diagnosis_t) test_diagnosis
171+ end function
172+
173+ elemental module function within_double_precision(operands, tolerance) result(test_diagnosis)
174+ implicit none
175+ #if HAVE_DERIVED_TYPE_KIND_PARAMETERS
176+ type (operands_t(double_precision)), intent (in ) :: operands
177+ #else
178+ type (double_precision_operands_t), intent (in ) :: operands
179+ #endif
180+ double precision , intent (in ) :: tolerance
181+ type (test_diagnosis_t) test_diagnosis
182+ end function
183+
184+ end interface
185+
21186 interface test_diagnosis_t
22187
23188 elemental module function construct_from_string_t(test_passed, diagnostics_string) result(test_diagnosis)
0 commit comments