Skip to content

Commit 8dabf8d

Browse files
added the fotran-testanything code
from dennisdjensen https://github.com/dennisdjensen/fortran-testanything license included in this commit. renamed test.f08 to test.f90 because *.f90 is what we have mkmf looking for updated buildfunctions to include the fortran-testanything code for developer tests only removed the local threed_model_mod.f90 (using the template model path like other developer tests)
1 parent 6c73b04 commit 8dabf8d

File tree

7 files changed

+499
-299
lines changed

7 files changed

+499
-299
lines changed

build_templates/buildfunctions.sh

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -222,8 +222,10 @@ done
222222
function dartbuild() {
223223

224224
local program
225+
local devlibs
225226

226227
if [ $dev_test -eq 0 ]; then
228+
devlibs=""
227229
#look in $program directory for {main}.f90
228230
if [ $1 == "obs_diag" ]; then
229231
program=$DART/assimilation_code/programs/obs_diag/$LOCATION
@@ -235,11 +237,13 @@ if [ $dev_test -eq 0 ]; then
235237
else
236238
# For developer tests {main}.f90 is in developer_tests
237239
program=$DART/developer_tests/$TEST/$1.f90
240+
devlibs=$DART/developer_tests/contrib/fortran-testanything
238241
fi
239242

240243
$DART/build_templates/mkmf -x -a $DART $m -p $1 \
241244
$dartsrc \
242245
$EXTRA \
246+
$devlibs \
243247
$program
244248
}
245249

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,14 @@
1+
Copyright 2015 Dennis Decker Jensen
2+
3+
Permission to use, copy, modify, and distribute this software for any
4+
purpose with or without fee is hereby granted, provided that the above
5+
copyright notice and this permission notice appear in all copies.
6+
7+
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
8+
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
9+
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
10+
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
11+
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
12+
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
13+
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
14+
Lines changed: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,24 @@
1+
! Template parameter: wp (working precision)
2+
! Template free identifiers: testline, tests
3+
subroutine is(got, expected, msg)
4+
integer(kind=wp), intent(in) :: got, expected
5+
character(len=*), intent(in), optional :: msg
6+
character(len=:), allocatable :: testmsg, idmsg
7+
character(len=120) gotmsg, expectedmsg
8+
logical good
9+
10+
if (present(msg)) then
11+
allocate(character(len=len_trim(msg)+20) :: testmsg, idmsg)
12+
write (unit=idmsg, fmt='(A,A,A)') 'Failed test: "', trim(msg), '"'
13+
testmsg = trim(msg)
14+
else
15+
allocate(character(len=30) :: testmsg, idmsg)
16+
write (unit=idmsg, fmt='(A,I0)') 'Failed test no. ', tests + 1
17+
testmsg = ""
18+
end if
19+
write (unit=gotmsg, fmt='(A,I0)') ' got: ', got
20+
write (unit=expectedmsg, fmt='(A,I0)') 'expected: ', expected
21+
22+
good = got == expected
23+
call testline(good, testmsg, idmsg, gotmsg, expectedmsg)
24+
end
Lines changed: 83 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,83 @@
1+
! Template parameter: wp (working precision)
2+
! Template free identifiers: testline, tests
3+
subroutine isabs(got, expected, eps, msg)
4+
real(kind=wp), intent(in) :: got, expected
5+
character(len=*), intent(in), optional :: msg
6+
real(kind=wp), intent(in), optional :: eps
7+
character(len=:), allocatable :: testmsg, idmsg
8+
character(len=120) gotmsg, expectedmsg
9+
real(kind=wp) tolerance
10+
logical good
11+
12+
if (present(msg)) then
13+
allocate(character(len=len_trim(msg)+20) :: testmsg, idmsg)
14+
write (unit=idmsg, fmt='(A,A,A)') 'Failed test: "', trim(msg), '"'
15+
testmsg = trim(msg)
16+
else
17+
allocate(character(len=30) :: testmsg, idmsg)
18+
write (unit=idmsg, fmt='(A,I0)') 'Failed test no. ', tests + 1
19+
testmsg = ""
20+
end if
21+
write (unit=gotmsg, fmt='(A,G0)') ' got: ', got
22+
write (unit=expectedmsg, fmt='(A,G0)') 'expected: ', expected
23+
24+
if (present(eps)) then
25+
tolerance = eps
26+
else
27+
tolerance = epsilon(got)
28+
end if
29+
! eps = 0.5e-10_wp
30+
! Absolute accuracy within the 10 least significant digits
31+
good = abs(got - expected) < tolerance
32+
call testline(good, testmsg, idmsg, gotmsg, expectedmsg)
33+
end
34+
35+
subroutine isrel(got, expected, eps, msg)
36+
real(kind=wp), intent(in) :: got, expected
37+
character(len=*), intent(in), optional :: msg
38+
real(kind=wp), intent(in), optional :: eps
39+
real(kind=wp) tolerance
40+
41+
! eps = (abs(a) + abs(b)) * 0.5e-10_wp
42+
! Relative accuracy within the 10 most significant digits
43+
tolerance = (abs(got) + abs(expected))
44+
if (present(eps)) then
45+
tolerance = tolerance * eps
46+
else
47+
tolerance = tolerance * epsilon(got)
48+
end if
49+
call isabs(got, expected, tolerance, msg)
50+
end
51+
52+
subroutine isnear(got, expected, eps, msg)
53+
real(kind=wp), intent(in) :: got, expected
54+
character(len=*), intent(in), optional :: msg
55+
real(kind=wp), intent(in), optional :: eps
56+
character(len=:), allocatable :: testmsg, idmsg
57+
character(len=120) gotmsg, expectedmsg
58+
real(kind=wp) tolerance
59+
logical good
60+
61+
if (present(msg)) then
62+
allocate(character(len=len_trim(msg)+20) :: testmsg, idmsg)
63+
write (unit=idmsg, fmt='(A,A,A)') 'Failed test: "', trim(msg), '"'
64+
testmsg = trim(msg)
65+
else
66+
allocate(character(len=30) :: testmsg, idmsg)
67+
write (unit=idmsg, fmt='(A,I0)') 'Failed test no. ', tests + 1
68+
testmsg = ""
69+
end if
70+
write (unit=gotmsg, fmt='(A,G0)') ' got: ', got
71+
write (unit=expectedmsg, fmt='(A,G0)') 'expected: ', expected
72+
73+
if (present(eps)) then
74+
tolerance = eps
75+
else
76+
tolerance = epsilon(got) ! minimun eps for which 1 + eps /= 1
77+
end if
78+
! Relative accuracy around 1.0_wp
79+
! Semantics of isnear means using <=, and not <, c.f. epsilon(got)
80+
good = abs(got / expected - 1.0_wp) <= tolerance
81+
call testline(good, testmsg, idmsg, gotmsg, expectedmsg)
82+
end
83+

0 commit comments

Comments
 (0)