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 module contains implementations of the tests of the procedures under the generic interfaces of [pm_arrayComplement](@ref pm_arrayComplement).
19 : !>
20 : !> \fintest
21 : !>
22 : !> \author
23 : !> \AmirShahmoradi, September 1, 2017, 11:35 PM, Institute for Computational Engineering and Sciences (ICES), The University of Texas at Austin
24 :
25 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
26 :
27 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
28 : #if getComplementRange_D1_IK_ENABLED
29 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
30 :
31 : character(*, SK), parameter :: PROCEDURE_NAME = "@getComplementRange()"
32 :
33 : integer(IKC) :: start, stop, step
34 : integer(IKC), allocatable :: setA(:), setB(:), Complement(:), Complement_ref(:)
35 :
36 5 : assertion = .true.
37 :
38 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
39 :
40 5 : setA = [integer(IKC) ::]
41 5 : Complement_ref = [integer(IKC) ::]
42 5 : start = 2_IKC
43 5 : stop = 1_IKC
44 5 : step = 1_IKC
45 :
46 10 : Complement = getComplementRange(setA, start, stop, step)
47 5 : call report(int(__LINE__, IK))
48 :
49 10 : Complement = getComplementRange(setA, start, stop, step, sorted = .false._LK, unique = .false._LK)
50 5 : call report(int(__LINE__, IK))
51 :
52 10 : Complement = getComplementRange(setA, start, stop, step, sorted = .false._LK, unique = .true._LK)
53 5 : call report(int(__LINE__, IK))
54 :
55 5 : call setSorted(setA)
56 10 : Complement = getComplementRange(setA, start, stop, step, sorted = .true._LK, unique = .false._LK)
57 5 : call report(int(__LINE__, IK))
58 :
59 10 : Complement = getComplementRange(setA, start, stop, step, sorted = .true._LK, unique = .true._LK)
60 5 : call report(int(__LINE__, IK))
61 :
62 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
63 :
64 35 : setA = int([-1,2,0,4,5], IKC)
65 5 : Complement_ref = [integer(IKC) ::]
66 5 : start = 5_IKC
67 5 : stop = 2_IKC
68 5 : step = 1_IKC
69 :
70 10 : Complement = getComplementRange(setA, start, stop, step)
71 5 : call report(int(__LINE__, IK))
72 :
73 10 : Complement = getComplementRange(setA, start, stop, step, sorted = .false._LK, unique = .false._LK)
74 5 : call report(int(__LINE__, IK))
75 :
76 10 : Complement = getComplementRange(setA, start, stop, step, sorted = .false._LK, unique = .true._LK)
77 5 : call report(int(__LINE__, IK))
78 :
79 5 : call setSorted(setA)
80 10 : Complement = getComplementRange(setA, start, stop, step, sorted = .true._LK, unique = .false._LK)
81 5 : call report(int(__LINE__, IK))
82 :
83 10 : Complement = getComplementRange(setA, start, stop, step, sorted = .true._LK, unique = .true._LK)
84 5 : call report(int(__LINE__, IK))
85 :
86 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
87 :
88 5 : start = -2_IKC
89 5 : stop = 5_IKC
90 5 : step = 1_IKC
91 5 : setA = [integer(IKC) ::]
92 50 : Complement_ref = getRange(start, stop, step)
93 :
94 50 : Complement = getComplementRange(setA, start, stop, step)
95 5 : call report(int(__LINE__, IK))
96 :
97 50 : Complement = getComplementRange(setA, start, stop, step, sorted = .false._LK, unique = .false._LK)
98 5 : call report(int(__LINE__, IK))
99 :
100 50 : Complement = getComplementRange(setA, start, stop, step, sorted = .false._LK, unique = .true._LK)
101 5 : call report(int(__LINE__, IK))
102 :
103 5 : call setSorted(setA)
104 50 : Complement = getComplementRange(setA, start, stop, step, sorted = .true._LK, unique = .false._LK)
105 5 : call report(int(__LINE__, IK))
106 :
107 50 : Complement = getComplementRange(setA, start, stop, step, sorted = .true._LK, unique = .true._LK)
108 5 : call report(int(__LINE__, IK))
109 :
110 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
111 :
112 35 : setA = int([-1,2,0,4,5], IKC)
113 25 : Complement_ref = int([-2,1,3], IKC)
114 5 : start = -2_IKC
115 5 : stop = 5_IKC
116 5 : step = 1_IKC
117 :
118 25 : Complement = getComplementRange(setA, start, stop, step)
119 5 : call report(int(__LINE__, IK))
120 :
121 25 : Complement = getComplementRange(setA, start, stop, step, sorted = .false._LK, unique = .false._LK)
122 5 : call report(int(__LINE__, IK))
123 :
124 25 : Complement = getComplementRange(setA, start, stop, step, sorted = .false._LK, unique = .true._LK)
125 5 : call report(int(__LINE__, IK))
126 :
127 5 : call setSorted(setA)
128 25 : Complement = getComplementRange(setA, start, stop, step, sorted = .true._LK, unique = .false._LK)
129 5 : call report(int(__LINE__, IK))
130 :
131 25 : Complement = getComplementRange(setA, start, stop, step, sorted = .true._LK, unique = .true._LK)
132 5 : call report(int(__LINE__, IK))
133 :
134 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
135 :
136 35 : setA = int([-1,2,0,4,5], IKC)
137 30 : Complement_ref = int([-2,1,3,6], IKC)
138 5 : start = -2_IKC
139 5 : stop = 6_IKC
140 5 : step = 1_IKC
141 :
142 30 : Complement = getComplementRange(setA, start, stop, step)
143 5 : call report(int(__LINE__, IK))
144 :
145 30 : Complement = getComplementRange(setA, start, stop, step, sorted = .false._LK, unique = .false._LK)
146 5 : call report(int(__LINE__, IK))
147 :
148 30 : Complement = getComplementRange(setA, start, stop, step, sorted = .false._LK, unique = .true._LK)
149 5 : call report(int(__LINE__, IK))
150 :
151 5 : call setSorted(setA)
152 30 : Complement = getComplementRange(setA, start, stop, step, sorted = .true._LK, unique = .false._LK)
153 5 : call report(int(__LINE__, IK))
154 :
155 30 : Complement = getComplementRange(setA, start, stop, step, sorted = .true._LK, unique = .true._LK)
156 5 : call report(int(__LINE__, IK))
157 :
158 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
159 :
160 35 : setA = int([-1,2,0,4,5], IKC)
161 20 : Complement_ref = int([-2,6], IKC)
162 5 : start = -2_IKC
163 5 : stop = 6_IKC
164 5 : step = 2_IKC
165 :
166 20 : Complement = getComplementRange(setA, start, stop, step)
167 5 : call report(int(__LINE__, IK))
168 :
169 20 : Complement = getComplementRange(setA, start, stop, step, sorted = .false._LK, unique = .false._LK)
170 5 : call report(int(__LINE__, IK))
171 :
172 20 : Complement = getComplementRange(setA, start, stop, step, sorted = .false._LK, unique = .true._LK)
173 5 : call report(int(__LINE__, IK))
174 :
175 5 : call setSorted(setA)
176 20 : Complement = getComplementRange(setA, start, stop, step, sorted = .true._LK, unique = .false._LK)
177 5 : call report(int(__LINE__, IK))
178 :
179 20 : Complement = getComplementRange(setA, start, stop, step, sorted = .true._LK, unique = .true._LK)
180 5 : call report(int(__LINE__, IK))
181 :
182 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
183 :
184 35 : setA = int([-1,2,0,4,5], IKC)
185 25 : Complement_ref = int([7, 1, -2], IKC)
186 5 : start = 7_IKC
187 5 : stop = -2_IKC
188 5 : step = -3_IKC
189 :
190 25 : Complement = getComplementRange(setA, start, stop, step)
191 5 : call report(int(__LINE__, IK))
192 :
193 25 : Complement = getComplementRange(setA, start, stop, step, sorted = .false._LK, unique = .false._LK)
194 5 : call report(int(__LINE__, IK))
195 :
196 25 : Complement = getComplementRange(setA, start, stop, step, sorted = .false._LK, unique = .true._LK)
197 5 : call report(int(__LINE__, IK))
198 :
199 5 : call setSorted(setA)
200 25 : Complement = getComplementRange(setA, start, stop, step, sorted = .true._LK, unique = .false._LK)
201 5 : call report(int(__LINE__, IK))
202 :
203 25 : Complement = getComplementRange(setA, start, stop, step, sorted = .true._LK, unique = .true._LK)
204 5 : call report(int(__LINE__, IK))
205 :
206 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
207 :
208 35 : setA = int([-1,2,0,4,6], IKC)
209 25 : Complement_ref = int([1, 3, 5], IKC)
210 5 : start = 0_IKC
211 5 : stop = 5_IKC
212 5 : step = 1_IKC
213 :
214 25 : Complement = getComplementRange(setA, start, stop, step)
215 5 : call report(int(__LINE__, IK))
216 :
217 25 : Complement = getComplementRange(setA, start, stop, step, sorted = .false._LK, unique = .false._LK)
218 5 : call report(int(__LINE__, IK))
219 :
220 25 : Complement = getComplementRange(setA, start, stop, step, sorted = .false._LK, unique = .true._LK)
221 5 : call report(int(__LINE__, IK))
222 :
223 5 : call setSorted(setA)
224 25 : Complement = getComplementRange(setA, start, stop, step, sorted = .true._LK, unique = .false._LK)
225 5 : call report(int(__LINE__, IK))
226 :
227 25 : Complement = getComplementRange(setA, start, stop, step, sorted = .true._LK, unique = .true._LK)
228 5 : call report(int(__LINE__, IK))
229 :
230 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
231 :
232 90 : setA = int([-1,2,0,4,6], IKC); setA = setA(size(setA):1:-1)
233 25 : Complement_ref = int([1, 3, 5], IKC)
234 5 : start = 0_IKC
235 5 : stop = 5_IKC
236 5 : step = 1_IKC
237 :
238 25 : Complement = getComplementRange(setA, start, stop, step)
239 5 : call report(int(__LINE__, IK))
240 :
241 25 : Complement = getComplementRange(setA, start, stop, step, sorted = .false._LK, unique = .false._LK)
242 5 : call report(int(__LINE__, IK))
243 :
244 25 : Complement = getComplementRange(setA, start, stop, step, sorted = .false._LK, unique = .true._LK)
245 5 : call report(int(__LINE__, IK))
246 :
247 5 : call setSorted(setA)
248 25 : Complement = getComplementRange(setA, start, stop, step, sorted = .true._LK, unique = .false._LK)
249 5 : call report(int(__LINE__, IK))
250 :
251 25 : Complement = getComplementRange(setA, start, stop, step, sorted = .true._LK, unique = .true._LK)
252 5 : call report(int(__LINE__, IK))
253 :
254 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
255 :
256 90 : setA = int([-1,2,0,4,6], IKC); setA = setA(size(setA):1:-1)
257 5 : Complement_ref = [integer(IKC)::]
258 5 : start = 0_IKC
259 5 : stop = 6_IKC
260 5 : step = 2_IKC
261 :
262 10 : Complement = getComplementRange(setA, start, stop, step)
263 5 : call report(int(__LINE__, IK))
264 :
265 10 : Complement = getComplementRange(setA, start, stop, step, sorted = .false._LK, unique = .false._LK)
266 5 : call report(int(__LINE__, IK))
267 :
268 10 : Complement = getComplementRange(setA, start, stop, step, sorted = .false._LK, unique = .true._LK)
269 5 : call report(int(__LINE__, IK))
270 :
271 5 : call setSorted(setA)
272 10 : Complement = getComplementRange(setA, start, stop, step, sorted = .true._LK, unique = .false._LK)
273 5 : call report(int(__LINE__, IK))
274 :
275 10 : Complement = getComplementRange(setA, start, stop, step, sorted = .true._LK, unique = .true._LK)
276 5 : call report(int(__LINE__, IK))
277 :
278 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
279 :
280 5 : block
281 : use pm_distUnif, only: getUnifRand
282 : integer(IK) :: i
283 1280 : do i = 1, 255_IK
284 :
285 1275 : start = getUnifRand(-53_IKC, 53_IKC)
286 1275 : stop = getUnifRand(-53_IKC, 53_IKC)
287 : do
288 1285 : step = getUnifRand(-53_IKC, 53_IKC)
289 1285 : if (step /= 0_IKC) exit
290 : end do
291 82598 : setA = getUnifRand(-53_IKC, 53_IKC, getUnifRand(0_IK, 126_IK))
292 4795 : setB = getRange(start, stop, step)
293 3882 : Complement_ref = getComplement(setA, setB)
294 :
295 3882 : Complement = getComplementRange(setA, start, stop, step)
296 1275 : call report(int(__LINE__, IK))
297 :
298 3882 : Complement = getComplementRange(setA, start, stop, step, sorted = .false._LK, unique = .false._LK)
299 1275 : call report(int(__LINE__, IK))
300 :
301 3882 : Complement = getComplementRange(setA, start, stop, step, sorted = .false._LK, unique = .true._LK)
302 1275 : call report(int(__LINE__, IK))
303 :
304 1275 : call setSorted(setA)
305 82460 : if (step < 0_IKC) setA = setA(size(setA):1:-1)
306 :
307 3882 : Complement = getComplementRange(setA, start, stop, step, sorted = .true._LK, unique = .false._LK)
308 1275 : call report(int(__LINE__, IK))
309 :
310 115040 : setA = getUnique(setA)
311 3882 : Complement = getComplementRange(setA, start, stop, step, sorted = .true._LK, unique = .true._LK)
312 1280 : call report(int(__LINE__, IK))
313 :
314 : end do
315 : end block
316 :
317 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
318 :
319 : contains
320 :
321 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
322 :
323 6625 : subroutine report(line)
324 : integer(IK), intent(in) :: line
325 : integer(IK) :: i
326 6625 : assertion = assertion .and. size(Complement, kind = IK) == size(Complement_ref, kind = IK)
327 6625 : if (test%traceable .and. .not. assertion) then
328 : ! LCOV_EXCL_START
329 : write(test%disp%unit,"(*(g0,:,', '))")
330 : write(test%disp%unit,"(*(g0,:,', '))") "size(Complement_ref) ", size(Complement_ref, kind = IK)
331 : write(test%disp%unit,"(*(g0,:,', '))") "size(Complement ) ", size(Complement , kind = IK)
332 : write(test%disp%unit,"(*(g0,:,', '))") "Complement_ref ", Complement_ref
333 : write(test%disp%unit,"(*(g0,:,', '))") "Complement ", Complement
334 : if (allocated(setB)) then
335 : write(test%disp%unit,"(*(g0,:,', '))") "setB ", setB
336 : write(test%disp%unit,"(*(g0,:,', '))") "size(setB) ", size(setB)
337 : end if
338 : write(test%disp%unit,"(*(g0,:,', '))") "size(setA) ", size(setA)
339 : write(test%disp%unit,"(*(g0,:,', '))") "setA ", setA
340 : write(test%disp%unit,"(*(g0,:,', '))") "start ", start
341 : write(test%disp%unit,"(*(g0,:,', '))") "stop ", stop
342 : write(test%disp%unit,"(*(g0,:,', '))") "step ", step
343 : write(test%disp%unit,"(*(g0,:,', '))")
344 : ! LCOV_EXCL_STOP
345 : end if
346 6625 : call test%assert(assertion, PROCEDURE_NAME//SK_": The size of the complement of setA with respect to specified range must be computed correctly.", line)
347 :
348 13935 : do i = 1, size(Complement)
349 7310 : assertion = assertion .and. Complement(i) == Complement_ref(i)
350 7310 : if (test%traceable .and. .not. assertion) then
351 : ! LCOV_EXCL_START
352 : write(test%disp%unit,"(*(g0,:,', '))")
353 : write(test%disp%unit,"(*(g0,:,', '))") "start ", start
354 : write(test%disp%unit,"(*(g0,:,', '))") "stop ", stop
355 : write(test%disp%unit,"(*(g0,:,', '))") "step ", step
356 : write(test%disp%unit,"(*(g0,:,', '))") "setA ", setA
357 : write(test%disp%unit,"(*(g0,:,', '))") "Complement_ref ", Complement_ref
358 : write(test%disp%unit,"(*(g0,:,', '))") "Complement ", Complement
359 : write(test%disp%unit,"(*(g0,:,', '))")
360 : ! LCOV_EXCL_STOP
361 : end if
362 13935 : call test%assert(assertion, PROCEDURE_NAME//SK_": The complement of setA with respect to specified range must be computed correctly.", line)
363 : end do
364 :
365 6625 : end subroutine
366 :
367 :
368 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
369 : #else
370 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
371 :
372 : #if getComplement_D1_LK_ENABLED || setComplement_D1_LK_ENABLED
373 : #define IS_EQUAL .eqv.
374 : #else
375 : #define IS_EQUAL ==
376 : #endif
377 :
378 : #if getComplement_ENABLED
379 : character(*, SK), parameter :: PROCEDURE_NAME = "@getComplement()"
380 : #elif setComplement_ENABLED
381 : character(*, SK), parameter :: PROCEDURE_NAME = "@setComplement()"
382 : #endif
383 :
384 : #if getComplement_D0_SK_ENABLED || setComplement_D0_SK_ENABLED
385 : #define ALL
386 1 : character(:,SKC), allocatable :: setA, setB, Complement, Complement_ref
387 : #elif getComplement_D1_SK_ENABLED || setComplement_D1_SK_ENABLED
388 : character(2,SKC), dimension(:), allocatable :: setA, setB, Complement, Complement_ref
389 : #elif getComplement_D1_IK_ENABLED || setComplement_D1_IK_ENABLED
390 : integer(IKC) , dimension(:), allocatable :: setA, setB, Complement, Complement_ref
391 : #elif getComplement_D1_LK_ENABLED || setComplement_D1_LK_ENABLED
392 : logical(LKC) , dimension(:), allocatable :: setA, setB, Complement, Complement_ref
393 : #elif getComplement_D1_CK_ENABLED || setComplement_D1_CK_ENABLED
394 : complex(CKC) , dimension(:), allocatable :: setA, setB, Complement, Complement_ref
395 : #elif getComplement_D1_RK_ENABLED || setComplement_D1_RK_ENABLED
396 : real(RKC) , dimension(:), allocatable :: setA, setB, Complement, Complement_ref
397 : #else
398 : #error "Unrecognized interface."
399 : #endif
400 :
401 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
402 :
403 20 : assertion = .true._LK
404 20 : call runTestsWith()
405 20 : call runTestsWith(iseq = iseq)
406 :
407 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
408 :
409 : contains
410 :
411 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
412 :
413 40 : subroutine runTestsWith (iseq)
414 :
415 : logical(LK) , external , optional :: iseq
416 :
417 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
418 :
419 40 : call reset()
420 :
421 : #if getComplement_D0_SK_ENABLED || setComplement_D0_SK_ENABLED
422 2 : setA = ""
423 2 : setB = ""
424 2 : Complement_ref = ""
425 : #elif getComplement_D1_SK_ENABLED
426 2 : allocate(character(2,SKC) :: setA(0), Complement_ref(0), setB(0))
427 : #elif setComplement_D1_SK_ENABLED
428 : allocate(setA(0), Complement_ref(0), setB(0))
429 : #elif getComplement_D1_IK_ENABLED || setComplement_D1_IK_ENABLED
430 10 : allocate(setA(0), Complement_ref(0), setB(0))
431 : #elif getComplement_D1_LK_ENABLED || setComplement_D1_LK_ENABLED
432 10 : allocate(setA(0), Complement_ref(0), setB(0))
433 : #elif getComplement_D1_CK_ENABLED || setComplement_D1_CK_ENABLED
434 8 : allocate(setA(0), Complement_ref(0), setB(0))
435 : #elif getComplement_D1_RK_ENABLED || setComplement_D1_RK_ENABLED
436 8 : allocate(setA(0), Complement_ref(0), setB(0))
437 : #endif
438 :
439 40 : call report(iseq)
440 40 : call report(iseq, sorted = .true._LK, unique = .true._LK)
441 40 : call report(iseq, sorted = .true._LK, unique = .false._LK)
442 40 : call report(iseq, sorted = .false._LK, unique = .true._LK)
443 40 : call report(iseq, sorted = .false._LK, unique = .false._LK)
444 :
445 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
446 :
447 40 : call reset()
448 :
449 : #if getComplement_D0_SK_ENABLED || setComplement_D0_SK_ENABLED
450 2 : setA = "ABCD"
451 2 : setB = "ABCD"
452 2 : Complement_ref = ""
453 : #elif getComplement_D1_SK_ENABLED
454 12 : setA = ["AA", "BB", "CC", "DD"]
455 12 : setB = ["AA", "BB", "CC", "DD"]
456 2 : allocate(Complement_ref(0))
457 : #elif getComplement_D1_IK_ENABLED || setComplement_D1_IK_ENABLED
458 60 : setA = int([1, 2, 3, 4], IKC)
459 60 : setB = int([1, 2, 3, 4], IKC)
460 10 : allocate(Complement_ref(0))
461 : #elif getComplement_D1_LK_ENABLED || setComplement_D1_LK_ENABLED
462 60 : setA = logical([.true., .true., .false., .false.], LKC)
463 60 : setB = logical([.true., .true., .false., .false.], LKC)
464 10 : allocate(Complement_ref(0))
465 : #elif getComplement_D1_CK_ENABLED || setComplement_D1_CK_ENABLED
466 48 : setA = cmplx([1, 2, 3, 4], kind = CKC)
467 48 : setB = cmplx([1, 2, 3, 4], kind = CKC)
468 8 : allocate(Complement_ref(0))
469 : #elif getComplement_D1_RK_ENABLED || setComplement_D1_RK_ENABLED
470 48 : setA = real([1, 2, 3, 4], RKC)
471 48 : setB = real([1, 2, 3, 4], RKC)
472 8 : allocate(Complement_ref(0))
473 : #endif
474 :
475 40 : call report(iseq)
476 : #if !(getComplement_D1_LK_ENABLED || setComplement_D1_LK_ENABLED)
477 30 : call report(iseq, sorted = .true._LK, unique = .true._LK)
478 30 : call report(iseq, sorted = .false._LK, unique = .true._LK)
479 : #endif
480 40 : call report(iseq, sorted = .true._LK, unique = .false._LK)
481 40 : call report(iseq, sorted = .false._LK, unique = .false._LK)
482 :
483 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
484 :
485 40 : call reset()
486 :
487 : #if getComplement_D0_SK_ENABLED || setComplement_D0_SK_ENABLED
488 2 : setA = "ABCD"
489 2 : setB = ""
490 : #elif getComplement_D1_SK_ENABLED
491 12 : setA = ["AA", "BB", "CC", "DD"]
492 2 : allocate(setB(0))
493 : #elif getComplement_D1_IK_ENABLED || setComplement_D1_IK_ENABLED
494 10 : allocate(setB(0))
495 60 : setA = int([1, 2, 3, 4], IKC)
496 : #elif getComplement_D1_LK_ENABLED || setComplement_D1_LK_ENABLED
497 10 : allocate(setB(0))
498 60 : setA = logical([.true., .true., .false., .false.], LKC)
499 : #elif getComplement_D1_CK_ENABLED || setComplement_D1_CK_ENABLED
500 8 : allocate(setB(0))
501 48 : setA = cmplx([1, 2, 3, 4], kind = CKC)
502 : #elif getComplement_D1_RK_ENABLED || setComplement_D1_RK_ENABLED
503 8 : allocate(setB(0))
504 48 : setA = real([1, 2, 3, 4], RKC)
505 : #endif
506 76 : Complement_ref = setB
507 :
508 40 : call report(iseq)
509 : #if !(getComplement_D1_LK_ENABLED || setComplement_D1_LK_ENABLED)
510 30 : call report(iseq, sorted = .true._LK, unique = .true._LK)
511 30 : call report(iseq, sorted = .false._LK, unique = .true._LK)
512 : #endif
513 40 : call report(iseq, sorted = .true._LK, unique = .false._LK)
514 40 : call report(iseq, sorted = .false._LK, unique = .false._LK)
515 :
516 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
517 :
518 40 : call reset()
519 :
520 : #if getComplement_D0_SK_ENABLED || setComplement_D0_SK_ENABLED
521 2 : setA = ""
522 2 : setB = "ABCD"
523 : #elif getComplement_D1_SK_ENABLED
524 2 : allocate(setA(0))
525 12 : setB = ["AA", "BB", "CC", "DD"]
526 : #elif getComplement_D1_IK_ENABLED || setComplement_D1_IK_ENABLED
527 10 : allocate(setA(0))
528 60 : setB = int([1, 2, 3, 4], IKC)
529 : #elif getComplement_D1_LK_ENABLED || setComplement_D1_LK_ENABLED
530 10 : allocate(setA(0))
531 60 : setB = logical([.true., .true., .false., .false.], LKC)
532 : #elif getComplement_D1_CK_ENABLED || setComplement_D1_CK_ENABLED
533 8 : allocate(setA(0))
534 48 : setB = cmplx([1, 2, 3, 4], kind = CKC)
535 : #elif getComplement_D1_RK_ENABLED || setComplement_D1_RK_ENABLED
536 8 : allocate(setA(0))
537 48 : setB = real([1, 2, 3, 4], RKC)
538 : #endif
539 268 : Complement_ref = setB
540 :
541 40 : call report(iseq)
542 : #if !(getComplement_D1_LK_ENABLED || setComplement_D1_LK_ENABLED)
543 30 : call report(iseq, sorted = .true._LK, unique = .true._LK)
544 30 : call report(iseq, sorted = .false._LK, unique = .true._LK)
545 : #endif
546 40 : call report(iseq, sorted = .true._LK, unique = .false._LK)
547 40 : call report(iseq, sorted = .false._LK, unique = .false._LK)
548 :
549 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
550 :
551 40 : call reset()
552 :
553 : #if getComplement_D0_SK_ENABLED || setComplement_D0_SK_ENABLED
554 2 : setA = "ABCD"
555 2 : setB = "ABCDE"
556 2 : Complement_ref = setB(len(setB):len(setB))
557 : #elif getComplement_D1_SK_ENABLED
558 12 : setA = ["AA", "BB", "CC", "DD"]
559 14 : setB = ["AA", "BB", "CC", "DD", "EE"]
560 6 : Complement_ref = setB(size(setB):size(setB))
561 : #elif getComplement_D1_IK_ENABLED || setComplement_D1_IK_ENABLED
562 60 : setA = int([1, 2, 3, 4], IKC)
563 70 : setB = int([1, 2, 3, 4, 5], IKC)
564 30 : Complement_ref = setB(size(setB):size(setB))
565 : #elif getComplement_D1_LK_ENABLED || setComplement_D1_LK_ENABLED
566 60 : setA = logical([.true., .true., .false., .false.], LKC)
567 70 : setB = logical([.true., .true., .false., .false., .false.], LKC)
568 10 : Complement_ref = [logical(LKC)::]
569 : #elif getComplement_D1_CK_ENABLED || setComplement_D1_CK_ENABLED
570 48 : setA = cmplx([1, 2, 3, 4], kind = CKC)
571 56 : setB = cmplx([1, 2, 3, 4, 5], kind = CKC)
572 24 : Complement_ref = setB(size(setB):size(setB))
573 : #elif getComplement_D1_RK_ENABLED || setComplement_D1_RK_ENABLED
574 48 : setA = real([1, 2, 3, 4], RKC)
575 56 : setB = real([1, 2, 3, 4, 5], RKC)
576 24 : Complement_ref = setB(size(setB):size(setB))
577 : #endif
578 :
579 40 : call report(iseq)
580 : #if !(getComplement_D1_LK_ENABLED || setComplement_D1_LK_ENABLED)
581 30 : call report(iseq, sorted = .true._LK, unique = .true._LK)
582 30 : call report(iseq, sorted = .false._LK, unique = .true._LK)
583 : #endif
584 40 : call report(iseq, sorted = .true._LK, unique = .false._LK)
585 40 : call report(iseq, sorted = .false._LK, unique = .false._LK)
586 :
587 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
588 :
589 40 : call reset()
590 :
591 : #if getComplement_D0_SK_ENABLED || setComplement_D0_SK_ENABLED
592 2 : setA = "ABCD"
593 2 : setB = "!ABCD"
594 2 : Complement_ref = setB(1:1)
595 : #elif getComplement_D1_SK_ENABLED
596 12 : setA = ["AA", "BB", "CC", "DD"]
597 14 : setB = ["!!", "AA", "BB", "CC", "DD"]
598 6 : Complement_ref = setB(1:1)
599 : #elif getComplement_D1_IK_ENABLED || setComplement_D1_IK_ENABLED
600 60 : setA = int([1, 2, 3, 4], IKC)
601 70 : setB = int([0, 1, 2, 3, 4], IKC)
602 30 : Complement_ref = setB(1:1)
603 : #elif getComplement_D1_LK_ENABLED || setComplement_D1_LK_ENABLED
604 30 : setA = logical([.true.], LKC)
605 40 : setB = logical([.true., .false.], LKC)
606 30 : Complement_ref = logical([.false.], LKC)
607 : #elif getComplement_D1_CK_ENABLED || setComplement_D1_CK_ENABLED
608 48 : setA = cmplx([1, 2, 3, 4], kind = CKC)
609 56 : setB = cmplx([0, 1, 2, 3, 4], kind = CKC)
610 24 : Complement_ref = setB(1:1)
611 : #elif getComplement_D1_RK_ENABLED || setComplement_D1_RK_ENABLED
612 48 : setA = real([1, 2, 3, 4], RKC)
613 56 : setB = real([0, 1, 2, 3, 4], RKC)
614 24 : Complement_ref = setB(1:1)
615 : #endif
616 :
617 40 : call report(iseq)
618 40 : call report(iseq, sorted = .true._LK, unique = .true._LK)
619 40 : call report(iseq, sorted = .false._LK, unique = .true._LK)
620 40 : call report(iseq, sorted = .true._LK, unique = .false._LK)
621 40 : call report(iseq, sorted = .false._LK, unique = .false._LK)
622 :
623 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
624 :
625 40 : call reset()
626 :
627 : #if getComplement_D0_SK_ENABLED || setComplement_D0_SK_ENABLED
628 2 : setA = "ABCD"
629 2 : setB = "!A?BCDEE"
630 2 : Complement_ref = "!?EE"
631 : #elif getComplement_D1_SK_ENABLED
632 12 : setA = ["AA", "BB", "CC", "DD"]
633 20 : setB = ["!!", "AA", "??", "BB", "CC", "DD", "EE", "EE"]
634 12 : Complement_ref = ["!!", "??", "EE", "EE"]
635 : #elif getComplement_D1_IK_ENABLED || setComplement_D1_IK_ENABLED
636 60 : setA = int([1, 2, 3, 4], IKC)
637 100 : setB = int([0, 2, 1, 3, 4, 5, 6, 6], IKC)
638 60 : Complement_ref = int([0, 5, 6, 6], IKC)
639 : #elif getComplement_D1_LK_ENABLED || setComplement_D1_LK_ENABLED
640 30 : setA = logical([.true.], LKC)
641 70 : setB = logical([.true., .true., .false., .false., .false.], LKC)
642 50 : Complement_ref = logical([.false., .false., .false.], LKC)
643 : #elif getComplement_D1_CK_ENABLED || setComplement_D1_CK_ENABLED
644 48 : setA = cmplx([1, 2, 3, 4], kind = CKC)
645 80 : setB = cmplx([0, 2, 1, 3, 4, 5, 6, 6], kind = CKC)
646 48 : Complement_ref = cmplx([0, 5, 6, 6], kind = CKC)
647 : #elif getComplement_D1_RK_ENABLED || setComplement_D1_RK_ENABLED
648 48 : setA = real([1, 2, 3, 4], RKC)
649 80 : setB = real([0, 2, 1, 3, 4, 5, 6, 6], RKC)
650 48 : Complement_ref = real([0, 5, 6, 6], kind = RKC)
651 : #endif
652 :
653 40 : call report(iseq)
654 40 : call report(iseq, sorted = .false._LK, unique = .false._LK)
655 40 : call report(iseq, sorted = .false._LK, unique = .true._LK)
656 40 : call setSorted(setA)
657 40 : call setSorted(setB)
658 40 : call report(iseq, sorted = .true._LK, unique = .false._LK)
659 322 : setA = getUnique(setA)
660 510 : setB = getUnique(setB)
661 : #if getComplement_D1_LK_ENABLED || setComplement_D1_LK_ENABLED
662 40 : Complement_ref = Complement_ref(1:1)
663 : #else
664 226 : Complement_ref = Complement_ref(1:3)
665 : #endif
666 40 : call report(iseq, sorted = .true._LK, unique = .true._LK)
667 :
668 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
669 :
670 40 : end subroutine
671 :
672 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
673 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
674 :
675 4281 : function iseq(elementA, elementB) result(equivalent)
676 : logical(LK) :: equivalent
677 : #if getComplement_D0_SK_ENABLED || setComplement_D0_SK_ENABLED
678 : character(*,SKC), intent(in) :: elementA, elementB
679 : #elif getComplement_D1_SK_ENABLED || setComplement_D1_SK_ENABLED
680 : character(*,SKC), intent(in) :: elementA, elementB
681 : #elif getComplement_D1_IK_ENABLED || setComplement_D1_IK_ENABLED
682 : integer(IKC) , intent(in) :: elementA, elementB
683 : #elif getComplement_D1_LK_ENABLED || setComplement_D1_LK_ENABLED
684 : logical(LKC) , intent(in) :: elementA, elementB
685 : #elif getComplement_D1_CK_ENABLED || setComplement_D1_CK_ENABLED
686 : complex(CKC) , intent(in) :: elementA, elementB
687 : #elif getComplement_D1_RK_ENABLED || setComplement_D1_RK_ENABLED
688 : real(RKC) , intent(in) :: elementA, elementB
689 : #endif
690 4281 : equivalent = elementA IS_EQUAL elementB
691 4281 : end function
692 :
693 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
694 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
695 :
696 : subroutine report ( iseq & ! LCOV_EXCL_LINE
697 : , sorted & ! LCOV_EXCL_LINE
698 : , unique & ! LCOV_EXCL_LINE
699 : )
700 :
701 : logical(LK) , external , optional :: iseq
702 : logical(LK) , intent(in), optional :: sorted
703 : logical(LK) , intent(in), optional :: unique
704 :
705 1320 : if (present(sorted) .neqv. present(unique)) error stop "The condition `present(sorted) .neqv. present(unique)` must hold."
706 :
707 1320 : if (present(iseq)) then
708 660 : if (present(sorted)) then
709 : #if getComplement_ENABLED
710 1668 : Complement = getComplement(setA, setB, sorted, unique, iseq)
711 : #elif setComplement_ENABLED
712 : #error "Unrecognized interface."
713 : #endif
714 : else
715 : #if getComplement_ENABLED
716 453 : Complement = getComplement(setA, setB, iseq)
717 : #elif setComplement_ENABLED
718 : #endif
719 : end if
720 : else
721 660 : if (present(sorted)) then
722 : #if getComplement_ENABLED
723 1668 : Complement = getComplement(setA, setB, sorted, unique)
724 : #elif setComplement_ENABLED
725 : #error "Unrecognized interface."
726 : #endif
727 : else
728 : #if getComplement_ENABLED
729 453 : Complement = getComplement(setA, setB)
730 : #elif setComplement_ENABLED
731 : #endif
732 : end if
733 : end if
734 :
735 : ! Report test results if needed.
736 :
737 2992 : assertion = assertion .and. ALL(Complement IS_EQUAL Complement_ref)
738 1320 : if (test%traceable .and. .not. assertion) then
739 :
740 : ! LCOV_EXCL_START
741 : write(test%disp%unit,"(*(g0,:,', '))")
742 :
743 : write(test%disp%unit,"(*(g0,:,', '))") "setB ", Complement
744 : write(test%disp%unit,"(*(g0,:,', '))") "setA ", Complement
745 : write(test%disp%unit,"(*(g0,:,', '))") "Complement ", Complement_ref
746 : write(test%disp%unit,"(*(g0,:,', '))") "present(unique) ", present(unique)
747 : write(test%disp%unit,"(*(g0,:,', '))") "present(sorted) ", present(sorted)
748 : write(test%disp%unit,"(*(g0,:,', '))") "present(iseq) ", present(iseq)
749 :
750 : if (present(sorted)) then
751 : write(test%disp%unit,"(*(g0,:,', '))") "sorted ", sorted
752 : end if
753 :
754 : if (present(unique)) then
755 : write(test%disp%unit,"(*(g0,:,', '))") "unique ", unique
756 : end if
757 :
758 : write(test%disp%unit,"(*(g0,:,', '))")
759 : ! LCOV_EXCL_STOP
760 :
761 : end if
762 :
763 1320 : call test%assert(assertion, PROCEDURE_NAME//SK_": The complement of setA with respect to setB must be properly set.", int(__LINE__, IK))
764 :
765 1320 : end subroutine
766 :
767 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
768 :
769 280 : subroutine reset()
770 280 : if (allocated(setA)) deallocate(setA)
771 280 : if (allocated(setB)) deallocate(setB)
772 280 : if (allocated(Complement)) deallocate(Complement)
773 280 : if (allocated(Complement_ref)) deallocate(Complement_ref)
774 280 : end subroutine reset
775 :
776 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
777 :
778 : #endif
779 :
780 : #undef IS_EQUAL
781 : #undef ALL
|
