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<br>
19 : !> [setReversed](@ref pm_arrayReverse::setReversed)<br>
20 : !> [getReversed](@ref pm_arrayReverse::getReversed)<br>
21 : !>
22 : !> \fintest
23 : !>
24 : !> \author
25 : !> \AmirShahmoradi, September 1, 2017, 12:00 AM, Institute for Computational Engineering and Sciences (ICES), The University of Texas at Austin
26 :
27 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
28 :
29 : #if getReversed_D1_LK_ENABLED || setReversed_D1_LK_ENABLED
30 : #define IS_EQUAL .eqv.
31 : #else
32 : #define IS_EQUAL ==
33 : #endif
34 :
35 : #if !(getReversed_D0_SK_ENABLED || setReversed_D0_SK_ENABLED)
36 : #define GET_SIZE size
37 : #endif
38 :
39 : #if getReversed_D0_SK_ENABLED || setReversed_D0_SK_ENABLED
40 : #define GET_SIZE len
41 : #define ALL
42 2 : character(:,SKC), allocatable :: Array, arrayNew, ArrayNew_ref
43 : #elif getReversed_D1_SK_ENABLED || setReversed_D1_SK_ENABLED
44 : character(2,SKC), dimension(:), allocatable :: Array, arrayNew, ArrayNew_ref
45 : #elif getReversed_D1_IK_ENABLED || setReversed_D1_IK_ENABLED
46 : integer(IKC) , dimension(:), allocatable :: Array, arrayNew, ArrayNew_ref
47 : #elif getReversed_D1_CK_ENABLED || setReversed_D1_CK_ENABLED
48 : complex(CKC) , dimension(:), allocatable :: Array, arrayNew, ArrayNew_ref
49 : #elif getReversed_D1_RK_ENABLED || setReversed_D1_RK_ENABLED
50 : real(RKC) , dimension(:), allocatable :: Array, arrayNew, ArrayNew_ref
51 : #elif getReversed_D1_LK_ENABLED || setReversed_D1_LK_ENABLED
52 : logical(LKC) , dimension(:), allocatable :: Array, arrayNew, ArrayNew_ref
53 : #else
54 : #error "Unrecognized interface."
55 : #endif
56 :
57 : #if getReversed_D1_ENABLED
58 : character(*, SK), parameter :: PROCEDURE_NAME = "@getReversed()"
59 : #elif setReversed_D1_ENABLED
60 : character(*, SK), parameter :: PROCEDURE_NAME = "@setReversed()"
61 : logical(LK) :: arrayNewEnabled
62 20 : arrayNewEnabled = .false._LK
63 : #else
64 : #error "Unrecognized Interface."
65 : #endif
66 :
67 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
68 :
69 40 : assertion = .true._LK
70 40 : call runTestsWith()
71 : #if setReversed_D1_ENABLED
72 20 : arrayNewEnabled = .true._LK
73 20 : call runTestsWith()
74 : #endif
75 :
76 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
77 :
78 : contains
79 :
80 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
81 :
82 60 : subroutine runTestsWith()
83 :
84 60 : if (allocated(Array)) deallocate(Array)
85 60 : if (allocated(ArrayNew_ref)) deallocate(ArrayNew_ref)
86 :
87 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
88 :
89 : #if getReversed_D0_SK_ENABLED || setReversed_D0_SK_ENABLED
90 3 : Array = ""
91 3 : ArrayNew_ref = ""
92 : #elif getReversed_D1_SK_ENABLED || setReversed_D1_SK_ENABLED
93 3 : allocate(character(2,SKC) :: Array(0), ArrayNew_ref(0))
94 : #elif getReversed_D1_IK_ENABLED || setReversed_D1_IK_ENABLED
95 15 : allocate(Array(0), ArrayNew_ref(0))
96 : #elif getReversed_D1_CK_ENABLED || setReversed_D1_CK_ENABLED
97 12 : allocate(Array(0), ArrayNew_ref(0))
98 : #elif getReversed_D1_RK_ENABLED || setReversed_D1_RK_ENABLED
99 12 : allocate(Array(0), ArrayNew_ref(0))
100 : #elif getReversed_D1_LK_ENABLED || setReversed_D1_LK_ENABLED
101 15 : allocate(Array(0), ArrayNew_ref(0))
102 : #endif
103 60 : call report()
104 60 : call test%assert(assertion, PROCEDURE_NAME//SK_": An empty array has a reversed array of length zero.", int(__LINE__, IK))
105 :
106 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
107 :
108 : #if getReversed_D0_SK_ENABLED || setReversed_D0_SK_ENABLED
109 3 : Array = " "
110 3 : ArrayNew_ref = " "
111 : #elif getReversed_D1_SK_ENABLED || setReversed_D1_SK_ENABLED
112 9 : Array = [" "]
113 9 : ArrayNew_ref = [" "]
114 : #elif getReversed_D1_IK_ENABLED || setReversed_D1_IK_ENABLED
115 45 : Array = [1_IKC]
116 45 : ArrayNew_ref = [1_IKC]
117 : #elif getReversed_D1_CK_ENABLED || setReversed_D1_CK_ENABLED
118 36 : Array = [(+1._CKC, -1._CKC)]
119 36 : ArrayNew_ref = [(+1._CKC, -1._CKC)]
120 : #elif getReversed_D1_RK_ENABLED || setReversed_D1_RK_ENABLED
121 36 : Array = [1._RKC]
122 36 : ArrayNew_ref = [1._RKC]
123 : #elif getReversed_D1_LK_ENABLED || setReversed_D1_LK_ENABLED
124 45 : Array = [.true._LKC]
125 45 : ArrayNew_ref = [.true._LKC]
126 : #endif
127 60 : call report()
128 60 : call test%assert(assertion, PROCEDURE_NAME//SK_": An array of length 1 has a reversed array of length 1.", int(__LINE__, IK))
129 :
130 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
131 :
132 : #if getReversed_D0_SK_ENABLED || setReversed_D0_SK_ENABLED
133 3 : Array = "ABCDE "
134 3 : ArrayNew_ref = " EDCBA"
135 : #elif getReversed_D1_SK_ENABLED || setReversed_D1_SK_ENABLED
136 24 : Array = ["AA", "BB", "CC", "DD", "EE", " "]
137 24 : ArrayNew_ref = Array(size(Array):1:-1)
138 : #elif getReversed_D1_IK_ENABLED || setReversed_D1_IK_ENABLED
139 120 : Array = [1_IKC, 2_IKC, 3_IKC, 4_IKC, 5_IKC, 6_IKC]
140 120 : ArrayNew_ref = Array(size(Array):1:-1)
141 : #elif getReversed_D1_CK_ENABLED || setReversed_D1_CK_ENABLED
142 96 : Array = [(+1._CKC, -1._CKC), (+2._CKC, -2._CKC), (+3._CKC, -3._CKC), (+4._CKC, -4._CKC), (+5._CKC, -5._CKC), (+6._CKC, -6._CKC)]
143 96 : ArrayNew_ref = Array(size(Array):1:-1)
144 : #elif getReversed_D1_RK_ENABLED || setReversed_D1_RK_ENABLED
145 96 : Array = [1._RKC, 2._RKC, 3._RKC, 4._RKC, 5._RKC, 6._RKC]
146 96 : ArrayNew_ref = Array(size(Array):1:-1)
147 : #elif getReversed_D1_LK_ENABLED || setReversed_D1_LK_ENABLED
148 120 : Array = [.false._LKC, .true._LKC, .false._LKC, .true._LKC, .false._LKC, .true._LKC]
149 120 : ArrayNew_ref = Array(size(Array):1:-1)
150 : #endif
151 60 : call report()
152 60 : call test%assert(assertion, PROCEDURE_NAME//SK_": An ordered array must be correctly reversed.", int(__LINE__, IK))
153 :
154 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
155 :
156 60 : end subroutine
157 :
158 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
159 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
160 :
161 180 : subroutine report()
162 :
163 : #if getReversed_D1_ENABLED
164 250 : arrayNew = getReversed(Array)
165 : #elif setReversed_D1_ENABLED
166 120 : if (arrayNewEnabled) then
167 60 : if (allocated(arrayNew)) deallocate(arrayNew)
168 106 : allocate(arrayNew, mold = Array)
169 60 : call setReversed(Array, arrayNew)
170 : else
171 60 : if (allocated(arrayNew)) deallocate(arrayNew)
172 239 : allocate(arrayNew, source = Array)
173 60 : call setReversed(arrayNew)
174 : end if
175 : #else
176 : #error "Unrecognized Interface."
177 : #endif
178 :
179 579 : assertion = assertion .and. ALL(arrayNew IS_EQUAL ArrayNew_ref)
180 180 : if (test%traceable .and. .not. assertion) then
181 : ! LCOV_EXCL_START
182 : write(test%disp%unit,"(*(g0,:,', '))")
183 : write(test%disp%unit,"(*(g0,:,', '))") "Array ", Array
184 : write(test%disp%unit,"(*(g0,:,', '))") "arrayNew ", arrayNew
185 : write(test%disp%unit,"(*(g0,:,', '))") "ArrayNew_ref ", ArrayNew_ref
186 : #if setReversed_D1_ENABLED
187 : write(test%disp%unit,"(*(g0,:,', '))") "arrayNewEnabled ", arrayNewEnabled
188 : #endif
189 : write(test%disp%unit,"(*(g0,:,', '))")
190 : ! LCOV_EXCL_STOP
191 : end if
192 180 : end subroutine
193 :
194 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
195 :
196 : #undef IS_EQUAL
197 : #undef GET_SIZE
198 : #undef ALL
|
