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 of [test_pm_arrayCompareLex](@ref test_pm_arrayCompareLex).
19 : !>
20 : !> \author
21 : !> \AmirShahmoradi, September 1, 2017, 12:00 AM, Institute for Computational Engineering and Sciences (ICES), The University of Texas at Austin
22 :
23 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
24 :
25 : #if test_llt_ENABLED
26 : #define COMPARES_WITH .llt.
27 : character(*, SK), parameter :: PROCEDURE_NAME = "isllt()"
28 : #elif test_lle_ENABLED
29 : #define COMPARES_WITH .lle.
30 : character(*, SK), parameter :: PROCEDURE_NAME = "islle()"
31 : #elif test_lge_ENABLED
32 : #define COMPARES_WITH .lge.
33 : character(*, SK), parameter :: PROCEDURE_NAME = "islge()"
34 : #elif test_lgt_ENABLED
35 : #define COMPARES_WITH .lgt.
36 : character(*, SK), parameter :: PROCEDURE_NAME = "islgt()"
37 : #else
38 : #error "Unrecognized interface."
39 : #endif
40 :
41 : logical(LK) :: result, result_ref
42 :
43 : #if test_llt_D0_D0_SK_ENABLED || test_lle_D0_D0_SK_ENABLED || test_lge_D0_D0_SK_ENABLED || test_lgt_D0_D0_SK_ENABLED
44 : #define test_D0_D0_SK_ENABLED 1
45 4 : character(:,SKC), allocatable :: array1, array2
46 : #elif test_llt_D1_D1_SK_ENABLED || test_lle_D1_D1_SK_ENABLED || test_lge_D1_D1_SK_ENABLED || test_lgt_D1_D1_SK_ENABLED
47 : #define test_D1_D1_SK_ENABLED 1
48 : character(2,SKC), allocatable :: array1(:), array2(:)
49 : #elif test_llt_D1_D1_LK_ENABLED || test_lle_D1_D1_LK_ENABLED || test_lge_D1_D1_LK_ENABLED || test_lgt_D1_D1_LK_ENABLED
50 : #define test_D1_D1_LK_ENABLED 1
51 : logical(LKC) , allocatable :: array1(:), array2(:)
52 : #elif test_llt_D1_D1_IK_ENABLED || test_lle_D1_D1_IK_ENABLED || test_lge_D1_D1_IK_ENABLED || test_lgt_D1_D1_IK_ENABLED
53 : #define test_D1_D1_IK_ENABLED 1
54 : integer(IKC) , allocatable :: array1(:), array2(:)
55 : #elif test_llt_D1_D1_CK_ENABLED || test_lle_D1_D1_CK_ENABLED || test_lge_D1_D1_CK_ENABLED || test_lgt_D1_D1_CK_ENABLED
56 : #define test_D1_D1_CK_ENABLED 1
57 : complex(CKC) , allocatable :: array1(:), array2(:)
58 : #elif test_llt_D1_D1_RK_ENABLED || test_lle_D1_D1_RK_ENABLED || test_lge_D1_D1_RK_ENABLED || test_lgt_D1_D1_RK_ENABLED
59 : #define test_D1_D1_RK_ENABLED 1
60 : real(RKC) , allocatable :: array1(:), array2(:)
61 : #else
62 : #error "Unrecognized interface."
63 : #endif
64 :
65 80 : assertion = .true._LK
66 :
67 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
68 :
69 : #if test_D0_D0_SK_ENABLED
70 4 : array1 = SKC_"A"
71 4 : array2 = SKC_"A"
72 : #elif test_D1_D1_SK_ENABLED
73 12 : array1 = [SKC_"AA"]
74 12 : array2 = [SKC_"AA"]
75 : #elif test_D1_D1_LK_ENABLED
76 60 : array1 = [.false._LKC]
77 60 : array2 = [.false._LKC]
78 : #elif test_D1_D1_IK_ENABLED
79 60 : array1 = [0_IKC]
80 60 : array2 = [0_IKC]
81 : #elif test_D1_D1_RK_ENABLED
82 48 : array1 = [0._RKC]
83 48 : array2 = [0._RKC]
84 : #elif test_D1_D1_CK_ENABLED
85 48 : array1 = [(0._CKC, 0._CKC)]
86 48 : array2 = [(0._CKC, 0._CKC)]
87 : #endif
88 :
89 : #if test_llt_ENABLED
90 20 : result_ref = .false._LK
91 : #elif test_lle_ENABLED
92 20 : result_ref = .true._LK
93 : #elif test_lge_ENABLED
94 20 : result_ref = .true._LK
95 : #elif test_lgt_ENABLED
96 20 : result_ref = .false._LK
97 : #endif
98 :
99 80 : call report()
100 80 : call test%assert(assertion, PROCEDURE_NAME//SK_" must correctly lexically compare two equivalent arrays of length 1.")
101 :
102 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
103 :
104 : #if test_D0_D0_SK_ENABLED
105 4 : array1 = SKC_"A"
106 4 : array2 = SKC_"B"
107 : #elif test_D1_D1_SK_ENABLED
108 12 : array1 = [SKC_"AA"]
109 12 : array2 = [SKC_"BB"]
110 : #elif test_D1_D1_LK_ENABLED
111 60 : array1 = [.false._LKC]
112 60 : array2 = [.true._LKC]
113 : #elif test_D1_D1_IK_ENABLED
114 60 : array1 = [0_IKC]
115 60 : array2 = [1_IKC]
116 : #elif test_D1_D1_RK_ENABLED
117 48 : array1 = [0._RKC]
118 48 : array2 = [1._RKC]
119 : #elif test_D1_D1_CK_ENABLED
120 48 : array1 = [(0._CKC, 0._CKC)]
121 48 : array2 = [(1._CKC, 1._CKC)]
122 : #endif
123 :
124 : #if test_llt_ENABLED
125 20 : result_ref = .true._LK
126 : #elif test_lle_ENABLED
127 20 : result_ref = .true._LK
128 : #elif test_lge_ENABLED
129 20 : result_ref = .false._LK
130 : #elif test_lgt_ENABLED
131 20 : result_ref = .false._LK
132 : #endif
133 :
134 80 : call report()
135 80 : call test%assert(assertion, PROCEDURE_NAME//SK_" must correctly perform lexical comparison when array1 is less than array2 both of length 1.")
136 :
137 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
138 :
139 : #if test_D0_D0_SK_ENABLED
140 4 : array1 = SKC_"A"
141 4 : array2 = SKC_"A "
142 : #elif test_D1_D1_SK_ENABLED
143 12 : array1 = [SKC_"AA"]
144 16 : array2 = [SKC_"AA", SKC_"AA"]
145 : #elif test_D1_D1_LK_ENABLED
146 60 : array1 = [.false._LKC]
147 80 : array2 = [.false._LKC, .false._LKC]
148 : #elif test_D1_D1_IK_ENABLED
149 60 : array1 = [0_IKC]
150 80 : array2 = [0_IKC, 0_IKC]
151 : #elif test_D1_D1_RK_ENABLED
152 48 : array1 = [0._RKC]
153 64 : array2 = [0._RKC, 0._RKC]
154 : #elif test_D1_D1_CK_ENABLED
155 48 : array1 = [(0._CKC, 0._CKC)]
156 64 : array2 = [(0._CKC, 0._CKC), (0._CKC, 0._CKC)]
157 : #endif
158 :
159 : #if test_llt_ENABLED
160 20 : result_ref = .true._LK
161 : #elif test_lle_ENABLED
162 20 : result_ref = .true._LK
163 : #elif test_lge_ENABLED
164 20 : result_ref = .false._LK
165 : #elif test_lgt_ENABLED
166 20 : result_ref = .false._LK
167 : #endif
168 :
169 80 : call report()
170 80 : call test%assert(assertion, PROCEDURE_NAME//SK_" must correctly perform lexical comparison when array1 of length 1 is less than array2 of length 2.")
171 :
172 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
173 :
174 : #if test_D0_D0_SK_ENABLED
175 4 : array1 = SKC_"A"
176 4 : array2 = SKC_"A "
177 : #elif test_D1_D1_SK_ENABLED
178 12 : array1 = [SKC_"AA"]
179 16 : array2 = [SKC_"AA", SKC_"AA"]
180 : #elif test_D1_D1_LK_ENABLED
181 60 : array1 = [.false._LKC]
182 80 : array2 = [.false._LKC, .false._LKC]
183 : #elif test_D1_D1_IK_ENABLED
184 60 : array1 = [0_IKC]
185 80 : array2 = [0_IKC, 0_IKC]
186 : #elif test_D1_D1_RK_ENABLED
187 48 : array1 = [0._RKC]
188 64 : array2 = [0._RKC, 0._RKC]
189 : #elif test_D1_D1_CK_ENABLED
190 48 : array1 = [(0._CKC, 0._CKC)]
191 64 : array2 = [(0._CKC, 0._CKC), (0._CKC, 0._CKC)]
192 : #endif
193 :
194 : #if test_llt_ENABLED
195 20 : result_ref = .true._LK
196 : #elif test_lle_ENABLED
197 20 : result_ref = .true._LK
198 : #elif test_lge_ENABLED
199 20 : result_ref = .false._LK
200 : #elif test_lgt_ENABLED
201 20 : result_ref = .false._LK
202 : #endif
203 :
204 80 : call report()
205 80 : call test%assert(assertion, PROCEDURE_NAME//SK_" must correctly perform lexical comparison when array1 of length 1 is less than array2 of length 2.")
206 :
207 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
208 :
209 : #if test_D0_D0_SK_ENABLED
210 4 : array1 = SKC_"A "
211 4 : array2 = SKC_"A"
212 : #elif test_D1_D1_SK_ENABLED
213 16 : array1 = [SKC_"AA", SKC_"AA"]
214 12 : array2 = [SKC_"AA"]
215 : #elif test_D1_D1_LK_ENABLED
216 80 : array1 = [.false._LKC, .false._LKC]
217 60 : array2 = [.false._LKC]
218 : #elif test_D1_D1_IK_ENABLED
219 80 : array1 = [0_IKC, 0_IKC]
220 60 : array2 = [0_IKC]
221 : #elif test_D1_D1_RK_ENABLED
222 64 : array1 = [0._RKC, 0._RKC]
223 48 : array2 = [0._RKC]
224 : #elif test_D1_D1_CK_ENABLED
225 64 : array1 = [(0._CKC, 0._CKC), (0._CKC, 0._CKC)]
226 48 : array2 = [(0._CKC, 0._CKC)]
227 : #endif
228 :
229 : #if test_llt_ENABLED
230 20 : result_ref = .false._LK
231 : #elif test_lle_ENABLED
232 20 : result_ref = .false._LK
233 : #elif test_lge_ENABLED
234 20 : result_ref = .true._LK
235 : #elif test_lgt_ENABLED
236 20 : result_ref = .true._LK
237 : #endif
238 :
239 80 : call report()
240 80 : call test%assert(assertion, PROCEDURE_NAME//SK_" must correctly perform lexical comparison when array1 of length 2 is more than array2 of length 1.")
241 :
242 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
243 :
244 : #if test_D0_D0_SK_ENABLED
245 4 : array1 = SKC_"AA"
246 4 : array2 = SKC_"AB"
247 : #elif test_D1_D1_SK_ENABLED
248 12 : array1 = [SKC_"AA"]
249 16 : array2 = [SKC_"AA", SKC_"AB"]
250 : #elif test_D1_D1_LK_ENABLED
251 80 : array1 = [.false._LKC, .false._LKC]
252 80 : array2 = [.false._LKC, .true._LKC]
253 : #elif test_D1_D1_IK_ENABLED
254 80 : array1 = [0_IKC, 0_IKC]
255 80 : array2 = [0_IKC, 1_IKC]
256 : #elif test_D1_D1_RK_ENABLED
257 64 : array1 = [0._RKC, 0._RKC]
258 64 : array2 = [0._RKC, 1._RKC]
259 : #elif test_D1_D1_CK_ENABLED
260 64 : array1 = [(0._CKC, 0._CKC), (0._CKC, 0._CKC)]
261 64 : array2 = [(0._CKC, 0._CKC), (0._CKC, 1._CKC)]
262 : #endif
263 :
264 : #if test_llt_ENABLED
265 20 : result_ref = .true._LK
266 : #elif test_lle_ENABLED
267 20 : result_ref = .true._LK
268 : #elif test_lge_ENABLED
269 20 : result_ref = .false._LK
270 : #elif test_lgt_ENABLED
271 20 : result_ref = .false._LK
272 : #endif
273 :
274 80 : call report()
275 80 : call test%assert(assertion, PROCEDURE_NAME//SK_" must correctly perform lexical comparison when array1 of length 2 is less than array2 of length 2.")
276 :
277 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
278 :
279 : #if test_D0_D0_SK_ENABLED
280 4 : array1 = SKC_"AB"
281 4 : array2 = SKC_"AA"
282 : #elif test_D1_D1_SK_ENABLED
283 16 : array1 = [SKC_"AA", SKC_"AB"]
284 12 : array2 = [SKC_"AA"]
285 : #elif test_D1_D1_LK_ENABLED
286 80 : array1 = [.false._LKC, .true._LKC]
287 80 : array2 = [.false._LKC, .false._LKC]
288 : #elif test_D1_D1_IK_ENABLED
289 80 : array1 = [0_IKC, 1_IKC]
290 80 : array2 = [0_IKC, 0_IKC]
291 : #elif test_D1_D1_RK_ENABLED
292 64 : array1 = [0._RKC, 1._RKC]
293 64 : array2 = [0._RKC, 0._RKC]
294 : #elif test_D1_D1_CK_ENABLED
295 64 : array1 = [(0._CKC, 0._CKC), (0._CKC, 1._CKC)]
296 64 : array2 = [(0._CKC, 0._CKC), (0._CKC, 0._CKC)]
297 : #endif
298 :
299 : #if test_llt_ENABLED
300 20 : result_ref = .false._LK
301 : #elif test_lle_ENABLED
302 20 : result_ref = .false._LK
303 : #elif test_lge_ENABLED
304 20 : result_ref = .true._LK
305 : #elif test_lgt_ENABLED
306 20 : result_ref = .true._LK
307 : #endif
308 :
309 80 : call report()
310 80 : call test%assert(assertion, PROCEDURE_NAME//SK_" must correctly perform lexical comparison when array1 of length 2 is less than array2 of length 2.")
311 :
312 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
313 :
314 : contains
315 :
316 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
317 :
318 560 : subroutine report()
319 560 : result = array1 COMPARES_WITH array2
320 560 : assertion = assertion .and. result .eqv. result_ref
321 560 : if (test%traceable .and. .not. assertion) then
322 : ! LCOV_EXCL_START
323 : write(test%disp%unit,"(*(g0,:,', '))")
324 : write(test%disp%unit,"(*(g0,:,', '))") "array1 ", array1
325 : write(test%disp%unit,"(*(g0,:,', '))") "array2 ", array2
326 : write(test%disp%unit,"(*(g0,:,', '))") "result ", result
327 : write(test%disp%unit,"(*(g0,:,', '))") "result_ref ", result_ref
328 : write(test%disp%unit,"(*(g0,:,', '))")
329 : ! LCOV_EXCL_STOP
330 : end if
331 560 : end subroutine
332 :
333 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
334 :
335 : #undef test_D0_D0_SK_ENABLED
336 : #undef test_D1_D1_SK_ENABLED
337 : #undef test_D1_D1_LK_ENABLED
338 : #undef test_D1_D1_IK_ENABLED
339 : #undef test_D1_D1_CK_ENABLED
340 : #undef test_D1_D1_RK_ENABLED
341 : #undef COMPARES_WITH
|