tap.f90
Go to the documentation of this file.
1!#############################################################################
2!# #
3!# fosite - 3D hydrodynamical simulation program #
4!# module: tap.f90 #
5!# #
6!# Copyright (C) 2013 Manuel Jung <mjung@astrophysik.uni-kiel.de> #
7!# #
8!# This program is free software; you can redistribute it and/or modify #
9!# it under the terms of the GNU General Public License as published by #
10!# the Free Software Foundation; either version 2 of the License, or (at #
11!# your option) any later version. #
12!# #
13!# This program is distributed in the hope that it will be useful, but #
14!# WITHOUT ANY WARRANTY; without even the implied warranty of #
15!# MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, GOOD TITLE or #
16!# NON INFRINGEMENT. See the GNU General Public License for more #
17!# details. #
18!# #
19!# You should have received a copy of the GNU General Public License #
20!# along with this program; if not, write to the Free Software #
21!# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. #
22!# #
23!#############################################################################
24
25!----------------------------------------------------------------------------!
31!----------------------------------------------------------------------------!
32
33MODULE tap
34 USE logging_base_mod, ONLY : setprefix
35 IMPLICIT NONE
36 !--------------------------------------------------------------------------!
37 PRIVATE
38 INTEGER, PARAMETER :: no_plan = -1
39 INTEGER, PARAMETER :: skip_all = -2
40 INTEGER, SAVE :: expected_tests = no_plan
41 INTEGER, SAVE :: failed_tests = 0
42 INTEGER, SAVE :: current_test = 0
43 !--------------------------------------------------------------------------!
44 PUBLIC :: &
45 tap_plan, &
46 tap_done, &
47 tap_check_at_loc, &
48 tap_check_op_at_loc, &
49 tap_check_close_at_loc, &
50 tap_check_small_at_loc
51 !--------------------------------------------------------------------------!
52
53CONTAINS
54
55 SUBROUTINE tap_diag(str)
56 IMPLICIT NONE
57 !------------------------------------------------------------------------!
58 CHARACTER(LEN=*) :: str
59 !------------------------------------------------------------------------!
60 INTENT(IN) :: str
61 !------------------------------------------------------------------------!
62 WRITE(*,'(A,A)') "# ",trim(str)
63 END SUBROUTINE tap_diag
64
65
66 FUNCTION itoa(i) RESULT(str)
67 IMPLICIT NONE
68 !------------------------------------------------------------------------!
69 INTEGER :: i
70 CHARACTER(len=ceiling(log10(real(i)+1))) :: str
71 !------------------------------------------------------------------------!
72 INTEGER :: n
73 CHARACTER(LEN=16) :: tmp
74 !------------------------------------------------------------------------!
75 INTENT(IN) :: i
76 !------------------------------------------------------------------------!
77 n = ceiling(log10(real(i)+1))
78 WRITE(tmp,'(I16)') i
79 str = tmp(16-n+1:16)
80 END FUNCTION itoa
81
82
83 FUNCTION rtoa(r) RESULT(str)
84 IMPLICIT NONE
85 !------------------------------------------------------------------------!
86 REAL :: r
87 CHARACTER(LEN=12) :: str
88 !------------------------------------------------------------------------!
89 INTENT(IN) :: r
90 !------------------------------------------------------------------------!
91 WRITE(str,'(ES12.3)') r
92 END FUNCTION rtoa
93
94
95 SUBROUTINE tap_plan(tests, why)
96 IMPLICIT NONE
97 !------------------------------------------------------------------------!
98 INTEGER :: tests
99 CHARACTER(len=128), OPTIONAL :: why
100 !------------------------------------------------------------------------!
101 INTENT(IN) :: tests, why
102 !------------------------------------------------------------------------!
103 CALL setprefix('#')
104 expected_tests = tests
105 failed_tests = 0
106 current_test = 0
107 WRITE(*, '(A)') "TAP version 13"
108 SELECT CASE(tests)
109 CASE(skip_all)
110 IF(PRESENT(why)) THEN
111 WRITE(*, '(A,A)') "1..0 SKIP ", why
112 ELSE
113 WRITE(*, '(A)') "1..0 SKIP"
114 END IF
115 CASE(no_plan)
116 CASE DEFAULT
117 WRITE(*, '(A,A)') "1..", itoa(tests)
118 END SELECT
119 END SUBROUTINE tap_plan
120
121
122 SUBROUTINE tap_done()
123 IMPLICIT NONE
124 !------------------------------------------------------------------------!
125 IF(expected_tests.EQ.no_plan) THEN
126 WRITE(*,'(A,A)') "1..",itoa(current_test)
127 stop 0
128 ELSE IF(current_test.NE.expected_tests) THEN
129 CALL tap_diag("Looks like " // itoa(expected_tests) //&
130 " tests were planned but " // itoa(current_test) // " ran.")
131 stop 255
132 END IF
133 IF(failed_tests.GT.0) THEN
134 CALL tap_diag("Looks like " // itoa(failed_tests) // &
135 " tests of " // itoa(current_test) // " have failed.")
136 !IF(expected_tests.EQ.NO_PLAN) THEN
137 ! retval = failed_tests
138 !ELSE
139 ! retval = expected_tests - current_test + failed_tests
140 !END IF
141 ! STOP retval ...not possible in FORTRAN
142 stop 255
143 END IF
144 END SUBROUTINE tap_done
145
146
147 SUBROUTINE tap_check(file,line,test,name)
148 IMPLICIT NONE
149 !------------------------------------------------------------------------!
150 CHARACTER(LEN=*) :: file
151 INTEGER :: line
152 LOGICAL :: test
153 CHARACTER(LEN=*) :: name
154 !------------------------------------------------------------------------!
155 INTENT(IN) :: file, line, test, name
156 !------------------------------------------------------------------------!
157 current_test = current_test + 1
158 IF(test) THEN
159 WRITE(*,'(A,A,A,A)') "ok ",itoa(current_test)," - ",trim(name)
160 ELSE
161 failed_tests = failed_tests + 1
162 WRITE(*,'(A,A,A,A)') "not ok ",itoa(current_test)," - ",trim(name)
163 END IF
164 END SUBROUTINE tap_check
165
166
167 SUBROUTINE tap_check_at_loc(file,line,test,name)
168 IMPLICIT NONE
169 !------------------------------------------------------------------------!
170 CHARACTER(LEN=*) :: file
171 INTEGER :: line
172 LOGICAL :: test
173 CHARACTER(LEN=*) :: name
174 !------------------------------------------------------------------------!
175 INTENT(IN) :: file, line, test, name
176 !------------------------------------------------------------------------!
177 CALL tap_check(file,line,test,name)
178 IF(.NOT.test) THEN
179 CALL tap_diag("Failed test '"//trim(name)//"'")
180 CALL tap_diag("at "//trim(file)//":"//itoa(line)//".")
181 END IF
182 END SUBROUTINE tap_check_at_loc
183
184
185 SUBROUTINE tap_check_op_at_loc(file,line,op,test,a,b,name)
186 IMPLICIT NONE
187 !------------------------------------------------------------------------!
188 CHARACTER(LEN=*) :: file
189 INTEGER :: line
190 CHARACTER(LEN=*) :: op
191 LOGICAL :: test
192 REAL :: a, b
193 CHARACTER(LEN=*) :: name
194 !------------------------------------------------------------------------!
195 INTENT(IN) :: file, line, op, test, a, b, name
196 !------------------------------------------------------------------------!
197 CALL tap_check(file,line,test,name)
198 IF(.NOT.test) THEN
199 CALL tap_diag("Failed test '"//trim(name)//"'")
200 CALL tap_diag(rtoa(a)//" "//trim(op)//" "//rtoa(b))
201 CALL tap_diag("at "//trim(file)//":"//itoa(line)//".")
202 END IF
203 END SUBROUTINE tap_check_op_at_loc
204
205
206 SUBROUTINE tap_check_close_at_loc(file,line,a,b,eps,name)
207 IMPLICIT NONE
208 !------------------------------------------------------------------------!
209 CHARACTER(LEN=*) :: file
210 INTEGER :: line
211 REAL :: a, b, eps
212 CHARACTER(LEN=*) :: name
213 !------------------------------------------------------------------------!
214 LOGICAL :: test
215 !------------------------------------------------------------------------!
216 INTENT(IN) :: file, line, a, b, eps, name
217 !------------------------------------------------------------------------!
218 test = abs(a-b).LT.eps
219 CALL tap_check(file,line,test,name)
220 IF(.NOT.test) THEN
221 CALL tap_diag("Failed test '"//trim(name)//"'")
222 CALL tap_diag("ABS("//rtoa(a)//"-"//rtoa(b)//.LT.") "//rtoa(eps))
223 CALL tap_diag("at "//trim(file)//":"//itoa(line)//".")
224 END IF
225 END SUBROUTINE tap_check_close_at_loc
226
227
228 SUBROUTINE tap_check_small_at_loc(file,line,a,eps,name)
229 IMPLICIT NONE
230 !------------------------------------------------------------------------!
231 CHARACTER(LEN=*) :: file
232 INTEGER :: line
233 REAL :: a, eps
234 CHARACTER(LEN=*) :: name
235 !------------------------------------------------------------------------!
236 LOGICAL :: test
237 !------------------------------------------------------------------------!
238 INTENT(IN) :: file, line, a, eps, name
239 !------------------------------------------------------------------------!
240 test = abs(a).LT.eps
241 CALL tap_check(file,line,test,name)
242 IF(.NOT.test) THEN
243 CALL tap_diag("Failed test '"//trim(name)//"'")
244 CALL tap_diag("ABS("//rtoa(a)//.LT.") "//rtoa(eps))
245 CALL tap_diag("at "//trim(file)//":"//itoa(line)//".")
246 END IF
247 END SUBROUTINE tap_check_small_at_loc
248
249END MODULE tap
logging_base_mod
Basic fosite module.
Definition: logging_base.f90:36
logging_base_mod::setprefix
subroutine setprefix(val)
Set character preceding the info output.
Definition: logging_base.f90:183
tap
Definition: tap.f90:33
tap::tap_check_close_at_loc
subroutine, public tap_check_close_at_loc(file, line, a, b, eps, name)
Definition: tap.f90:207
tap::tap_check
subroutine tap_check(file, line, test, name)
Definition: tap.f90:148
tap::tap_plan
subroutine, public tap_plan(tests, why)
Definition: tap.f90:96
tap::itoa
function itoa(i)
Definition: tap.f90:67
tap::rtoa
character(len=12) function rtoa(r)
Definition: tap.f90:84
tap::tap_check_op_at_loc
subroutine, public tap_check_op_at_loc(file, line, op, test, a, b, name)
Definition: tap.f90:186
tap::no_plan
integer, parameter no_plan
Definition: tap.f90:38
tap::expected_tests
integer, save expected_tests
Definition: tap.f90:40
tap::tap_check_at_loc
subroutine, public tap_check_at_loc(file, line, test, name)
Definition: tap.f90:168
tap::failed_tests
integer, save failed_tests
Definition: tap.f90:41
tap::current_test
integer, save current_test
Definition: tap.f90:42
tap::skip_all
integer, parameter skip_all
Definition: tap.f90:39
tap::tap_diag
subroutine tap_diag(str)
Definition: tap.f90:56
tap::tap_check_small_at_loc
subroutine, public tap_check_small_at_loc(file, line, a, eps, name)
Definition: tap.f90:229
tap::tap_done
subroutine, public tap_done()
Definition: tap.f90:123
Generated by   doxygen 1.9.4