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 interface
19 : !> [setInserted](@ref pm_arrayInsert::setInserted).
20 : !>
21 : !> \fintest
22 : !>
23 : !> \author
24 : !> \AmirShahmoradi, September 1, 2017, 11:35 PM, Institute for Computational Engineering and Sciences (ICES), The University of Texas at Austin
25 :
26 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
27 :
28 : #if setInserted_D0_SK_ENABLED
29 : #define GET_INDEX(i) i:i
30 : #define GET_SIZE len
31 : #else
32 : #define GET_INDEX(i) i
33 : #define GET_SIZE size
34 : #endif
35 :
36 : #if setInserted_D1_LK_ENABLED
37 : #define IS_EQUAL .eqv.
38 : #else
39 : #define IS_EQUAL ==
40 : #endif
41 :
42 : use pm_val2str, only: getStr
43 : use pm_kind, only: LK, SK
44 :
45 : character(*, SK), parameter :: PROCEDURE_NAME = "@setInserted()"
46 :
47 : #if setInserted_D0_SK_ENABLED
48 : #define ALL
49 1 : character(:,SKC), allocatable :: array, insertion, arrayNew, arrayNewS_ref, arrayNewV_ref
50 : #elif setInserted_D1_SK_ENABLED
51 : character(2,SKC), allocatable, dimension(:) :: array, insertion, arrayNew, arrayNewS_ref, arrayNewV_ref
52 : #elif setInserted_D1_IK_ENABLED
53 : integer(IKC) , allocatable, dimension(:) :: array, insertion, arrayNew, arrayNewS_ref, arrayNewV_ref
54 : #elif setInserted_D1_CK_ENABLED
55 : complex(CKC) , allocatable, dimension(:) :: array, insertion, arrayNew, arrayNewS_ref, arrayNewV_ref
56 : #elif setInserted_D1_RK_ENABLED
57 : real(RKC) , allocatable, dimension(:) :: array, insertion, arrayNew, arrayNewS_ref, arrayNewV_ref
58 : #elif setInserted_D1_LK_ENABLED
59 : logical(LKC) , allocatable, dimension(:) :: array, insertion, arrayNew, arrayNewS_ref, arrayNewV_ref
60 : #else
61 : #error "Unrecognized interface."
62 : #endif
63 : integer(IK) , allocatable :: index(:)
64 : logical(LK) :: getInsertedEnabled
65 : integer(IK) :: i
66 :
67 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
68 :
69 20 : assertion = .true._LK
70 :
71 20 : getInsertedEnabled = .false._LK
72 61 : do i = 1, 2
73 40 : call runInsertionTestsWith()
74 40 : call runInsertionTestsWith(sorted = .true._LK)
75 40 : call runInsertionTestsWith(sorted = .false._LK)
76 40 : call runInsertionTestsWith(positive = .true._LK)
77 40 : call runInsertionTestsWith(positive = .false._LK)
78 40 : call runInsertionTestsWith(positive = .true._LK, sorted = .true._LK)
79 40 : call runInsertionTestsWith(positive = .false._LK, sorted = .true._LK)
80 40 : call runInsertionTestsWith(positive = .false._LK, sorted = .false._LK)
81 40 : call runInsertionTestsWith(positive = .true._LK, sorted = .false._LK)
82 60 : getInsertedEnabled = .not. getInsertedEnabled
83 : end do
84 :
85 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
86 :
87 : contains
88 :
89 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
90 :
91 360 : subroutine runInsertionTestsWith(positive, sorted)
92 :
93 : use pm_option, only: getOption
94 : logical(LK), intent(in), optional :: positive, sorted
95 :
96 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
97 :
98 360 : call reset()
99 :
100 : #if setInserted_D0_SK_ENABLED
101 18 : insertion = " "
102 18 : allocate(character(0,SKC) :: arrayNewV_ref, array)
103 : #elif setInserted_D1_SK_ENABLED
104 54 : insertion = [" "]
105 18 : allocate(character(2,SKC) :: arrayNewV_ref(0), array(0))
106 : #elif setInserted_D1_IK_ENABLED
107 270 : insertion = [1_IKC]
108 90 : allocate(arrayNewV_ref(0), array(0))
109 : #elif setInserted_D1_CK_ENABLED
110 216 : insertion = [1._CKC]
111 72 : allocate(arrayNewV_ref(0), array(0))
112 : #elif setInserted_D1_RK_ENABLED
113 216 : insertion = [1._RKC]
114 72 : allocate(arrayNewV_ref(0), array(0))
115 : #elif setInserted_D1_LK_ENABLED
116 270 : insertion = [.false._LKC]
117 90 : allocate(arrayNewV_ref(0), array(0))
118 : #endif
119 360 : allocate(index(0))
120 360 : arrayNewS_ref = arrayNewV_ref
121 :
122 360 : call runTestWith(positive, sorted)
123 360 : call test%assert(assertion, PROCEDURE_NAME//SK_": An empty `array` has empty resulting `arrayNew` with vector `insertion` with getInsertedEnabled = "//getStr(getInsertedEnabled)//".", int(__LINE__, IK))
124 :
125 360 : call runTestWith(positive, sorted, scalarInsertionIndex = 1_IK)
126 360 : call test%assert(assertion, PROCEDURE_NAME//SK_": An empty `array` has empty resulting `arrayNew` with scalar `insertion` with getInsertedEnabled = "//getStr(getInsertedEnabled)//".", int(__LINE__, IK))
127 :
128 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
129 :
130 360 : call reset()
131 :
132 : #if setInserted_D0_SK_ENABLED
133 18 : allocate(character(0,SKC) :: arrayNewV_ref, array, insertion)
134 : #elif setInserted_D1_SK_ENABLED
135 18 : allocate(character(2,SKC) :: arrayNewV_ref(0), array(0), insertion(0))
136 : #elif setInserted_D1_IK_ENABLED
137 90 : allocate(arrayNewV_ref(0), array(0), insertion(0))
138 : #elif setInserted_D1_CK_ENABLED
139 72 : allocate(arrayNewV_ref(0), array(0), insertion(0))
140 : #elif setInserted_D1_RK_ENABLED
141 72 : allocate(arrayNewV_ref(0), array(0), insertion(0))
142 : #elif setInserted_D1_LK_ENABLED
143 90 : allocate(arrayNewV_ref(0), array(0), insertion(0))
144 : #endif
145 360 : allocate(index(0))
146 360 : arrayNewS_ref = arrayNewV_ref
147 :
148 360 : call runTestWith(positive, sorted)
149 360 : call test%assert(assertion, PROCEDURE_NAME//SK_": An empty `array` has empty resulting `arrayNew` with vector `insertion` of length zero with getInsertedEnabled = "//getStr(getInsertedEnabled)//".", int(__LINE__, IK))
150 :
151 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
152 :
153 360 : call reset()
154 :
155 : #if setInserted_D0_SK_ENABLED
156 18 : array = "AAAA"
157 18 : insertion = "X"
158 : #elif setInserted_D1_SK_ENABLED
159 72 : array = ["AA", "AA"]
160 54 : insertion = ["XX"]
161 : #elif setInserted_D1_IK_ENABLED
162 360 : array = [1_IKC, 1_IKC]
163 270 : insertion = [2_IKC]
164 : #elif setInserted_D1_CK_ENABLED
165 288 : array = [(1._CKC,-1._CKC), (1._CKC,-1._CKC)]
166 216 : insertion = [(2._CKC,-2._CKC)]
167 : #elif setInserted_D1_RK_ENABLED
168 288 : array = [1._RKC, 1._RKC]
169 216 : insertion = [2._RKC]
170 : #elif setInserted_D1_LK_ENABLED
171 360 : array = [.false._LK, .false._LK]
172 270 : insertion = [.true._LK]
173 : #endif
174 360 : allocate(index(0))
175 1728 : arrayNewS_ref = array
176 1728 : arrayNewV_ref = array
177 :
178 360 : call runTestWith(positive, sorted)
179 360 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with a single-element vector `insertion` with vector `insertion` with an empty `index` must yield an `arrayNew` that is identical to `array` with getInsertedEnabled = "//getStr(getInsertedEnabled)//".", int(__LINE__, IK))
180 :
181 360 : call runTestWith(positive, sorted, scalarInsertionIndex = 1_IK)
182 360 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with a single-element scalar `insertion` with vector `insertion` with an empty `index` must yield an `arrayNew` that is identical to `array` with getInsertedEnabled = "//getStr(getInsertedEnabled)//".", int(__LINE__, IK))
183 :
184 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
185 :
186 360 : call reset()
187 :
188 : #if setInserted_D0_SK_ENABLED
189 18 : array = "AA"
190 18 : insertion = "XY"
191 18 : arrayNewS_ref = "XAXA"
192 18 : arrayNewV_ref = "XYAXYA"
193 : #elif setInserted_D1_SK_ENABLED
194 72 : array = ["AA", "AA"]
195 72 : insertion = ["XX", "YY"]
196 108 : arrayNewS_ref = ["XX", "AA", "XX", "AA"]
197 144 : arrayNewV_ref = ["XX", "YY", "AA", "XX", "YY", "AA"]
198 : #elif setInserted_D1_IK_ENABLED
199 360 : array = [1_IKC, 1_IKC]
200 360 : insertion = [2_IKC, 3_IKC]
201 540 : arrayNewS_ref = [2_IKC, 1_IKC, 2_IKC, 1_IKC]
202 720 : arrayNewV_ref = [2_IKC, 3_IKC, 1_IKC, 2_IKC, 3_IKC, 1_IKC]
203 : #elif setInserted_D1_CK_ENABLED
204 288 : array = [(1._CKC,-1._CKC), (1._CKC,-1._CKC)]
205 288 : insertion = [(2._CKC,-2._CKC), (3._CKC,-3._CKC)]
206 432 : arrayNewS_ref = [(2._CKC,-2._CKC), (1._CKC,-1._CKC), (2._CKC,-2._CKC), (1._CKC,-1._CKC)]
207 576 : arrayNewV_ref = [(2._CKC,-2._CKC), (3._CKC,-3._CKC), (1._CKC,-1._CKC), (2._CKC,-2._CKC), (3._CKC,-3._CKC), (1._CKC,-1._CKC)]
208 : #elif setInserted_D1_RK_ENABLED
209 288 : array = [1._RKC, 1._RKC]
210 288 : insertion = [2._RKC, 3._RKC]
211 432 : arrayNewS_ref = [2._RKC, 1._RKC, 2._RKC, 1._RKC]
212 576 : arrayNewV_ref = [2._RKC, 3._RKC, 1._RKC, 2._RKC, 3._RKC, 1._RKC]
213 : #elif setInserted_D1_LK_ENABLED
214 360 : array = [.false._LK, .false._LK]
215 360 : insertion = [.true._LK, .true._LK]
216 540 : arrayNewS_ref = [.true._LK, .false._LK, .true._LK, .false._LK]
217 720 : arrayNewV_ref = [.true._LK, .true._LK, .false._LK, .true._LK, .true._LK, .false._LK]
218 : #endif
219 1440 : index = [1_IK, 2_IK]
220 :
221 360 : call runTestWith(positive, sorted)
222 360 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with a double-element vector `insertion` with `index = [1,2]` must yield a proper `arrayNew` with getInsertedEnabled = "//getStr(getInsertedEnabled)//".", int(__LINE__, IK))
223 :
224 360 : call runTestWith(positive, sorted, scalarInsertionIndex = 1_IK)
225 360 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with a single-element scalar `insertion` with `index = [1,2]` must yield a proper `arrayNew` with getInsertedEnabled = "//getStr(getInsertedEnabled)//".", int(__LINE__, IK))
226 :
227 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
228 :
229 360 : call reset()
230 :
231 : #if setInserted_D0_SK_ENABLED
232 18 : array = "AA"
233 18 : insertion = "XY"
234 18 : arrayNewS_ref = "XAXAX"
235 18 : arrayNewV_ref = "XYAXYAXY"
236 : #elif setInserted_D1_SK_ENABLED
237 72 : array = ["AA", "AA"]
238 72 : insertion = ["XX", "YY"]
239 126 : arrayNewS_ref = ["XX", "AA", "XX", "AA", "XX"]
240 180 : arrayNewV_ref = ["XX", "YY", "AA", "XX", "YY", "AA", "XX", "YY"]
241 : #elif setInserted_D1_IK_ENABLED
242 360 : array = [1_IKC, 1_IKC]
243 360 : insertion = [2_IKC, 3_IKC]
244 630 : arrayNewS_ref = [2_IKC, 1_IKC, 2_IKC, 1_IKC, 2_IKC]
245 900 : arrayNewV_ref = [2_IKC, 3_IKC, 1_IKC, 2_IKC, 3_IKC, 1_IKC, 2_IKC, 3_IKC]
246 : #elif setInserted_D1_CK_ENABLED
247 288 : array = [(1._CKC,-1._CKC), (1._CKC,-1._CKC)]
248 288 : insertion = [(2._CKC,-2._CKC), (3._CKC,-3._CKC)]
249 504 : arrayNewS_ref = [(2._CKC,-2._CKC), (1._CKC,-1._CKC), (2._CKC,-2._CKC), (1._CKC,-1._CKC), (2._CKC,-2._CKC)]
250 720 : arrayNewV_ref = [(2._CKC,-2._CKC), (3._CKC,-3._CKC), (1._CKC,-1._CKC), (2._CKC,-2._CKC), (3._CKC,-3._CKC), (1._CKC,-1._CKC), (2._CKC,-2._CKC), (3._CKC,-3._CKC)]
251 : #elif setInserted_D1_RK_ENABLED
252 288 : array = [1._RKC, 1._RKC]
253 288 : insertion = [2._RKC, 3._RKC]
254 504 : arrayNewS_ref = [2._RKC, 1._RKC, 2._RKC, 1._RKC, 2._RKC]
255 720 : arrayNewV_ref = [2._RKC, 3._RKC, 1._RKC, 2._RKC, 3._RKC, 1._RKC, 2._RKC, 3._RKC]
256 : #elif setInserted_D1_LK_ENABLED
257 360 : array = [.false._LK, .false._LK]
258 360 : insertion = [.true._LK, .true._LK]
259 630 : arrayNewS_ref = [.true._LK, .false._LK, .true._LK, .false._LK, .true._LK]
260 900 : arrayNewV_ref = [.true._LK, .true._LK, .false._LK, .true._LK, .true._LK, .false._LK, .true._LK, .true._LK]
261 : #endif
262 1800 : index = [1_IK, 2_IK, 3_IK]
263 360 : call runTestWith(positive, sorted)
264 360 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with a double-element vector `insertion` with `index = [1,2,3]` must yield a proper `arrayNew` with getInsertedEnabled = "//getStr(getInsertedEnabled)//".", int(__LINE__, IK))
265 :
266 360 : call runTestWith(positive, sorted, scalarInsertionIndex = 1_IK)
267 360 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with a single-element scalar `insertion` with `index = [1,2,3]` must yield a proper `arrayNew` with getInsertedEnabled = "//getStr(getInsertedEnabled)//".", int(__LINE__, IK))
268 :
269 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
270 :
271 360 : if (.not. getOption(.false._LK,positive)) then
272 :
273 240 : call reset()
274 :
275 : #if setInserted_D0_SK_ENABLED
276 12 : array = "AA"
277 12 : insertion = "XY"
278 12 : arrayNewS_ref = "XAXAXX"
279 12 : arrayNewV_ref = "XYAXYAXYXY"
280 : #elif setInserted_D1_SK_ENABLED
281 48 : array = ["AA", "AA"]
282 48 : insertion = ["XX", "YY"]
283 96 : arrayNewS_ref = ["XX", "AA", "XX", "AA", "XX", "XX"]
284 144 : arrayNewV_ref = ["XX", "YY", "AA", "XX", "YY", "AA", "XX", "YY", "XX", "YY"]
285 : #elif setInserted_D1_IK_ENABLED
286 240 : array = [1_IKC, 1_IKC]
287 240 : insertion = [2_IKC, 3_IKC]
288 480 : arrayNewS_ref = [2_IKC, 1_IKC, 2_IKC, 1_IKC, 2_IKC, 2_IKC]
289 720 : arrayNewV_ref = [2_IKC, 3_IKC, 1_IKC, 2_IKC, 3_IKC, 1_IKC, 2_IKC, 3_IKC, 2_IKC, 3_IKC]
290 : #elif setInserted_D1_CK_ENABLED
291 192 : array = [(1._CKC,-1._CKC), (1._CKC,-1._CKC)]
292 192 : insertion = [(2._CKC,-2._CKC), (3._CKC,-3._CKC)]
293 384 : arrayNewS_ref = [(2._CKC,-2._CKC), (1._CKC,-1._CKC), (2._CKC,-2._CKC), (1._CKC,-1._CKC), (2._CKC,-2._CKC), (2._CKC,-2._CKC)]
294 576 : arrayNewV_ref = [(2._CKC,-2._CKC), (3._CKC,-3._CKC), (1._CKC,-1._CKC), (2._CKC,-2._CKC), (3._CKC,-3._CKC), (1._CKC,-1._CKC), (2._CKC,-2._CKC), (3._CKC,-3._CKC), (2._CKC,-2._CKC), (3._CKC,-3._CKC)]
295 : #elif setInserted_D1_RK_ENABLED
296 192 : array = [1._RKC, 1._RKC]
297 192 : insertion = [2._RKC, 3._RKC]
298 384 : arrayNewS_ref = [2._RKC, 1._RKC, 2._RKC, 1._RKC, 2._RKC, 2._RKC]
299 576 : arrayNewV_ref = [2._RKC, 3._RKC, 1._RKC, 2._RKC, 3._RKC, 1._RKC, 2._RKC, 3._RKC, 2._RKC, 3._RKC]
300 : #elif setInserted_D1_LK_ENABLED
301 240 : array = [.false._LK, .false._LK]
302 240 : insertion = [.true._LK, .true._LK]
303 480 : arrayNewS_ref = [.true._LK, .false._LK, .true._LK, .false._LK, .true._LK, .true._LK]
304 720 : arrayNewV_ref = [.true._LK, .true._LK, .false._LK, .true._LK, .true._LK, .false._LK, .true._LK, .true._LK, .true._LK, .true._LK]
305 : #endif
306 1440 : index = [1_IK, 2_IK, 3_IK, 0_IK]
307 240 : call runTestWith(positive, sorted)
308 240 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with a double-element vector `insertion` with `index = [1_IK, 2_IK, 3_IK, 0_IK]` must yield a proper `arrayNew` with getInsertedEnabled = "//getStr(getInsertedEnabled)//".", int(__LINE__, IK))
309 :
310 240 : call runTestWith(positive, sorted, scalarInsertionIndex = 1_IK)
311 240 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with a single-element scalar `insertion` with `index = [1_IK, 2_IK, 3_IK, 0_IK]` must yield a proper `arrayNew` with getInsertedEnabled = "//getStr(getInsertedEnabled)//".", int(__LINE__, IK))
312 :
313 1440 : index = [-2_IK, -1_IK, 0_IK, 0_IK]
314 240 : call runTestWith(positive, sorted)
315 240 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with a double-element vector `insertion` with `index = [-2_IK, -1_IK, 0_IK, 0_IK]` must yield a proper `arrayNew` with getInsertedEnabled = "//getStr(getInsertedEnabled)//".", int(__LINE__, IK))
316 :
317 240 : call runTestWith(positive, sorted, scalarInsertionIndex = 1_IK)
318 240 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with a single-element scalar `insertion` with `index = [-2_IK, -1_IK, 0_IK, 0_IK]` must yield a proper `arrayNew` with getInsertedEnabled = "//getStr(getInsertedEnabled)//".", int(__LINE__, IK))
319 :
320 : end if
321 :
322 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
323 :
324 360 : if (.not. getOption(.false._LK, sorted)) then
325 :
326 240 : call reset()
327 :
328 : #if setInserted_D0_SK_ENABLED
329 12 : array = "AA"
330 12 : insertion = "XY"
331 12 : arrayNewS_ref = "XAXAXX"
332 12 : arrayNewV_ref = "XYAXYAXYXY"
333 : #elif setInserted_D1_SK_ENABLED
334 48 : array = ["AA", "AA"]
335 48 : insertion = ["XX", "YY"]
336 96 : arrayNewS_ref = ["XX", "AA", "XX", "AA", "XX", "XX"]
337 144 : arrayNewV_ref = ["XX", "YY", "AA", "XX", "YY", "AA", "XX", "YY", "XX", "YY"]
338 : #elif setInserted_D1_IK_ENABLED
339 240 : array = [1_IKC, 1_IKC]
340 240 : insertion = [2_IKC, 3_IKC]
341 480 : arrayNewS_ref = [2_IKC, 1_IKC, 2_IKC, 1_IKC, 2_IKC, 2_IKC]
342 720 : arrayNewV_ref = [2_IKC, 3_IKC, 1_IKC, 2_IKC, 3_IKC, 1_IKC, 2_IKC, 3_IKC, 2_IKC, 3_IKC]
343 : #elif setInserted_D1_CK_ENABLED
344 192 : array = [(1._CKC,-1._CKC), (1._CKC,-1._CKC)]
345 192 : insertion = [(2._CKC,-2._CKC), (3._CKC,-3._CKC)]
346 384 : arrayNewS_ref = [(2._CKC,-2._CKC), (1._CKC,-1._CKC), (2._CKC,-2._CKC), (1._CKC,-1._CKC), (2._CKC,-2._CKC), (2._CKC,-2._CKC)]
347 576 : arrayNewV_ref = [(2._CKC,-2._CKC), (3._CKC,-3._CKC), (1._CKC,-1._CKC), (2._CKC,-2._CKC), (3._CKC,-3._CKC), (1._CKC,-1._CKC), (2._CKC,-2._CKC), (3._CKC,-3._CKC), (2._CKC,-2._CKC), (3._CKC,-3._CKC)]
348 : #elif setInserted_D1_RK_ENABLED
349 192 : array = [1._RKC, 1._RKC]
350 192 : insertion = [2._RKC, 3._RKC]
351 384 : arrayNewS_ref = [2._RKC, 1._RKC, 2._RKC, 1._RKC, 2._RKC, 2._RKC]
352 576 : arrayNewV_ref = [2._RKC, 3._RKC, 1._RKC, 2._RKC, 3._RKC, 1._RKC, 2._RKC, 3._RKC, 2._RKC, 3._RKC]
353 : #elif setInserted_D1_LK_ENABLED
354 240 : array = [.false._LK, .false._LK]
355 240 : insertion = [.true._LK, .true._LK]
356 480 : arrayNewS_ref = [.true._LK, .false._LK, .true._LK, .false._LK, .true._LK, .true._LK]
357 720 : arrayNewV_ref = [.true._LK, .true._LK, .false._LK, .true._LK, .true._LK, .false._LK, .true._LK, .true._LK, .true._LK, .true._LK]
358 : #endif
359 1440 : index = [3_IK, 3_IK, 1_IK, 2_IK]
360 240 : call runTestWith(positive, sorted)
361 240 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with a double-element vector `insertion` with `index = [3_IK, 0_IK, 2_IK, 1_IK]` must yield a proper `arrayNew` with getInsertedEnabled = "//getStr(getInsertedEnabled)//".", int(__LINE__, IK))
362 :
363 240 : call runTestWith(positive, sorted, scalarInsertionIndex = 1_IK)
364 240 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with a single-element scalar `insertion` with `index = [3_IK, 0_IK, 2_IK, 1_IK]` must yield a proper `arrayNew` with getInsertedEnabled = "//getStr(getInsertedEnabled)//".", int(__LINE__, IK))
365 :
366 240 : if (.not. getOption(.false._LK, positive)) then
367 960 : index = [-1_IK, 0_IK, -2_IK, 0_IK]
368 160 : call runTestWith(positive, sorted)
369 160 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with a double-element vector `insertion` with `index = [-1_IK, 0_IK, -2_IK, 0_IK]` must yield a proper `arrayNew` with getInsertedEnabled = "//getStr(getInsertedEnabled)//".", int(__LINE__, IK))
370 :
371 160 : call runTestWith(positive, sorted, scalarInsertionIndex = 1_IK)
372 160 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with a single-element scalar `insertion` with `index = [-1_IK, 0_IK, -2_IK, 0_IK]` must yield a proper `arrayNew` with getInsertedEnabled = "//getStr(getInsertedEnabled)//".", int(__LINE__, IK))
373 : end if
374 :
375 : end if
376 :
377 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
378 :
379 360 : end subroutine
380 :
381 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
382 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
383 :
384 2280 : subroutine reset()
385 2280 : if (allocated(index)) deallocate(index)
386 2280 : if (allocated(array)) deallocate(array)
387 2280 : if (allocated(insertion)) deallocate(insertion)
388 2280 : if (allocated(arrayNewV_ref)) deallocate(arrayNewV_ref)
389 2280 : end subroutine reset
390 :
391 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
392 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
393 :
394 5000 : subroutine runTestWith(positive, sorted, scalarInsertionIndex)
395 : use pm_arrayResize, only: setResized
396 : logical(LK) , intent(in), optional :: positive, sorted
397 : integer(IK) , intent(in), optional :: scalarInsertionIndex
398 :
399 : integer(IK) :: lenArrayNew
400 5000 : lenArrayNew = GET_SIZE(array, kind = IK) + size(index, kind = IK)
401 :
402 5000 : if (present(scalarInsertionIndex)) then
403 2320 : call setResized(arrayNew, lenArrayNew)
404 2320 : if (getInsertedEnabled) then
405 1160 : call setInserted(arrayNew, array, insertion(GET_INDEX(scalarInsertionIndex)), index = index, positive = positive, sorted = sorted)
406 : else
407 6651 : arrayNew = getInserted(array, insertion(GET_INDEX(scalarInsertionIndex)), index = index, positive = positive, sorted = sorted)
408 : end if
409 11098 : assertion = assertion .and. ALL(arrayNew IS_EQUAL arrayNewS_ref)
410 2320 : call reportFailure(positive, sorted)
411 : else
412 2680 : lenArrayNew = lenArrayNew + size(index, kind = IK) * (GET_SIZE(insertion, kind = IK) - 1_IK)
413 2680 : call setResized(arrayNew, lenArrayNew)
414 2680 : if (getInsertedEnabled) then
415 1340 : call setInserted(arrayNew, array, insertion, index = index, positive = positive, sorted = sorted)
416 : else
417 9529 : arrayNew = getInserted(array, insertion, index = index, positive = positive, sorted = sorted)
418 : end if
419 16512 : assertion = assertion .and. ALL(arrayNew IS_EQUAL arrayNewV_ref)
420 2680 : call reportFailure(positive, sorted)
421 : end if
422 :
423 5000 : end subroutine
424 :
425 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
426 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
427 :
428 5000 : subroutine reportFailure(positive, sorted)
429 :
430 : use pm_io, only: display_type
431 :
432 : logical(LK) , intent(in), optional :: positive, sorted
433 :
434 5000 : type(display_type) :: disp
435 5000 : disp = display_type()
436 :
437 5000 : if (test%traceable .and. .not. assertion) then
438 :
439 : ! LCOV_EXCL_START
440 : write(test%disp%unit,"(*(g0,:,', '))")
441 :
442 : call disp%show("arrayNew")
443 : call disp%show( arrayNew )
444 : call disp%show("arrayNewV_ref")
445 : call disp%show( arrayNewV_ref )
446 : call disp%show("index")
447 : call disp%show( index )
448 : call disp%show("present(positive)")
449 : call disp%show( present(positive) )
450 : call disp%show("present(sorted)")
451 : call disp%show( present(sorted) )
452 :
453 : if (present(sorted)) then
454 : call disp%show("sorted")
455 : call disp%show( sorted )
456 : end if
457 :
458 : if (present(positive)) then
459 : call disp%show("positive")
460 : call disp%show( positive )
461 : end if
462 :
463 : write(test%disp%unit,"(*(g0,:,', '))")
464 : ! LCOV_EXCL_STOP
465 :
466 : end if
467 :
468 5000 : end subroutine
469 :
470 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
471 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
472 :
473 : #undef GET_INDEX
474 : #undef GET_SIZE
475 : #undef IS_EQUAL
476 : #undef ALL
|
