Line data Source code
1 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3 : !!!! !!!!
4 : !!!! ParaMonte: Parallel Monte Carlo and Machine Learning Library. !!!!
5 : !!!! !!!!
6 : !!!! Copyright (C) 2012-present, The Computational Data Science Lab !!!!
7 : !!!! !!!!
8 : !!!! This file is part of the ParaMonte library. !!!!
9 : !!!! !!!!
10 : !!!! LICENSE !!!!
11 : !!!! !!!!
12 : !!!! https://github.com/cdslaborg/paramonte/blob/main/LICENSE.md !!!!
13 : !!!! !!!!
14 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
15 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
16 :
17 : !> \brief
18 : !> This include file contains the implementations of the tests of procedures with generic interfaces of [pm_except](@ref pm_except).
19 : !>
20 : !> \fintest
21 : !>
22 : !> \author
23 : !> \AmirShahmoradi, Sunday 4:33 PM, September 19, 2021, Dallas, TX
24 :
25 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
26 :
27 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
28 : #if getInfPos_ENABLED || setInfPos_ENABLED || getInfNeg_ENABLED || setInfNeg_ENABLED
29 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
30 :
31 : #if getInfPos_ENABLED
32 : #define test_getInf_ENABLED 1
33 : #define GEN_INF getInfPos
34 : #define IS_INF isInfPos
35 : #elif setInfPos_ENABLED
36 : #define test_setInf_ENABLED 1
37 : #define GET_INF setInfPos
38 : #define IS_INF isInfPos
39 : #elif getInfNeg_ENABLED
40 : #define test_getInf_ENABLED 1
41 : #define GEN_INF getInfNeg
42 : #define IS_INF isInfNeg
43 : #elif setInfNeg_ENABLED
44 : #define test_setInf_ENABLED 1
45 : #define GET_INF setInfNeg
46 : #define IS_INF isInfNeg
47 : #else
48 : #error "Unrecognized interface."
49 : #endif
50 :
51 : #if CK_ENABLED
52 : complex(CKC), allocatable :: Inf(:)
53 : real(CKC) , allocatable :: Dummy(:) ! \bug bypass Intel 2021.4 bug.
54 : #elif RK_ENABLED
55 : real(RKC) , allocatable :: Inf(:)
56 : #else
57 : #error "Unrecognized interface."
58 : #endif
59 31 : assertion = .true._LK
60 32 : allocate(Inf(3))
61 :
62 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
63 :
64 : #if test_getInf_ENABLED
65 16 : Inf(1) = GEN_INF(Inf(1))
66 : #elif test_setInf_ENABLED
67 16 : call GET_INF(Inf(1))
68 : #endif
69 :
70 32 : assertion = assertion .and. IS_INF(Inf(1))
71 32 : call report()
72 32 : call test%assert(assertion, SK_"GEN_INF()/GET_INF() must return must return a scalar `Inf`.", int(__LINE__, IK))
73 :
74 32 : assertion = assertion .and. isInf(Inf(1))
75 32 : call report()
76 32 : call test%assert(assertion, SK_"GEN_INF()/GET_INF() must return must return a scalar `Inf`.", int(__LINE__, IK))
77 :
78 : #if test_getInf_ENABLED
79 112 : Inf = GEN_INF(Inf)
80 : #elif test_setInf_ENABLED
81 64 : call GET_INF(Inf)
82 : #endif
83 :
84 128 : assertion = assertion .and. all(IS_INF(Inf))
85 32 : call report()
86 32 : call test%assert(assertion, SK_"GEN_INF()/GET_INF() must return must return a vector `Inf`.", int(__LINE__, IK))
87 :
88 128 : assertion = assertion .and. all(isInf(Inf))
89 32 : call report()
90 32 : call test%assert(assertion, SK_"GEN_INF()/GET_INF() must return must return a vector `Inf`.", int(__LINE__, IK))
91 :
92 : #if test_getInf_ENABLED
93 16 : Inf(1) = GEN_INF(Inf(1))
94 16 : Inf(3) = GEN_INF(Inf(3))
95 : #elif test_setInf_ENABLED
96 16 : call GET_INF(Inf(1))
97 16 : call GET_INF(Inf(3))
98 : #endif
99 32 : call setUnifRand(Inf(2))
100 :
101 32 : assertion = assertion .and. IS_INF(Inf(1)) .and. IS_INF(Inf(3)) .and. .not. IS_INF(Inf(2))
102 32 : call report()
103 32 : call test%assert(assertion, SK_"IS_INF() must properly recognize two `Inf` values in a vector of 3 values.", int(__LINE__, IK))
104 :
105 32 : assertion = assertion .and. isInf(Inf(1)) .and. isInf(Inf(3)) .and. .not. isInf(Inf(2))
106 32 : call report()
107 32 : call test%assert(assertion, SK_"isInf() must properly recognize two `Inf` values in a vector of 3 values.", int(__LINE__, IK))
108 :
109 : #if CK_ENABLED
110 16 : allocate(Dummy(size(Inf)))
111 : #if test_getInf_ENABLED
112 8 : Dummy(1) = GEN_INF(Dummy(1))
113 : #elif test_setInf_ENABLED
114 8 : call GET_INF(Dummy(1))
115 : #endif
116 16 : Inf(1)%re = Dummy(1)
117 16 : call setUnifRand(Dummy(1))
118 16 : Inf(1)%im = Dummy(1)
119 :
120 16 : assertion = assertion .and. IS_INF(Inf(1)%re) .and. .not. IS_INF(Inf(1)%im)
121 16 : call report()
122 16 : call test%assert(assertion, SK_"IS_INF() must properly recognize a scalar `Inf` real component and a scalar `Inf` imaginary component.", int(__LINE__, IK))
123 :
124 16 : assertion = assertion .and. isInf(Inf(1)%re) .and. .not. isInf(Inf(1)%im)
125 16 : call report()
126 16 : call test%assert(assertion, SK_"isInf() must properly recognize a scalar `Inf` real component and a scalar `Inf` imaginary component.", int(__LINE__, IK))
127 : #endif
128 :
129 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
130 :
131 : contains
132 :
133 224 : subroutine report()
134 224 : if (test%traceable .and. .not. assertion) then
135 : ! LCOV_EXCL_START
136 : write(test%disp%unit,"(*(g0,:,', '))")
137 : write(test%disp%unit,"(*(g0,:,', '))") "Inf", Inf
138 : write(test%disp%unit,"(*(g0,:,', '))")
139 : ! LCOV_EXCL_STOP
140 : end if
141 224 : end subroutine
142 :
143 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
144 : #elif getNAN_ENABLED || setNAN_ENABLED
145 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
146 :
147 :
148 : #if CK_ENABLED
149 : complex(CKC), allocatable :: NAN(:)
150 : real(CKC) , allocatable :: Dummy(:) ! \bug bypass Intel 2021.4 bug.
151 : #elif RK_ENABLED
152 : real(RKC) , allocatable :: NAN(:)
153 : #else
154 : #error "Unrecognized interface."
155 : #endif
156 :
157 16 : assertion = .true._LK
158 :
159 16 : allocate(NAN(3))
160 :
161 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
162 :
163 : #if getNAN_ENABLED
164 8 : NAN(1) = getNAN(NAN(1))
165 : #elif setNAN_ENABLED
166 8 : call setNAN(NAN(1))
167 : #endif
168 16 : assertion = assertion .and. isNAN(NAN(1))
169 16 : call report()
170 16 : call test%assert(assertion, SK_"getNAN() must return must return a scalar `NAN`.", int(__LINE__, IK))
171 :
172 : #if getNAN_ENABLED
173 56 : NAN = getNAN(NAN)
174 : #elif setNAN_ENABLED
175 32 : call setNAN(NAN)
176 : #endif
177 64 : assertion = assertion .and. all(isNAN(NAN))
178 16 : call report()
179 16 : call test%assert(assertion, SK_"getNAN() must return must return a vector `NAN`.", int(__LINE__, IK))
180 :
181 : #if getNAN_ENABLED
182 8 : NAN(1) = getNAN(NAN(1))
183 8 : NAN(3) = getNAN(NAN(3))
184 : #elif setNAN_ENABLED
185 8 : call setNAN(NAN(1))
186 8 : call setNAN(NAN(3))
187 : #endif
188 16 : call setUnifRand(NAN(2))
189 16 : assertion = assertion .and. isNAN(NAN(1)) .and. isNAN(NAN(3)) .and. .not. isNAN(NAN(2))
190 16 : call report()
191 16 : call test%assert(assertion, SK_"isNAN() must properly recognize two `NAN` values in a vector of 3 values.", int(__LINE__, IK))
192 :
193 : #if CK_ENABLED
194 8 : allocate(Dummy(size(NAN)))
195 : #if getNAN_ENABLED
196 4 : Dummy(1) = getNAN(Dummy(1))
197 : #elif setNAN_ENABLED
198 4 : call setNAN(Dummy(1))
199 : #endif
200 8 : NAN(1)%re = Dummy(1)
201 8 : call setUnifRand(Dummy(1))
202 8 : NAN(1)%im = Dummy(1)
203 8 : assertion = assertion .and. isNAN(NAN(1)%re) .and. .not. isNAN(NAN(1)%im)
204 8 : call report()
205 8 : call test%assert(assertion, SK_"isNAN() must properly recognize a scalar `NAN` real component and a scalar `NAN` imaginary component.", int(__LINE__, IK))
206 : #endif
207 :
208 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
209 :
210 : contains
211 :
212 56 : subroutine report()
213 56 : if (test%traceable .and. .not. assertion) then
214 : ! LCOV_EXCL_START
215 : write(test%disp%unit,"(*(g0,:,', '))")
216 : write(test%disp%unit,"(*(g0,:,', '))") "NAN", NAN
217 : write(test%disp%unit,"(*(g0,:,', '))")
218 : ! LCOV_EXCL_STOP
219 : end if
220 56 : end subroutine
221 :
222 : #else
223 : !%%%%%%%%%%%%%%%%%%%%%%%%
224 : #error "Unrecognized interface."
225 : !%%%%%%%%%%%%%%%%%%%%%%%%
226 : #endif
227 : #undef test_getInf_ENABLED
228 : #undef test_setInf_ENABLED
229 : #undef GEN_INF
230 : #undef GET_INF
231 : #undef IS_INF
|
