Skip to content

Commit 4fdf372

Browse files
wpbonelliwpbonelli
committed
test: add minimal unit tests for some utilities
1 parent 625741a commit 4fdf372

7 files changed

+314
-1
lines changed

‎autotest/TestDevFeature.f90

+28
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,28 @@
1+
module TestDevFeature
2+
use testdrive, only: error_type, unittest_type, new_unittest, check
3+
use DevFeatureModule, only: dev_feature
4+
use ConstantsModule, only: LINELENGTH
5+
use VersionModule, only: IDEVELOPMODE
6+
7+
implicit none
8+
private
9+
public :: collect_dev_feature
10+
11+
contains
12+
13+
subroutine collect_dev_feature(testsuite)
14+
type(unittest_type), allocatable, intent(out) :: testsuite(:)
15+
testsuite = [ &
16+
! expect failure if in release mode, otherwise pass
17+
new_unittest("dev_feature", test_dev_feature, &
18+
should_fail=(IDEVELOPMODE == 0)) &
19+
]
20+
end subroutine collect_dev_feature
21+
22+
subroutine test_dev_feature(error)
23+
type(error_type), allocatable, intent(out) :: error
24+
character(len=LINELENGTH) :: errmsg
25+
call dev_feature(errmsg)
26+
end subroutine test_dev_feature
27+
28+
end module TestDevFeature

‎autotest/TestGenericUtils.f90

+53
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,53 @@
1+
module TestGenericUtils
2+
use testdrive, only: error_type, unittest_type, new_unittest, check
3+
use KindModule, only: DP
4+
use GenericUtilitiesModule, only: is_same
5+
6+
implicit none
7+
private
8+
public :: collect_genericutils
9+
10+
contains
11+
12+
subroutine collect_genericutils(testsuite)
13+
type(unittest_type), allocatable, intent(out) :: testsuite(:)
14+
testsuite = [ &
15+
new_unittest("is_same", test_is_same), &
16+
new_unittest("is_same_both_near_0", test_is_same_both_near_0, &
17+
should_fail=.true.), & ! expect failure for now, see below
18+
new_unittest("is_not_same", test_is_not_same) &
19+
]
20+
end subroutine collect_genericutils
21+
22+
subroutine test_is_same(error)
23+
type(error_type), allocatable, intent(out) :: error
24+
25+
! exact
26+
call check(error, is_same(0.0_DP, 0.0_DP))
27+
if (allocated(error)) return
28+
29+
! inexact (within tolerance)
30+
call check(error, is_same(1.0000_DP, 1.0001_DP, eps=0.01_DP))
31+
if (allocated(error)) return
32+
end subroutine test_is_same
33+
34+
subroutine test_is_same_both_near_0(error)
35+
type(error_type), allocatable, intent(out) :: error
36+
37+
! relative comparison mode fails when a and b are close to 0
38+
call check(error, is_same(0.0000_DP, 0.0001_DP, eps=0.01_DP))
39+
if (allocated(error)) return
40+
end subroutine test_is_same_both_near_0
41+
42+
subroutine test_is_not_same(error)
43+
type(error_type), allocatable, intent(out) :: error
44+
45+
call check(error, (.not. (is_same(1.0_DP, 1.0001_DP))))
46+
if (allocated(error)) return
47+
48+
! with tolerance
49+
call check(error, (.not. is_same(1.0_DP, 1.0001_DP, eps=0.00005_DP)))
50+
if (allocated(error)) return
51+
end subroutine test_is_not_same
52+
53+
end module TestGenericUtils

‎autotest/TestInputOutput.f90

