|
1 |
| -program test_distribution_PRNG |
2 |
| - use stdlib_error, only : check |
| 1 | +module test_stats_distribution_prng |
3 | 2 | use stdlib_kinds, only: int8, int16, int32, int64
|
4 | 3 | use stdlib_stats_distribution_PRNG, only : random_seed, dist_rand
|
5 |
| - |
| 4 | + use stdlib_test, only: new_unittest, unittest_type, error_type, check |
6 | 5 | implicit none
|
7 |
| - logical :: warn = .true. |
8 | 6 |
|
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(:) |
14 | 16 |
|
| 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 | + ] |
15 | 24 |
|
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 |
17 | 30 |
|
18 |
| - subroutine test_random_seed |
19 | 31 | integer :: put, get, res(5)
|
20 | 32 | integer :: ans(5) = [-1859553078, -1933696596, -642834430, &
|
21 | 33 | 1711399314, 1548311463]
|
22 | 34 | integer :: i
|
23 | 35 |
|
24 |
| - print *, "" |
25 |
| - print *, "Test random_seed" |
26 | 36 | put = 135792468
|
27 | 37 | do i = 1, 5
|
28 |
| - call random_seed(put,get) |
| 38 | + call random_seed(put, get) |
29 | 39 | res(i) = get
|
30 | 40 | put = get
|
31 | 41 | end do
|
32 |
| - call check(all(res == ans), msg="random seed test failed.",warn=warn) |
| 42 | + call check(error, all(res == ans)) |
33 | 43 | end subroutine test_random_seed
|
34 | 44 |
|
35 |
| - subroutine test_random_rand_iint8 |
| 45 | + subroutine test_random_rand_iint8(error) |
| 46 | + !> Error handling |
| 47 | + type(error_type), allocatable, intent(out) :: error |
36 | 48 | integer :: put, get, i
|
| 49 | + integer(int8) :: res(5), ans(5) = [118, -15, -72, 101, 70] |
37 | 50 |
|
38 |
| - integer(int8) :: res(5), ans(5)=[118, -15, -72, 101, 70] |
39 |
| - |
40 |
| - |
41 |
| - print *, "" |
42 |
| - print *, "Test random_rand with kind int8" |
43 | 51 | put = 12345678
|
44 | 52 | call random_seed(put, get)
|
45 | 53 | do i = 1, 5
|
46 | 54 | res(i) = dist_rand(1_int8)
|
47 | 55 | 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)) |
50 | 57 | end subroutine test_random_rand_iint8
|
51 | 58 |
|
52 |
| - subroutine test_random_rand_iint16 |
| 59 | + subroutine test_random_rand_iint16(error) |
| 60 | + !> Error handling |
| 61 | + type(error_type), allocatable, intent(out) :: error |
53 | 62 | integer :: put, get, i
|
| 63 | + integer(int16) :: res(5), ans(5) = [30286, -3799, -18204, 25947, 18148] |
54 | 64 |
|
55 |
| - integer(int16) :: res(5), ans(5)=[30286, -3799, -18204, 25947, 18148] |
56 |
| - |
57 |
| - |
58 |
| - print *, "" |
59 |
| - print *, "Test random_rand with kind int16" |
60 | 65 | put = 12345678
|
61 | 66 | call random_seed(put, get)
|
62 | 67 | do i = 1, 5
|
63 | 68 | res(i) = dist_rand(1_int16)
|
64 | 69 | 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)) |
67 | 71 | end subroutine test_random_rand_iint16
|
68 | 72 |
|
69 |
| - subroutine test_random_rand_iint32 |
| 73 | + subroutine test_random_rand_iint32(error) |
| 74 | + !> Error handling |
| 75 | + type(error_type), allocatable, intent(out) :: error |
70 | 76 | integer :: put, get, i
|
71 |
| - |
72 | 77 | integer(int32) :: res(5), ans(5)=[1984865646, -248954393, -1192993267, &
|
73 | 78 | 1700514835, 1189401802]
|
74 | 79 |
|
75 |
| - |
76 |
| - print *, "" |
77 |
| - print *, "Test random_rand with kind int32" |
78 | 80 | put = 12345678
|
79 | 81 | call random_seed(put, get)
|
80 | 82 | do i = 1, 5
|
81 | 83 | res(i) = dist_rand(1_int32)
|
82 | 84 | 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)) |
85 | 86 | end subroutine test_random_rand_iint32
|
86 | 87 |
|
87 |
| - subroutine test_random_rand_iint64 |
| 88 | + subroutine test_random_rand_iint64(error) |
| 89 | + !> Error handling |
| 90 | + type(error_type), allocatable, intent(out) :: error |
88 | 91 | integer :: put, get, i
|
89 |
| - |
90 | 92 | integer(int64) :: res(5), ans(5)=[8524933037632333570_int64, &
|
91 | 93 | -1069250973542918798_int64, &
|
92 | 94 | -5123867065024149335_int64, &
|
93 | 95 | 7303655603304982073_int64, &
|
94 | 96 | 5108441843522503546_int64]
|
95 | 97 |
|
96 |
| - |
97 |
| - print *, "" |
98 |
| - print *, "Test random_rand with kind int64" |
99 | 98 | put = 12345678
|
100 | 99 | call random_seed(put, get)
|
101 | 100 | do i = 1, 5
|
102 | 101 | res(i) = dist_rand(1_int64)
|
103 | 102 | 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)) |
106 | 104 | end subroutine test_random_rand_iint64
|
107 | 105 |
|
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