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 
33 MODULE 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 
53 CONTAINS
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 
249 END MODULE tap
tap::itoa
function itoa(i)
Definition: tap.f90:67
tap::tap_done
subroutine, public tap_done()
Definition: tap.f90:123
logging_base_mod::setprefix
subroutine setprefix(val)
Set character preceding the info output.
Definition: logging_base.f90:178
tap::current_test
integer, save current_test
Definition: tap.f90:42
tap::tap_check
subroutine tap_check(file, line, test, name)
Definition: tap.f90:148
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
Definition: tap.f90:33
logging_base_mod
Basic fosite module.
Definition: logging_base.f90:36
tap::tap_check_small_at_loc
subroutine, public tap_check_small_at_loc(file, line, a, eps, name)
Definition: tap.f90:229
tap::no_plan
integer, parameter no_plan
Definition: tap.f90:38
tap::failed_tests
integer, save failed_tests
Definition: tap.f90:41
tap::tap_plan
subroutine, public tap_plan(tests, why)
Definition: tap.f90:96
tap::tap_diag
subroutine tap_diag(str)
Definition: tap.f90:56
tap::tap_check_at_loc
subroutine, public tap_check_at_loc(file, line, test, name)
Definition: tap.f90:168
tap::rtoa
character(len=12) function rtoa(r)
Definition: tap.f90:84
tap::expected_tests
integer, save expected_tests
Definition: tap.f90:40
tap::skip_all
integer, parameter skip_all
Definition: tap.f90:39
tap::tap_check_close_at_loc
subroutine, public tap_check_close_at_loc(file, line, a, b, eps, name)
Definition: tap.f90:207
Generated by   doxygen 1.8.14