+63
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,63 @@
1+
module TestInputOutput
2+
use testdrive, only: error_type, unittest_type, new_unittest, check
3+
use ConstantsModule, only: LINELENGTH
4+
use InputOutputModule, only: get_node, get_ijk
5+
implicit none
6+
private
7+
public :: collect_inputoutput
8+
9+
contains
10+
11+
subroutine collect_inputoutput(testsuite)
12+
type(unittest_type), allocatable, intent(out) :: testsuite(:)
13+
testsuite = [ &
14+
new_unittest("get_node_get_ijk", test_get_node_get_ijk) &
15+
]
16+
end subroutine collect_inputoutput
17+
18+
subroutine test_get_node_get_ijk(error)
19+
type(error_type), allocatable, intent(out) :: error
20+
integer :: ilay
21+
integer :: irow
22+
integer :: icol
23+
integer :: nlay
24+
integer :: nrow
25+
integer :: ncol
26+
integer :: nnum
27+
integer :: ncls
28+
integer :: k, i, j
29+
30+
! trivial grid with 1 cell
31+
nnum = get_node(1, 1, 1, 1, 1, 1)
32+
call get_ijk(nnum, 1, 1, 1, ilay, irow, icol)
33+
call check(error, nnum == 1)
34+
call check(error, ilay == 1)
35+
call check(error, irow == 1)
36+
call check(error, icol == 1)
37+
if (allocated(error)) return
38+
39+
! small grid, 3x4x5
40+
nlay = 3
41+
nrow = 4
42+
ncol = 5
43+
ncls = nlay * nrow * ncol
44+
do k = 1, nlay
45+
do i = 1, nrow
46+
do j = 1, ncol
47+
! node number from ijk
48+
nnum = get_node(k, i, j, nlay, nrow, ncol)
49+
call check(error, nnum == (k - 1) * nrow * ncol + (i - 1) * ncol + j)
50+
if (allocated(error)) return
51+
52+
! ijk from node number
53+
call get_ijk(nnum, nrow, ncol, nlay, irow, icol, ilay)
54+
call check(error, ilay == k)
55+
call check(error, irow == i)
56+
call check(error, icol == j)
57+
if (allocated(error)) return
58+
end do
59+
end do
60+
end do
61+
end subroutine test_get_node_get_ijk
62+
63+
end module TestInputOutput

‎autotest/TestList.f90

+96
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,96 @@
1+
module TestList
2+
use testdrive, only: error_type, unittest_type, new_unittest, check
3+
use ListModule, only: ListType, ListNodeType
4+
5+
implicit none
6+
private
7+
public :: collect_list
8+
9+
type :: IntNodeType
10+
integer :: value
11+
end type IntNodeType
12+
contains
13+
14+
subroutine collect_list(testsuite)
15+
type(unittest_type), allocatable, intent(out) :: testsuite(:)
16+
testsuite = [ &
17+
new_unittest("count", test_count), &
18+
new_unittest("add", test_add), &
19+
new_unittest("remove_node_by_index", test_remove_node_by_index) &
20+
]
21+
end subroutine collect_list
22+
23+
subroutine test_count(error)
24+
type(error_type), allocatable, intent(out) :: error
25+
type(ListType), pointer :: list => null()
26+
type(IntNodeType), pointer :: p1 => null()
27+
class(*), pointer :: p => null()
28+
29+
! allocate
30+
allocate (list)
31+
allocate (p1)
32+
33+
! empty case
34+
call check(error, list%Count() == 0)
35+
if (allocated(error)) return
36+
37+
! one node case
38+
p1%value = 1
39+
p => p1
40+
call list%Add(p)
41+
call check(error, list%Count() == 1)
42+
if (allocated(error)) return
43+
44+
! deallocate
45+
deallocate (list)
46+
deallocate (p1)
47+
end subroutine test_count
48+
49+
subroutine test_add(error)
50+
type(error_type), allocatable, intent(out) :: error
51+
type(ListType), pointer :: list => null()
52+
type(IntNodeType), pointer :: p1 => null()
53+
class(*), pointer :: p => null()
54+
55+
! allocate
56+
allocate (list)
57+
allocate (p1)
58+
59+
! add a node
60+
p1%value = 1
61+
p => p1
62+
call list%Add(p)
63+
call check(error, list%Count() == 1)
64+
if (allocated(error)) return
65+
66+
! deallocate
67+
deallocate (list)
68+
end subroutine test_add
69+
70+
subroutine test_remove_node_by_index(error)
71+
type(error_type), allocatable, intent(out) :: error
72+
type(ListType), pointer :: list => null()
73+
type(IntNodeType), pointer :: p1 => null()
74+
class(*), pointer :: p => null()
75+
76+
! allocate
77+
allocate (list)
78+
allocate (p1)
79+
80+
! add a node
81+
p1%value = 1
82+
p => p1
83+
call list%Add(p)
84+
call check(error, list%Count() == 1)
85+
if (allocated(error)) return
86+
87+
! remove a node
88+
call list%RemoveNode(1, destroyValue=.false.)
89+
call check(error, list%Count() == 0)
90+
91+
! deallocate
92+
deallocate (list)
93+
deallocate (p1)
94+
end subroutine test_remove_node_by_index
95+
96+
end module TestList

