forked from fortran-lang/stdlib
-
Notifications
You must be signed in to change notification settings - Fork 0
/
test_loadtxt_qp.fypp
129 lines (101 loc) · 3.63 KB
/
test_loadtxt_qp.fypp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
#:include "common.fypp"
module test_loadtxt_qp
use stdlib_kinds, only: qp
use stdlib_io, only: loadtxt, savetxt
use testdrive, only: new_unittest, unittest_type, error_type, check, skip_test
implicit none
private
public :: collect_loadtxt_qp
contains
!> Collect all exported unit tests
subroutine collect_loadtxt_qp(testsuite)
!> Collection of tests
type(unittest_type), allocatable, intent(out) :: testsuite(:)
testsuite = [ &
new_unittest("loadtxt_qp", test_loadtxt_qp_), &
new_unittest("loadtxt_qp_huge", test_loadtxt_qp_huge), &
new_unittest("loadtxt_qp_tiny", test_loadtxt_qp_tiny) &
]
end subroutine collect_loadtxt_qp
subroutine test_loadtxt_qp_(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#:if WITH_QP
real(qp), allocatable :: input(:,:), expected(:,:)
integer :: n
allocate(input(10,10))
allocate(expected(10,10))
do n = 1, 100
call random_number(input)
input = input - 0.5
call savetxt('test_qp.txt', input)
call loadtxt('test_qp.txt', expected)
call check(error, all(input == expected))
if (allocated(error)) return
end do
#:else
call skip_test(error, "Quadruple precision is not enabled")
#:endif
end subroutine test_loadtxt_qp_
subroutine test_loadtxt_qp_huge(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#:if WITH_QP
real(qp), allocatable :: input(:,:), expected(:,:)
integer :: n
allocate(input(10,10))
allocate(expected(10,10))
do n = 1, 10
call random_number(input)
input = (input - 0.5) * huge(input)
call savetxt('test_qp_huge.txt', input)
call loadtxt('test_qp_huge.txt', expected)
call check(error, all(input == expected))
if (allocated(error)) return
end do
#:else
call skip_test(error, "Quadruple precision is not enabled")
#:endif
end subroutine test_loadtxt_qp_huge
subroutine test_loadtxt_qp_tiny(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#:if WITH_QP
real(qp), allocatable :: input(:,:), expected(:,:)
integer :: n
allocate(input(10,10))
allocate(expected(10,10))
do n = 1, 10
call random_number(input)
input = (input - 0.5) * tiny(input)
call savetxt('test_qp_tiny.txt', input)
call loadtxt('test_qp_tiny.txt', expected)
call check(error, all(input == expected))
if (allocated(error)) return
end do
#:else
call skip_test(error, "Quadruple precision is not enabled")
#:endif
end subroutine test_loadtxt_qp_tiny
end module test_loadtxt_qp
program tester
use, intrinsic :: iso_fortran_env, only : error_unit
use testdrive, only : run_testsuite, new_testsuite, testsuite_type
use test_loadtxt_qp, only : collect_loadtxt_qp
implicit none
integer :: stat, is
type(testsuite_type), allocatable :: testsuites(:)
character(len=*), parameter :: fmt = '("#", *(1x, a))'
stat = 0
testsuites = [ &
new_testsuite("loadtxt_qp", collect_loadtxt_qp) &
]
do is = 1, size(testsuites)
write(error_unit, fmt) "Testing:", testsuites(is)%name
call run_testsuite(testsuites(is)%collect, error_unit, stat)
end do
if (stat > 0) then
write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!"
error stop
end if
end program tester