-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathfortun_assertions.f90
184 lines (137 loc) · 4.65 KB
/
fortun_assertions.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
module fortun_assertions
implicit none
private
public :: assert_eq, assert_lt, assert_gt, assert_le, assert_ge
interface assert_eq
module procedure assert_int_eq, assert_real_eq, assert_bool_eq
end interface assert_eq
interface assert_lt
module procedure assert_int_lt, assert_real_lt
end interface assert_lt
interface assert_le
module procedure assert_int_le, assert_real_le
end interface assert_le
interface assert_gt
module procedure assert_int_gt, assert_real_gt
end interface assert_gt
interface assert_ge
module procedure assert_int_ge, assert_real_ge
end interface assert_ge
contains
!-- Assertions on equality
!---------------------------------------------------------------- assert_int_eq
pure logical function assert_int_eq(a,b) result(res)
implicit none
integer, intent(IN) :: a, b
res = a .eq. b
end function assert_int_eq
!--------------------------------------------------------------- assert_bool_eq
pure logical function assert_bool_eq(a,b) result(res)
implicit none
logical, intent(IN) :: a, b
res = a .eqv. b
end function assert_bool_eq
!--------------------------------------------------------------- assert_real_eq
!> default tolerance is 1.e-10
pure logical function assert_real_eq(a,b,tolerance) result(res)
implicit none
real, intent(IN) :: a, b
real, intent(IN), optional :: tolerance
real :: tol
!> using local value tol for tolerance for purity
if (present(tolerance)) then
tol = tolerance
else
tol = 1.e-10
end if
res = (abs(a)-abs(b)) .le. tol
end function assert_real_eq
!-- Assertions on less than
!---------------------------------------------------------------- assert_int_lt
pure logical function assert_int_lt(a,b) result(res)
implicit none
integer, intent(IN) :: a, b
res = a .lt. b
end function assert_int_lt
!--------------------------------------------------------------- assert_real_lt
!> default tolerance is 1.e-10
pure logical function assert_real_lt(a,b,tolerance) result(res)
implicit none
real, intent(IN) :: a, b
real, intent(IN), optional :: tolerance
real :: tol
!> using local value tol for tolerance for purity
if (present(tolerance)) then
tol = tolerance
else
tol = 1.e-10
end if
res = (a-b) .lt. tol
end function assert_real_lt
!-- Assertions on less or equal
!---------------------------------------------------------------- assert_int_le
pure logical function assert_int_le(a,b) result(res)
implicit none
integer, intent(IN) :: a, b
res = a .le. b
end function assert_int_le
!--------------------------------------------------------------- assert_real_le
!> default tolerance is 1.e-10
pure logical function assert_real_le(a,b,tolerance) result(res)
implicit none
real, intent(IN) :: a, b
real, intent(IN), optional :: tolerance
real :: tol
!> using local value tol for tolerance for purity
if (present(tolerance)) then
tol = tolerance
else
tol = 1.e-10
end if
res = (a-b) .le. tol
end function assert_real_le
!-- Assertions on greater than
!---------------------------------------------------------------- assert_int_gt
pure logical function assert_int_gt(a,b) result(res)
implicit none
integer, intent(IN) :: a, b
res = a .gt. b
end function assert_int_gt
!--------------------------------------------------------------- assert_real_gt
!> default tolerance is 1.e-10
pure logical function assert_real_gt(a,b,tolerance) result(res)
implicit none
real, intent(IN) :: a, b
real, intent(IN), optional :: tolerance
real :: tol
!> using local value tol for tolerance for purity
if (present(tolerance)) then
tol = tolerance
else
tol = 1.e-10
end if
res = (a-b) .gt. tol
end function assert_real_gt
!-- Assertions on greater or equal
!---------------------------------------------------------------- assert_int_ge
pure logical function assert_int_ge(a,b) result(res)
implicit none
integer, intent(IN) :: a, b
res = a .ge. b
end function assert_int_ge
!--------------------------------------------------------------- assert_real_ge
!> default tolerance is 1.e-10
pure logical function assert_real_ge(a,b,tolerance) result(res)
implicit none
real, intent(IN) :: a, b
real, intent(IN), optional :: tolerance
real :: tol
!> using local value tol for tolerance for purity
if (present(tolerance)) then
tol = tolerance
else
tol = 1.e-10
end if
res = (a-b) .ge. tol
end function assert_real_ge
end module fortun_assertions