1 ! RUN: %python %S/test_folding.py %s %flang_fc1
3 ! Check intrinsic function folding with host runtime library
6 real(2), parameter :: eps2
= 0.001_2
7 real(2), parameter :: eps3
= 0.001_3
8 real(4), parameter :: eps4
= 0.000001_4
9 real(8), parameter :: eps8
= 0.000000000000001_8
11 ! These eps have been set so that constant folding of intrinsic
12 ! functions that use host runtime can be tested independently of
13 ! the underlying math library used.
14 ! C++ <cmath> and libpgmath precise, relaxed and fast libraries pass the test.
15 ! It may have to be relaxed to pass on all architectures.
16 ! The purpose is to check that the "correct" runtime functions are mapped
17 ! to intrinsic functions but not to test the stability between different libraries.
18 ! The eps should just be low enough to give confidence that intrinsic
19 ! functions are mapped to runtime functions implementing the same math
21 ! Compared values were selected to be around 1 +/- 0.5 so that eps is meaningful.
22 ! Expected values come from libpgmath-precise for Real(4) and Real(8) and
23 ! were computed on X86_64.
25 logical, parameter :: test_sign_i4
= sign(1_4,2) == 1_4 .and
. sign(1_4,-3_8) == -1_4
26 logical, parameter :: test_sign_i8
= sign(1_8,2) == 1_8 .and
. sign(1_8,-3_8) == -1_8
28 ! Real scalar intrinsic function tests
29 #define
TEST_FLOATING(name
, result
, expected
, t
, k
) \
30 t(kind
= k
), parameter ::res_##name##_##t##k
= result
; \
31 t(kind
= k
), parameter ::exp_##name##_##t##k
= expected
; \
32 logical, parameter ::test_##name##_##t##k
= abs(res_##name##_##t##k
- exp_##name##_##t##k
).LE
.(eps##k
)
34 #define
TEST_R2(name
, result
, expected
) TEST_FLOATING(name
, result
, expected
, real, 2)
35 #define
TEST_R3(name
, result
, expected
) TEST_FLOATING(name
, result
, expected
, real, 3)
36 #define
TEST_R4(name
, result
, expected
) TEST_FLOATING(name
, result
, expected
, real, 4)
37 #define
TEST_R8(name
, result
, expected
) TEST_FLOATING(name
, result
, expected
, real, 8)
38 #define
TEST_C4(name
, result
, expected
) TEST_FLOATING(name
, result
, expected
, complex, 4)
39 #define
TEST_C8(name
, result
, expected
) TEST_FLOATING(name
, result
, expected
, complex, 8)
43 logical, parameter :: test_abs_r4
= abs(-2._4
).EQ
.(2._4
)
44 TEST_R4(acos
, acos(0.5_4
), 1.0471975803375244140625_4
)
45 TEST_R4(acosh
, acosh(1.5_4
), 0.96242368221282958984375_4
)
46 logical, parameter :: test_aint1
= aint(2.783).EQ
.(2.)
47 logical, parameter :: test_anint1
= anint(2.783).EQ
.(3.)
48 logical, parameter :: test_floor1
= floor(-2.783).EQ
.(-3.)
49 logical, parameter :: test_floor2
= floor(2.783).EQ
.(2.)
50 logical, parameter :: test_ceiling1
= ceiling(-2.783).EQ
.(-2.)
51 logical, parameter :: test_ceiling2
= ceiling(2.783).EQ
.(3.)
52 TEST_R4(asin
, asin(0.9_4
), 1.11976945400238037109375_4
)
53 TEST_R4(asinh
, asinh(1._4
), 0.881373584270477294921875_4
)
54 TEST_R4(atan
, atan(1.5_4
), 0.982793748378753662109375_4
)
55 TEST_R4(atan2
, atan2(1.5_4
, 1._4
), 0.982793748378753662109375_4
)
56 TEST_R4(atan_2
, atan(1.5_4
, 1._4
), 0.982793748378753662109375_4
)
57 TEST_R4(atanh
, atanh(0.8_4
), 1.098612308502197265625_4
)
58 TEST_R4(cos
, cos(0.5_4
), 0.877582550048828125_4
)
59 TEST_R4(cosh
, cosh(0.1_4
), 1.0050041675567626953125_4
)
60 TEST_R4(erf
, erf(1._4
), 0.842700779438018798828125_4
)
61 TEST_R4(erfc
, erfc(0.1_4
), 0.887537062168121337890625_4
)
62 TEST_R4(exp
, exp(0.1_4
), 1.1051709651947021484375_4
)
63 TEST_R4(gamma
, gamma(0.9_4
), 1.06862866878509521484375_4
)
64 TEST_R4(hypot
, hypot(1.1_4
, 0.1_4
), 1.10453617572784423828125_4
)
65 TEST_R4(log
, log(3._4
), 1.098612308502197265625_4
)
66 TEST_R4(log10
, log10(10.5_4
), 1.02118933200836181640625_4
)
67 TEST_R4(log_gamma
, log_gamma(3.5_4
), 1.20097362995147705078125_4
)
68 TEST_R4(mod
, mod(-8.1_4
, 5._4
), (-3.1000003814697265625_4
))
69 TEST_R4(real, real(z
'3f800000'), 1._4
)
70 logical, parameter :: test_sign_r4
= sign(1._4
,2._8
) == 1._4
.and
. sign(1._4
,-2._4
) == -1._4
71 TEST_R4(sin
, sin(1.6_4
), 0.99957358837127685546875_4
)
72 TEST_R4(sinh
, sinh(0.9_4
), 1.0265166759490966796875_4
)
73 TEST_R4(sqrt
, sqrt(1.1_4
), 1.0488088130950927734375_4
)
74 TEST_R4(tan
, tan(0.8_4
), 1.0296385288238525390625_4
)
75 TEST_R4(tanh
, tanh(3._4
), 0.995054781436920166015625_4
)
79 logical, parameter :: test_abs_r8
= abs(-2._8
).EQ
.(2._8
)
80 TEST_R8(acos
, acos(0.5_8
), &
81 1.047197551196597853362391106202267110347747802734375_8
)
82 TEST_R8(acosh
, acosh(1.5_8
), &
83 0.9624236501192069415111518537742085754871368408203125_8
)
84 TEST_R8(asin
, asin(0.9_8
), &
85 1.119769514998634196700777465594001114368438720703125_8
)
86 TEST_R8(asinh
, asinh(1._8
), &
87 0.88137358701954304773806825323845259845256805419921875_8
)
88 TEST_R8(atan
, atan(1.5_8
), &
89 0.98279372324732905408239957978366874158382415771484375_8
)
90 TEST_R8(atan2
, atan2(1.5_8
, 1._8
), &
91 0.98279372324732905408239957978366874158382415771484375_8
)
92 TEST_R8(atan_2
, atan(1.5_8
, 1._8
), &
93 0.98279372324732905408239957978366874158382415771484375_8
)
94 TEST_R8(atanh
, atanh(0.8_8
), &
95 1.0986122886681097821082175869378261268138885498046875_8
)
96 TEST_R8(cos
, cos(0.5_8
), &
97 0.8775825618903727587394314468838274478912353515625_8
)
98 TEST_R8(cosh
, cosh(0.1_8
), &
99 1.0050041680558035039894093642942607402801513671875_8
)
100 TEST_R8(erf
, erf(1._8
), &
101 0.84270079294971489414223242420121096074581146240234375_8
)
102 TEST_R8(erfc
, erfc(0.1_8
), &
103 0.8875370839817151580319887216319330036640167236328125_8
)
104 TEST_R8(exp
, exp(0.1_8
), &
105 1.10517091807564771244187795673497021198272705078125_8
)
106 TEST_R8(gamma
, gamma(0.9_8
), &
107 1.0686287021193192625645451698801480233669281005859375_8
)
108 TEST_R8(hypot
, hypot(1.1_8
, 0.1_8
), &
109 1.1045361017187260710414875575224868953227996826171875_8
)
110 TEST_R8(log
, log(3._8
), &
111 1.0986122886681097821082175869378261268138885498046875_8
)
112 TEST_R8(log10
, log10(10.5_8
), &
113 1.0211892990699380501240511875948868691921234130859375_8
)
114 TEST_R8(log_gamma
, log_gamma(3.5_8
), &
115 1.200973602347074287166606154642067849636077880859375_8
)
116 TEST_R8(mod
, mod(-8.1_8
, 5._8
), &
117 (-3.0999999999999996447286321199499070644378662109375_8
))
118 TEST_R8(real, real(z
'3ff0000000000000',8), 1._8
)
119 logical, parameter :: test_sign_r8
= sign(1._8
,2._8
) == 1._8
.and
. sign(1._8
,-2._4
) == -1._8
120 TEST_R8(sin
, sin(1.6_8
), &
121 0.99957360304150510987852840116829611361026763916015625_8
)
122 TEST_R8(sinh
, sinh(0.9_8
), &
123 1.0265167257081753149350333842448890209197998046875_8
)
124 TEST_R8(sqrt
, sqrt(1.1_8
), &
125 1.048808848170151630796453900984488427639007568359375_8
)
126 TEST_R8(tan
, tan(0.8_8
), &
127 1.0296385570503641115891468871268443763256072998046875_8
)
128 TEST_R8(tanh
, tanh(3._8
), &
129 0.995054753686730464323773048818111419677734375_8
)
133 logical, parameter :: test_abs_c4
= abs(abs((1.1_4
, 0.1_4
)) &
134 - 1.10453617572784423828125_4
).LE
.(eps4
)
135 TEST_C4(acos
, acos((0.7_4
, 1.1_4
)), &
136 (1.11259567737579345703125_4
, -1.03283786773681640625_4
))
137 TEST_C4(acosh
, acosh((0.7_4
, 1.1_4
)), &
138 (1.03283774852752685546875_4
, 1.11259555816650390625_4
))
139 TEST_C4(asin
, asin((1.4_4
, 0.7_4
)), &
140 (1.0101039409637451171875_4
,1.08838176727294921875_4
))
141 TEST_C4(asinh
, asinh((0.7_4
, 1.4_4
)), &
142 (1.08838176727294921875_4
,1.0101039409637451171875_4
))
143 TEST_C4(atan
, atan((0.2_4
, 1.1_4
)), &
144 (1.06469786167144775390625_4
,1.12215900421142578125_4
))
145 TEST_C4(atanh
, atanh((1.1_4
, 0.2_4
)), &
146 (1.12215900421142578125_4
,1.06469786167144775390625_4
))
147 TEST_C4(cmplx
, cmplx(z
'bf800000',z
'3f000000'), (-1._4
,0.5_4
))
148 TEST_C4(cos
, cos((0.9_4
, 1.1_4
)), &
149 (1.0371677875518798828125_4
,(-1.0462486743927001953125_4
)))
150 TEST_C4(cosh
, cosh((1.1_4
, 0.9_4
)), &
151 (1.0371677875518798828125_4
,1.0462486743927001953125_4
))
152 TEST_C4(exp
, exp((0.4_4
, 0.8_4
)), &
153 (1.039364337921142578125_4
,1.07016956806182861328125_4
))
154 TEST_C4(log
, log((1.5_4
, 2.5_4
)), &
155 (1.07003307342529296875_4
,1.03037679195404052734375_4
))
156 TEST_C4(sin
, sin((0.7_4
, 1.1_4
)), &
157 (1.07488918304443359375_4
,1.02155959606170654296875_4
))
158 TEST_C4(sinh
, sinh((1.1_4
, 0.7_4
)), &
159 (1.02155959606170654296875_4
,1.07488918304443359375_4
))
160 TEST_C4(sqrt
, sqrt((0.1_4
, 2.1_4
)), &
161 (1.04937589168548583984375_4
,1.00059473514556884765625_4
))
162 TEST_C4(tan
, tan((1.1_4
, 0.4_4
)), &
163 (1.07952976226806640625_4
,1.1858270168304443359375_4
))
164 TEST_C4(tanh
, tanh((0.4_4
, 1.1_4
)), &
165 (1.1858270168304443359375_4
,1.07952976226806640625_4
))
169 logical, parameter :: test_abs_c8
= abs(abs((1.1_8
, 0.1_8
)) &
170 - 1.1045361017187260710414875575224868953227996826171875_8
).LE
.(eps4
)
171 TEST_C8(acos
, acos((0.7_8
, 1.1_8
)), &
172 (1.1125956244800556671492586247040890157222747802734375_8
, &
173 (-1.032837729564676454430127705563791096210479736328125_8
)))
174 TEST_C8(acosh
, acosh((0.7_8
, 1.1_8
)), &
175 (1.0328377295646762323855227805324830114841461181640625_8
, &
176 (1.1125956244800558891938635497353971004486083984375_8
)))
177 TEST_C8(asin
, asin((1.4_8
, 0.7_8
)), &
178 (1.010103922959187716656970223993994295597076416015625_8
, &
179 (1.088381716746653626870511288871057331562042236328125_8
)))
180 TEST_C8(asinh
, asinh((0.7_8
, 1.4_8
)), &
181 (1.088381716746653626870511288871057331562042236328125_8
, &
182 (1.0101039229591874946123652989626862108707427978515625_8
)))
183 TEST_C8(atan
, atan((0.2_8
, 1.1_8
)), &
184 (1.064697821069229721757665174663998186588287353515625_8
, &
185 (1.122159092433034910385458715609274804592132568359375_8
)))
186 TEST_C8(atanh
, atanh((1.1_8
, 0.2_8
)), &
187 (1.122159092433034910385458715609274804592132568359375_8
, &
188 (1.064697821069229721757665174663998186588287353515625_8
)))
189 TEST_C8(cmplx
, cmplx(z
'bff0000000000000', kind
=8), (-1._8
,0))
190 TEST_C8(cos
, cos((0.9_8
, 1.1_8
)), &
191 (1.03716776530046761450876147137023508548736572265625_8
, &
192 (-1.0462486051241379758636185215436853468418121337890625_8
)))
193 TEST_C8(cosh
, cosh((1.1_8
, 0.9_8
)), &
194 (1.03716776530046761450876147137023508548736572265625_8
, &
195 (1.0462486051241379758636185215436853468418121337890625_8
)))
196 TEST_C8(exp
, exp((0.4_8
, 0.8_8
)), &
197 (1.039364276016479404773917849524877965450286865234375_8
, &
198 (1.0701695334073042520373064689920283854007720947265625_8
)))
199 TEST_C8(log
, log((1.5_8
, 2.5_8
)), &
200 (1.070033081748135384003717263112775981426239013671875_8
, &
201 (1.0303768265243125057395445764996111392974853515625_8
)))
202 TEST_C8(sin
, sin((0.7_8
, 1.1_8
)), &
203 (1.0748891638565509776270801012287847697734832763671875_8
, &
204 (1.0215595324907689178672853813623078167438507080078125_8
)))
205 TEST_C8(sinh
, sinh((1.1_8
, 0.7_8
)), &
206 (1.0215595324907689178672853813623078167438507080078125_8
, &
207 (1.0748891638565509776270801012287847697734832763671875_8
)))
208 TEST_C8(sqrt
, sqrt((0.1_8
, 2.1_8
)), &
209 (1.04937591075907210580453465809114277362823486328125_8
, &
210 (1.0005947241922830059472419228351358112816260614863494993187487125396728515625_8
)))
211 TEST_C8(tan
, tan((1.1_8
, 0.4_8
)), &
212 (1.07952982287592025301137255155481398105621337890625_8
, &
213 (1.1858270353667335061942367246956564486026763916015625_8
)))
214 TEST_C8(tanh
, tanh((0.4_8
, 1.1_8
)), &
215 (1.1858270353667335061942367246956564486026763916015625_8
, &
216 (1.07952982287592025301137255155481398105621337890625_8
)))
219 ! Only test a few REAL(2)/REAL(3) cases since they anyway use the real 4
221 TEST_R2(acos
, acos(0.5_2
), 1.046875_2
)
222 TEST_R2(atan2
, atan2(1.5_2
, 1._2
), 9.8291015625e-1_2
)
224 TEST_R3(acos
, acos(0.5_3
), 1.046875_3
)
225 TEST_R3(atan2
, atan2(1.3_2
, 1._3
), 9.140625e-1_3
)
227 #ifdef TEST_LIBPGMATH
228 ! Bessel functions and erfc_scaled can only be folded if libpgmath
230 TEST_R4(bessel_j0
, bessel_j0(0.5_4
), 0.938469827175140380859375_4
)
231 TEST_R4(bessel_j1
, bessel_j1(1.8_4
), 0.5815169811248779296875_4
)
232 TEST_R4(bessel_jn
, bessel_jn(2, 3._4
), 0.4860912859439849853515625_4
)
233 TEST_R4(bessel_y0
, bessel_y0(2._4
), 0.510375678539276123046875_4
)
234 TEST_R4(bessel_y1
, bessel_y1(1._4
), (-0.78121280670166015625_4
))
235 TEST_R4(bessel_yn
, bessel_yn(2, 1.5_4
), (-0.932193756103515625_4
))
236 TEST_R4(erfc_scaled
, erfc_scaled(0.1_4
), 0.8964569568634033203125_4
)
238 TEST_R8(bessel_j0
, bessel_j0(0.5_8
), &
239 0.938469807240812858850631528184749186038970947265625_8
)
240 TEST_R8(bessel_j1
, bessel_j1(1.8_8
), &
241 0.5815169517311653546443039886071346700191497802734375_8
)
242 TEST_R8(bessel_jn
, bessel_jn(2, 3._8
), &
243 0.486091260585891082879328450871980749070644378662109375_8
)
244 TEST_R8(bessel_y0
, bessel_y0(2._8
), &
245 0.51037567264974514902320379405864514410495758056640625_8
)
246 TEST_R8(bessel_y1
, bessel_y1(1._8
), &
247 (-0.781212821300288684511770043172873556613922119140625_8
))
248 TEST_R8(bessel_yn
, bessel_yn(2, 1.5_8
), &
249 (-0.93219375976297402797143831776338629424571990966796875_8
))
250 TEST_R8(erfc_scaled
, erfc_scaled(0.1_8
), &
251 0.89645697996912654392787089818739332258701324462890625_8
)
253 real(4), parameter :: bessel_jn_transformational(*) = bessel_jn(1,3, 3.2_4
)
254 logical, parameter :: test_bessel_jn_shape
= size(bessel_jn_transformational
, 1).eq
.3
255 logical, parameter :: test_bessel_jn_t1
= bessel_jn_transformational(1).eq
.bessel_jn(1, 3.2_4
)
256 logical, parameter :: test_bessel_jn_t2
= bessel_jn_transformational(2).eq
.bessel_jn(2, 3.2_4
)
257 logical, parameter :: test_bessel_jn_t3
= bessel_jn_transformational(3).eq
.bessel_jn(3, 3.2_4
)
258 real(4), parameter :: bessel_jn_empty(*) = bessel_jn(3,1, 3.2_4
)
259 logical, parameter :: test_bessel_jn_empty
= size(bessel_jn_empty
, 1).eq
.0
261 real(4), parameter :: bessel_yn_transformational(*) = bessel_yn(1,3, 1.6_4
)
262 logical, parameter :: test_bessel_yn_shape
= size(bessel_yn_transformational
, 1).eq
.3
263 logical, parameter :: test_bessel_yn_t1
= bessel_yn_transformational(1).eq
.bessel_yn(1, 1.6_4
)
264 logical, parameter :: test_bessel_yn_t2
= bessel_yn_transformational(2).eq
.bessel_yn(2, 1.6_4
)
265 logical, parameter :: test_bessel_yn_t3
= bessel_yn_transformational(3).eq
.bessel_yn(3, 1.6_4
)
266 real(4), parameter :: bessel_yn_empty(*) = bessel_yn(3,1, 3.2_4
)
267 logical, parameter :: test_bessel_yn_empty
= size(bessel_yn_empty
, 1).eq
.0
270 ! Test exponentiation by real or complex folding (it is using host runtime)
271 TEST_R4(pow
, (0.5_4
**3.14_4
), 1.134398877620697021484375e-1_4
)
272 TEST_R8(pow
, (0.5_8
**3.14_8
), &
273 1.1343989441464509548840311481399112381041049957275390625e-1_8
)
274 TEST_C4(pow
, ((0.5_4
, 0.6_4
)**(0.74_4
, -1.1_4
)), &
275 (1.32234990596771240234375_4
,1.73712027072906494140625_4
))
276 TEST_C8(pow
, ((0.5_8
, 0.6_8
)**(0.74_8
, -1.1_8
)), &
277 (1.3223499632715445262221010125358588993549346923828125_8
, &
278 1.7371201007364975854585509296157397329807281494140625_8
))
280 ! Extension specific intrinsic variants
281 logical, parameter :: test_babs1
= kind(babs(-1_1)) == 1
282 logical, parameter :: test_babs2
= babs(-1_1) == 1_1
283 logical, parameter :: test_iiabs1
= kind(iiabs(-1_2)) == 2
284 logical, parameter :: test_iiabs2
= iiabs(-1_2) == 1_2
285 logical, parameter :: test_jiabs1
= kind(jiabs(-1_4)) == 4
286 logical, parameter :: test_jiabs2
= jiabs(-1_4) == 1_4
287 logical, parameter :: test_kiabs1
= kind(kiabs(-1_8)) == 8
288 logical, parameter :: test_kiabs2
= kiabs(-1_8) == 1_8
289 logical, parameter :: test_zabs1
= kind(zabs((3._8
,4._8
))) == 8
290 logical, parameter :: test_zabs2
= zabs((3._8
,4._8
)) == 5_8
291 logical, parameter :: test_cdabs1
= kind(cdabs((3._8
,4._8
))) == kind(1.d0
)
292 logical, parameter :: test_cdabs2
= cdabs((3._8
,4._8
)) == real(5, kind(1.d0
))
293 logical, parameter :: test_kidnnt1
= kind(kidnnt(2.5d0)) == 8
294 logical, parameter :: test_kidnnt2
= kidnnt(2.5d0) == 3
295 logical, parameter :: test_knint1
= kind(knint(2.5)) == 8
296 logical, parameter :: test_knint2
= knint(2.5) == 3
