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 [pm_arrayRange](@ref pm_arrayRange).
19 : !>
20 : !> \fintest
21 : !>
22 : !> \author
23 : !> \AmirShahmoradi, Sunday 4:33 PM, September 19, 2021, Dallas, TX
24 :
25 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
26 :
27 : #if SK_ENABLED
28 : #define ALL
29 : #define TYPE_KIND character(1,SKC)
30 : integer(IK) :: step
31 : character(1,SKC) :: start, finit
32 2 : character(:,SKC), allocatable :: range, range_ref
33 : #elif IK_ENABLED
34 : #define TYPE_KIND integer(IKC)
35 : integer(IKC) :: start, finit, step
36 : integer(IKC) , allocatable :: range(:), range_ref(:)
37 : #elif RK_ENABLED
38 : #define TYPE_KIND real(RKC)
39 : real(RKC) :: start, finit, step
40 : real(RKC) , allocatable :: range(:), range_ref(:)
41 : real(RKC) , parameter :: TOL = 10 * epsilon(0._RKC)
42 : #else
43 : #error "Unrecognized interface."
44 : #endif
45 20 : assertion = .true._LK
46 :
47 : !%%%%%%%%%%%%%%%
48 : #if getRange_ENABLED
49 : !%%%%%%%%%%%%%%%
50 :
51 10 : call reset()
52 : #if SK_ENABLED
53 1 : step = 1
54 1 : start = "z"
55 1 : finit = "a"
56 1 : allocate(character(0,SKC) :: range_ref)
57 : #elif IK_ENABLED
58 5 : step = 1_IKC
59 5 : start = +0_IKC
60 5 : finit = -5_IKC
61 5 : allocate(range_ref(0))
62 : #elif RK_ENABLED
63 4 : step = 1._RKC
64 4 : start = +0._RKC
65 4 : finit = -5._RKC
66 4 : allocate(range_ref(0))
67 : #endif
68 10 : call report(start, finit, step = step)
69 10 : call test%assert(assertion, SK_"getRange() must yield an empty `range` with `finit < start` with a positive `step`.")
70 :
71 10 : call report(finit, start, step = -step)
72 10 : call test%assert(assertion, SK_"getRange() must yield an empty `range` with `finit > start` with a negative `step`.")
73 :
74 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
75 :
76 10 : call reset()
77 : #if SK_ENABLED
78 1 : step = 1
79 1 : start = "a"
80 1 : finit = "a"
81 1 : range_ref = start
82 : #elif IK_ENABLED
83 1 : step = 1_IKC
84 5 : start = +1_IKC
85 5 : finit = +1_IKC
86 15 : range_ref = [start]
87 : #elif RK_ENABLED
88 2 : step = 1._RKC
89 4 : start = +1._RKC
90 4 : finit = +1._RKC
91 12 : range_ref = [start]
92 : #endif
93 :
94 10 : call report(start, finit)
95 10 : call test%assert(assertion, SK_"getRange() must yield an `range` of size `1` with `finit == start`.")
96 :
97 10 : call report(start, finit, step = step)
98 10 : call test%assert(assertion, SK_"getRange() must yield an `range` of size `1` with `finit == start` with an equality `step`.")
99 :
100 10 : call report(finit, start, step = -step)
101 10 : call test%assert(assertion, SK_"getRange() must yield an `range` of size `1` with `finit == start` with an equality `step`.")
102 :
103 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
104 :
105 10 : call reset()
106 : #if SK_ENABLED
107 1 : step = 2
108 1 : start = "a"
109 1 : finit = "b"
110 1 : range_ref = start
111 : #elif IK_ENABLED
112 5 : step = 2_IKC
113 1 : start = +1_IKC
114 5 : finit = +2_IKC
115 15 : range_ref = [start]
116 : #elif RK_ENABLED
117 4 : step = 2._RKC
118 2 : start = +1._RKC
119 4 : finit = +2._RKC
120 12 : range_ref = [start]
121 : #endif
122 :
123 10 : call report(start, finit, step = step)
124 10 : call test%assert(assertion, SK_"getRange() must yield an `range` of size `1` with `finit < start + step`.")
125 :
126 19 : range_ref = finit
127 10 : call report(finit, start, step = -step)
128 10 : call test%assert(assertion, SK_"getRange() must yield an `range` of size `1` with `finit - step < start`.")
129 :
130 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
131 :
132 10 : call reset()
133 : #if SK_ENABLED
134 1 : step = 2
135 1 : start = "a"
136 1 : finit = "h"
137 1 : range_ref = SKC_"aceg"
138 : #elif IK_ENABLED
139 1 : step = 2_IKC
140 5 : start = -1_IKC
141 5 : finit = +5_IKC
142 30 : range_ref = [-1_IKC, +1_IKC, +3_IKC, +5_IKC]
143 : #elif RK_ENABLED
144 2 : step = 2._RKC
145 4 : start = -1._RKC
146 4 : finit = +6._RKC
147 24 : range_ref = [real(RKC) :: -1, +1, +3, +5]
148 : #endif
149 10 : call report(start, finit, step = step)
150 30 : call test%assert(assertion, SK_"getRange() must yield a proper `range` with start, finit, step = "//getStr([start, finit])//SK_", "//getStr(step))
151 :
152 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
153 :
154 10 : call reset()
155 : #if SK_ENABLED
156 1 : step = -3
157 1 : start = "h"
158 1 : finit = "a"
159 1 : range_ref = SKC_"heb"
160 : #elif IK_ENABLED
161 5 : step = -3_IKC
162 5 : start = +6_IKC
163 5 : finit = -1_IKC
164 25 : range_ref = [6_IKC, +3_IKC, 0_IKC]
165 : #elif RK_ENABLED
166 4 : step = -3._RKC
167 4 : start = +6._RKC
168 4 : finit = -1._RKC
169 20 : range_ref = [real(RKC) :: 6, +3, 0]
170 : #endif
171 10 : call report(start, finit, step = step)
172 30 : call test%assert(assertion, SK_"getRange() must yield a proper `range` with start, finit, step = "//getStr([start, finit])//SK_", "//getStr(step))
173 :
174 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
175 :
176 10 : call reset()
177 : #if SK_ENABLED
178 1 : start = "c"
179 1 : finit = "a"
180 1 : range_ref = SKC_"cba"
181 : #elif IK_ENABLED
182 5 : start = +3_IKC
183 1 : finit = -1_IKC
184 35 : range_ref = [integer(IKC) :: 3, 2, 1, 0, -1]
185 : #elif RK_ENABLED
186 4 : start = 1._RKC
187 4 : finit = nearest(nearest(1._RKC, -1._RKC), -1._RKC)
188 20 : range_ref = [real(RKC) :: start, nearest(1._RKC, -1._RKC), finit]
189 : #endif
190 10 : call report(start, finit)
191 30 : call test%assert(assertion, SK_"getRange() must yield a proper `range` with start, finit = "//getStr([start, finit]))
192 :
193 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
194 :
195 10 : call reset()
196 : #if SK_ENABLED
197 1 : start = "A"
198 1 : finit = "z"
199 : #elif IK_ENABLED
200 5 : start = 1_IKC
201 5 : finit = 10_IKC
202 : #elif RK_ENABLED
203 2 : start = 1._RKC
204 4 : finit = 1._RKC + 1000 * epsilon(0._RKC)
205 : #endif
206 4073 : range = getRange(start, finit)
207 30 : call test%assert(assertion, SK_"getRange() must yield a proper `range` with start, finit = "//getStr([start, finit]))
208 :
209 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
210 :
211 : contains
212 :
213 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
214 :
215 100 : subroutine report(start, finit, step)
216 : TYPE_KIND, intent(in) :: start, finit
217 : #if SK_ENABLED
218 : integer(IK), intent(in), optional :: step
219 : #else
220 : TYPE_KIND, intent(in), optional :: step
221 : #endif
222 100 : type(display_type) :: disp
223 100 : if (present(step)) then
224 251 : range = getRange(start, finit, step)
225 : else
226 84 : range = getRange(start, finit)
227 : end if
228 : #if SK_ENABLED || IK_ENABLED
229 145 : assertion = assertion .and. ALL(range == range_ref)
230 : #elif RK_ENABLED
231 100 : assertion = assertion .and. all(isClose(range_ref, range, abstol = TOL))
232 : #endif
233 100 : if (test%traceable .and. .not. assertion) then
234 : ! LCOV_EXCL_START
235 : call disp%skip
236 : call disp%show("start")
237 : call disp%show( start )
238 : call disp%show("finit")
239 : call disp%show( finit )
240 : call disp%show("present(step)")
241 : call disp%show( present(step) )
242 : if (present(step)) then
243 : call disp%show("step")
244 : call disp%show( step )
245 : end if
246 : call disp%show("range")
247 : call disp%show( range )
248 : call disp%show("range_ref")
249 : call disp%show( range_ref )
250 : ! LCOV_EXCL_STOP
251 : end if
252 100 : end subroutine
253 :
254 : !%%%%%%%%%%%%%%%
255 : #elif setRange_ENABLED
256 : !%%%%%%%%%%%%%%%
257 :
258 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
259 :
260 10 : call reset()
261 : #if SK_ENABLED
262 1 : step = 1_IK
263 1 : start = "a"
264 1 : finit = "c"
265 1 : range_ref = SKC_"abc"
266 : #elif IK_ENABLED
267 5 : step = 1_IKC
268 5 : start = +1_IKC
269 5 : finit = +3_IKC
270 25 : range_ref = [integer(IKC) :: 1, 2, 3]
271 : #elif RK_ENABLED
272 4 : step = 1._RKC
273 4 : start = 1._RKC
274 4 : finit = 4._RKC
275 20 : range_ref = [real(RKC) :: 1, 2, 3]
276 : #endif
277 18 : allocate(range, mold = range_ref)
278 10 : call report(start, step)
279 30 : call test%assert(assertion, SK_"getRange() must yield a proper `range` with start, finit, step = "//getStr([start, finit])//SK_", "//getStr(step))
280 :
281 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
282 :
283 10 : call reset()
284 : #if SK_ENABLED
285 1 : step = -2_IK
286 1 : start = "f"
287 1 : finit = "a"
288 1 : range_ref = SKC_"fdb"
289 : #elif IK_ENABLED
290 5 : step = -2_IKC
291 5 : start = +6_IKC
292 5 : finit = +1_IKC
293 25 : range_ref = [integer(IKC) :: 6, 4, 2]
294 : #elif RK_ENABLED
295 4 : step = -2._RKC
296 4 : start = 6._RKC
297 4 : finit = 1._RKC
298 20 : range_ref = [real(RKC) :: 6, 4, 2]
299 : #endif
300 18 : allocate(range, mold = range_ref)
301 10 : call report(start, step)
302 30 : call test%assert(assertion, SK_"getRange() must yield a proper `range` with start, finit, step = "//getStr([start, finit])//SK_", "//getStr(step))
303 :
304 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
305 :
306 10 : call reset()
307 : #if SK_ENABLED
308 1 : start = "a"
309 1 : range_ref = SKC_"abc"
310 : #elif IK_ENABLED
311 5 : start = +1_IKC
312 25 : range_ref = [integer(IKC) :: 1, 2, 3]
313 : #elif RK_ENABLED
314 4 : start = 1._RKC
315 4 : allocate(range_ref(3))
316 : block
317 : integer(IK) :: i
318 4 : range_ref(1) = nearest(1._RKC, 1._RKC)
319 12 : do i = 2, size(range_ref)
320 12 : range_ref(i) = nearest(range_ref(i - 1), 1._RKC)
321 : end do
322 : end block
323 : #endif
324 14 : allocate(range, mold = range_ref)
325 10 : call report(start)
326 30 : call test%assert(assertion, SK_"getRange() must yield a proper `range` with start, finit, step = "//getStr([start, finit])//SK_", "//getStr(step))
327 :
328 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
329 :
330 : contains
331 :
332 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
333 :
334 30 : subroutine report(start, step)
335 : TYPE_KIND, intent(in) :: start
336 : #if SK_ENABLED
337 : integer(IK), intent(in), optional :: step
338 : #else
339 : TYPE_KIND, intent(in), optional :: step
340 : #endif
341 30 : type(display_type) :: disp
342 30 : if (present(step)) then
343 20 : call setRange(range, start, step)
344 : else
345 10 : call setRange(range, start)
346 : end if
347 : #if SK_ENABLED || IK_ENABLED
348 63 : assertion = assertion .and. ALL(range == range_ref)
349 : #elif RK_ENABLED
350 48 : assertion = assertion .and. all(isClose(range_ref, range, abstol = TOL))
351 : #endif
352 30 : if (test%traceable .and. .not. assertion) then
353 : ! LCOV_EXCL_START
354 : call disp%skip
355 : call disp%show("start")
356 : call disp%show( start )
357 : call disp%show("finit")
358 : call disp%show( finit )
359 : call disp%show("present(step)")
360 : call disp%show( present(step) )
361 : if (present(step)) then
362 : call disp%show("step")
363 : call disp%show( step )
364 : end if
365 : call disp%show("range")
366 : call disp%show( range )
367 : call disp%show("range_ref")
368 : call disp%show( range_ref )
369 : ! LCOV_EXCL_STOP
370 : end if
371 30 : end subroutine
372 :
373 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
374 :
375 : #else
376 : #error "Unrecognized interface."
377 : #endif
378 :
379 100 : subroutine reset()
380 100 : if (allocated(range)) deallocate(range)
381 100 : if (allocated(range_ref)) deallocate(range_ref)
382 100 : end subroutine
383 :
384 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
385 :
386 : #undef TYPE_KIND
387 : #undef ALL
|
