Skip to content

Commit 984aa30

Browse files
committed
Port test_distribution_PRNG to test-drive
1 parent 58b8467 commit 984aa30

File tree

1 file changed

+73
-46
lines changed

1 file changed

+73
-46
lines changed
Lines changed: 73 additions & 46 deletions
Original file line numberDiff line numberDiff line change
@@ -1,108 +1,135 @@
1-
program test_distribution_PRNG
2-
use stdlib_error, only : check
1+
module test_stats_distribution_prng
32
use stdlib_kinds, only: int8, int16, int32, int64
43
use stdlib_stats_distribution_PRNG, only : random_seed, dist_rand
5-
4+
use stdlib_test, only: new_unittest, unittest_type, error_type, check
65
implicit none
7-
logical :: warn = .true.
86

9-
call test_random_seed
10-
call test_random_rand_iint8
11-
call test_random_rand_iint16
12-
call test_random_rand_iint32
13-
call test_random_rand_iint64
7+
private
8+
public :: collect_stats_distribution_prng
9+
10+
contains
11+
12+
!> Collect all exported unit tests
13+
subroutine collect_stats_distribution_prng(testsuite)
14+
!> Collection of tests
15+
type(unittest_type), allocatable, intent(out) :: testsuite(:)
1416

17+
testsuite = [ &
18+
new_unittest("random_seed", test_random_seed), &
19+
new_unittest("random_rand_iint8", test_random_rand_iint8), &
20+
new_unittest("random_rand_iint16", test_random_rand_iint8), &
21+
new_unittest("random_rand_iint32", test_random_rand_iint8), &
22+
new_unittest("random_rand_iint64", test_random_rand_iint8) &
23+
]
1524

16-
contains
25+
end subroutine collect_stats_distribution_prng
26+
27+
subroutine test_random_seed(error)
28+
!> Error handling
29+
type(error_type), allocatable, intent(out) :: error
1730

18-
subroutine test_random_seed
1931
integer :: put, get, res(5)
2032
integer :: ans(5) = [-1859553078, -1933696596, -642834430, &
2133
1711399314, 1548311463]
2234
integer :: i
2335

24-
print *, ""
25-
print *, "Test random_seed"
2636
put = 135792468
2737
do i = 1, 5
28-
call random_seed(put,get)
38+
call random_seed(put, get)
2939
res(i) = get
3040
put = get
3141
end do
32-
call check(all(res == ans), msg="random seed test failed.",warn=warn)
42+
call check(error, all(res == ans))
3343
end subroutine test_random_seed
3444

35-
subroutine test_random_rand_iint8
45+
subroutine test_random_rand_iint8(error)
46+
!> Error handling
47+
type(error_type), allocatable, intent(out) :: error
3648
integer :: put, get, i
49+
integer(int8) :: res(5), ans(5) = [118, -15, -72, 101, 70]
3750

38-
integer(int8) :: res(5), ans(5)=[118, -15, -72, 101, 70]
39-
40-
41-
print *, ""
42-
print *, "Test random_rand with kind int8"
4351
put = 12345678
4452
call random_seed(put, get)
4553
do i = 1, 5
4654
res(i) = dist_rand(1_int8)
4755
end do
48-
call check(all(res == ans), msg="random_rand with kind int8 test" &
49-
//" failed.", warn=warn)
56+
call check(error, all(res == ans))
5057
end subroutine test_random_rand_iint8
5158

52-
subroutine test_random_rand_iint16
59+
subroutine test_random_rand_iint16(error)
60+
!> Error handling
61+
type(error_type), allocatable, intent(out) :: error
5362
integer :: put, get, i
63+
integer(int16) :: res(5), ans(5) = [30286, -3799, -18204, 25947, 18148]
5464

55-
integer(int16) :: res(5), ans(5)=[30286, -3799, -18204, 25947, 18148]
56-
57-
58-
print *, ""
59-
print *, "Test random_rand with kind int16"
6065
put = 12345678
6166
call random_seed(put, get)
6267
do i = 1, 5
6368
res(i) = dist_rand(1_int16)
6469
end do
65-
call check(all(res == ans), msg="random_rand with kind int16 test" &
66-
//" failed.", warn=warn)
70+
call check(error, all(res == ans))
6771
end subroutine test_random_rand_iint16
6872

69-
subroutine test_random_rand_iint32
73+
subroutine test_random_rand_iint32(error)
74+
!> Error handling
75+
type(error_type), allocatable, intent(out) :: error
7076
integer :: put, get, i
71-
7277
integer(int32) :: res(5), ans(5)=[1984865646, -248954393, -1192993267, &
7378
1700514835, 1189401802]
7479

75-
76-
print *, ""
77-
print *, "Test random_rand with kind int32"
7880
put = 12345678
7981
call random_seed(put, get)
8082
do i = 1, 5
8183
res(i) = dist_rand(1_int32)
8284
end do
83-
call check(all(res == ans), msg="random_rand with kind int32 test" &
84-
//" failed.", warn=warn)
85+
call check(error, all(res == ans))
8586
end subroutine test_random_rand_iint32
8687

87-
subroutine test_random_rand_iint64
88+
subroutine test_random_rand_iint64(error)
89+
!> Error handling
90+
type(error_type), allocatable, intent(out) :: error
8891
integer :: put, get, i
89-
9092
integer(int64) :: res(5), ans(5)=[8524933037632333570_int64, &
9193
-1069250973542918798_int64, &
9294
-5123867065024149335_int64, &
9395
7303655603304982073_int64, &
9496
5108441843522503546_int64]
9597

96-
97-
print *, ""
98-
print *, "Test random_rand with kind int64"
9998
put = 12345678
10099
call random_seed(put, get)
101100
do i = 1, 5
102101
res(i) = dist_rand(1_int64)
103102
end do
104-
call check(all(res == ans), msg="random_rand with kind int64 test" &
105-
//" failed.", warn=warn)
103+
call check(error, all(res == ans))
106104
end subroutine test_random_rand_iint64
107105

108-
end program test_distribution_PRNG
106+
end module test_stats_distribution_prng
107+
108+
109+
program tester
110+
use iso_fortran_env, only: error_unit
111+
use stdlib_test, only: new_testsuite, run_testsuite, testsuite_type
112+
use test_stats_distribution_prng, only: collect_stats_distribution_prng
113+
implicit none
114+
115+
integer :: stat, is
116+
type(testsuite_type), allocatable :: testsuites(:)
117+
character(len=*), parameter :: fmt = '("#", *(1x, a))'
118+
119+
stat = 0
120+
121+
testsuites = [ &
122+
new_testsuite("stats_distribution_prng", collect_stats_distribution_prng) &
123+
]
124+
125+
do is = 1, size(testsuites)
126+
write(error_unit, fmt) "Testing:", testsuites(is)%name
127+
call run_testsuite(testsuites(is)%collect, error_unit, stat)
128+
end do
129+
130+
if (stat > 0) then
131+
write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!"
132+
error stop
133+
end if
134+
135+
end program tester

0 commit comments

Comments
 (0)