‎autotest/TestSim.f90

+58
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,58 @@
1+
module TestSim
2+
use testdrive, only: error_type, unittest_type, new_unittest, check
3+
use SimModule, only: store_error, store_warning, store_note, &
4+
initial_message, count_errors, count_notes, &
5+
count_warnings
6+
use ConstantsModule, only: LINELENGTH
7+
8+
implicit none
9+
private
10+
public :: collect_sim
11+
12+
contains
13+
14+
subroutine collect_sim(testsuite)
15+
type(unittest_type), allocatable, intent(out) :: testsuite(:)
16+
testsuite = [ &
17+
new_unittest("store_and_count", test_store_and_count) &
18+
]
19+
end subroutine collect_sim
20+
21+
subroutine test_store_and_count(error)
22+
type(error_type), allocatable, intent(out) :: error
23+
character(len=LINELENGTH) :: ntemsg
24+
character(len=LINELENGTH) :: wrnmsg
25+
character(len=LINELENGTH) :: errmsg
26+
27+
! define messages
28+
ntemsg = "NOTE"
29+
wrnmsg = "WARNING"
30+
errmsg = "ERROR"
31+
32+
! initialize message arrays
33+
call initial_message()
34+
35+
! check no messages stored
36+
call check(error, count_errors() == 0)
37+
call check(error, count_warnings() == 0)
38+
call check(error, count_notes() == 0)
39+
if (allocated(error)) return
40+
41+
! todo store a note and check that it's stored
42+
call store_note(ntemsg)
43+
call check(error, count_notes() == 1)
44+
if (allocated(error)) return
45+
46+
! todo store a warning and check that it's stored
47+
call store_warning(wrnmsg)
48+
call check(error, count_warnings() == 1)
49+
if (allocated(error)) return
50+
51+
! store an error and check that it's stored
52+
call store_error(errmsg, terminate=.false.)
53+
call check(error, count_errors() == 1)
54+
if (allocated(error)) return
55+
56+
end subroutine test_store_and_count
57+
58+
end module TestSim

‎autotest/meson.build

+5
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,11 @@ test_drive = dependency('test-drive', required : false)
22
if test_drive.found()
33
tests = [
44
'ArrayHandlers',
5+
'DevFeature',
6+
'GenericUtils',
7+
'InputOutput',
8+
'List',
9+
'Sim'
510
]
611

712
test_srcs = files(

‎autotest/tester.f90

+11-1
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,11 @@ program tester
33
use testdrive, only: run_testsuite, new_testsuite, testsuite_type, &
44
& select_suite, run_selected, get_argument
55
use TestArrayHandlers, only: collect_arrayhandlers
6+
use TestDevFeature, only: collect_dev_feature
7+
use TestGenericUtils, only: collect_genericutils
8+
use TestInputOutput, only: collect_inputoutput
9+
use TestList, only: collect_list
10+
use TestSim, only: collect_sim
611
implicit none
712
integer :: stat, is
813
character(len=:), allocatable :: suite_name, test_name
@@ -11,7 +16,12 @@ program tester
1116

1217
stat = 0
1318
testsuites = [ &
14-
new_testsuite("ArrayHandlers", collect_arrayhandlers) &
19+
new_testsuite("ArrayHandlers", collect_arrayhandlers), &
20+
new_testsuite("DevFeature", collect_dev_feature), &
21+
new_testsuite("GenericUtils", collect_genericutils), &
22+
new_testsuite("InputOutput", collect_inputoutput), &
23+
new_testsuite("List", collect_list), &
24+
new_testsuite("Sim", collect_sim) &
1525
]
1626

1727
call get_argument(1, suite_name)

0 commit comments

Comments
 (0)