This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Test for nan range ends.
[perl5.git] / t / op / infnan.t
CommitLineData
8c12dc63 1#!./perl -w
313d3d89
JH
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6 require './test.pl';
7}
8
8c12dc63
JH
9use strict;
10
636a970b
JH
11use Config;
12
78c93c95
JH
13BEGIN {
14 if ($^O eq 'aix' && $Config{uselongdouble}) {
15 # FWIW: NaN actually seems to be working decently,
16 # but Inf is completely broken (e.g. Inf + 0 -> NaN).
17 skip_all "$^O with long doubles does not have sane inf/nan";
18 }
19}
20
313d3d89
JH
21my $PInf = "Inf" + 0;
22my $NInf = "-Inf" + 0;
23my $NaN = "NaN" + 0;
24
8c12dc63
JH
25my @PInf = ("Inf", "inf", "INF", "+Inf",
26 "Infinity", "INFINITE",
313d3d89 27 "1.#INF", "1#INF");
8c12dc63 28my @NInf = map { "-$_" } grep { ! /^\+/ } @PInf;
313d3d89
JH
29
30my @NaN = ("NAN", "nan", "qnan", "SNAN", "NanQ", "NANS",
8c12dc63 31 "1.#QNAN", "+1#SNAN", "-1.#NAN", "1#IND",
313d3d89
JH
32 "NaN123", "NAN(123)", "nan%",
33 "nanonano"); # RIP, Robin Williams.
34
0c7df902 35my @printf_fmt = qw(e f g a d u o i b x p);
354b74ae 36my @packi_fmt = qw(c C s S l L i I n N v V j J w W U);
0c7df902 37my @packf_fmt = qw(f d F);
354b74ae 38my @packs_fmt = qw(a4 A4 Z5 b20 B20 h10 H10 u);
540a63d6 39
0c7df902
JH
40if ($Config{ivsize} == 8) {
41 push @packi_fmt, qw(q Q);
42}
38e1c50b 43
3e3c2fa4 44if ($Config{uselongdouble} && $Config{nvsize} > $Config{doublesize}) {
0c7df902
JH
45 push @packf_fmt, 'D';
46}
313d3d89 47
0c7df902 48# === Inf tests ===
313d3d89 49
0c7df902
JH
50cmp_ok($PInf, '>', 0, "positive infinity");
51cmp_ok($NInf, '<', 0, "negative infinity");
313d3d89 52
0c7df902
JH
53cmp_ok($PInf, '>', $NInf, "positive > negative");
54cmp_ok($NInf, '==', -$PInf, "negative == -positive");
55cmp_ok(-$NInf, '==', $PInf, "--negative == positive");
313d3d89 56
0c7df902
JH
57is($PInf, "Inf", "$PInf value stringifies as Inf");
58is($NInf, "-Inf", "$NInf value stringifies as -Inf");
8c12dc63 59
5bf8b78e
JH
60cmp_ok($PInf + 0, '==', $PInf, "+Inf + zero is +Inf");
61cmp_ok($NInf + 0, '==', $NInf, "-Inf + zero is -Inf");
62
63cmp_ok($PInf + 1, '==', $PInf, "+Inf + one is +Inf");
64cmp_ok($NInf + 1, '==', $NInf, "-Inf + one is -Inf");
65
66cmp_ok($PInf + $PInf, '==', $PInf, "+Inf + Inf is +Inf");
67cmp_ok($NInf + $NInf, '==', $NInf, "-Inf - Inf is -Inf");
68
0c7df902
JH
69cmp_ok($PInf * 2, '==', $PInf, "twice Inf is Inf");
70cmp_ok($PInf / 2, '==', $PInf, "half of Inf is Inf");
313d3d89 71
00c6bd38
JH
72cmp_ok($PInf * $PInf, '==', $PInf, "+Inf * +Inf is +Inf");
73cmp_ok($PInf * $NInf, '==', $NInf, "+Inf * -Inf is -Inf");
74cmp_ok($NInf * $PInf, '==', $NInf, "-Inf * +Inf is -Inf");
5bf8b78e 75cmp_ok($NInf * $NInf, '==', $PInf, "-Inf * -Inf is +Inf");
313d3d89 76
0c7df902
JH
77is(sprintf("%g", $PInf), "Inf", "$PInf sprintf %g is Inf");
78is(sprintf("%a", $PInf), "Inf", "$PInf sprintf %a is Inf");
d06c1c80 79
0c7df902
JH
80for my $f (@printf_fmt) {
81 is(sprintf("%$f", $PInf), "Inf", "$PInf sprintf %$f is Inf");
82}
d1877901 83
0c7df902
JH
84ok(!defined eval { $a = sprintf("%c", $PInf)}, "sprintf %c +Inf undef");
85like($@, qr/Cannot printf/, "$PInf sprintf fails");
354b74ae
FC
86ok(!defined eval { $a = sprintf("%c", "Inf")},
87 "stringy sprintf %c +Inf undef");
88like($@, qr/Cannot printf/, "stringy $PInf sprintf fails");
313d3d89 89
0c7df902
JH
90ok(!defined eval { $a = chr($PInf) }, "chr(+Inf) undef");
91like($@, qr/Cannot chr/, "+Inf chr() fails");
354b74ae
FC
92ok(!defined eval { $a = chr("Inf") }, "chr(stringy +Inf) undef");
93like($@, qr/Cannot chr/, "stringy +Inf chr() fails");
540a63d6 94
0c7df902
JH
95ok(!defined eval { $a = sprintf("%c", $NInf)}, "sprintf %c -Inf undef");
96like($@, qr/Cannot printf/, "$NInf sprintf fails");
354b74ae
FC
97ok(!defined eval { $a = sprintf("%c", "-Inf")},
98 "sprintf %c stringy -Inf undef");
99like($@, qr/Cannot printf/, "stringy $NInf sprintf fails");
1cd88304 100
0c7df902
JH
101ok(!defined eval { $a = chr($NInf) }, "chr(-Inf) undef");
102like($@, qr/Cannot chr/, "-Inf chr() fails");
354b74ae
FC
103ok(!defined eval { $a = chr("-Inf") }, "chr(stringy -Inf) undef");
104like($@, qr/Cannot chr/, "stringy -Inf chr() fails");
1cd88304 105
0c7df902 106for my $f (@packi_fmt) {
5ebb886c 107 undef $a;
0c7df902
JH
108 ok(!defined eval { $a = pack($f, $PInf) }, "pack $f +Inf undef");
109 like($@, $f eq 'w' ? qr/Cannot compress Inf/: qr/Cannot pack Inf/,
110 "+Inf pack $f fails");
5ebb886c 111 undef $a;
354b74ae
FC
112 ok(!defined eval { $a = pack($f, "Inf") },
113 "pack $f stringy +Inf undef");
114 like($@, $f eq 'w' ? qr/Cannot compress Inf/: qr/Cannot pack Inf/,
115 "stringy +Inf pack $f fails");
5ebb886c 116 undef $a;
0c7df902
JH
117 ok(!defined eval { $a = pack($f, $NInf) }, "pack $f -Inf undef");
118 like($@, $f eq 'w' ? qr/Cannot compress -Inf/: qr/Cannot pack -Inf/,
119 "-Inf pack $f fails");
5ebb886c 120 undef $a;
354b74ae
FC
121 ok(!defined eval { $a = pack($f, "-Inf") },
122 "pack $f stringy -Inf undef");
123 like($@, $f eq 'w' ? qr/Cannot compress -Inf/: qr/Cannot pack -Inf/,
124 "stringy -Inf pack $f fails");
0c7df902 125}
1f4ef0f1 126
0c7df902 127for my $f (@packf_fmt) {
5ebb886c
JH
128 undef $a;
129 undef $b;
0c7df902
JH
130 ok(defined eval { $a = pack($f, $PInf) }, "pack $f +Inf defined");
131 eval { $b = unpack($f, $a) };
132 cmp_ok($b, '==', $PInf, "pack $f +Inf equals $PInf");
1f4ef0f1 133
5ebb886c
JH
134 undef $a;
135 undef $b;
0c7df902
JH
136 ok(defined eval { $a = pack($f, $NInf) }, "pack $f -Inf defined");
137 eval { $b = unpack($f, $a) };
138 cmp_ok($b, '==', $NInf, "pack $f -Inf equals $NInf");
139}
1cd88304 140
354b74ae 141for my $f (@packs_fmt) {
5ebb886c 142 undef $a;
354b74ae
FC
143 ok(defined eval { $a = pack($f, $PInf) }, "pack $f +Inf defined");
144 is($a, pack($f, "Inf"), "pack $f +Inf same as 'Inf'");
145
5ebb886c 146 undef $a;
354b74ae
FC
147 ok(defined eval { $a = pack($f, $NInf) }, "pack $f -Inf defined");
148 is($a, pack($f, "-Inf"), "pack $f -Inf same as 'Inf'");
149}
150
151is eval { unpack "p", pack 'p', $PInf }, "Inf", "pack p +Inf";
152is eval { unpack "P3", pack 'P', $PInf }, "Inf", "pack P +Inf";
153is eval { unpack "p", pack 'p', $NInf }, "-Inf", "pack p -Inf";
154is eval { unpack "P4", pack 'P', $NInf }, "-Inf", "pack P -Inf";
155
0c7df902 156for my $i (@PInf) {
8c12dc63
JH
157 cmp_ok($i + 0 , '==', $PInf, "$i is +Inf");
158 cmp_ok($i, '>', 0, "$i is positive");
313d3d89 159 is("@{[$i+0]}", "Inf", "$i value stringifies as Inf");
0c7df902 160}
313d3d89 161
0c7df902 162for my $i (@NInf) {
8c12dc63
JH
163 cmp_ok($i + 0, '==', $NInf, "$i is -Inf");
164 cmp_ok($i, '<', 0, "$i is negative");
313d3d89 165 is("@{[$i+0]}", "-Inf", "$i value stringifies as -Inf");
0c7df902 166}
313d3d89 167
0c7df902
JH
168is($PInf + $PInf, $PInf, "+Inf plus +Inf is +Inf");
169is($NInf + $NInf, $NInf, "-Inf plus -Inf is -Inf");
313d3d89 170
0c7df902
JH
171is(1/$PInf, 0, "one per +Inf is zero");
172is(1/$NInf, 0, "one per -Inf is zero");
87821667 173
0c7df902
JH
174my ($PInfPP, $PInfMM) = ($PInf, $PInf);
175my ($NInfPP, $NInfMM) = ($NInf, $NInf);;
176$PInfPP++;
177$PInfMM--;
178$NInfPP++;
179$NInfMM--;
180is($PInfPP, $PInf, "+Inf++ is +Inf");
181is($PInfMM, $PInf, "+Inf-- is +Inf");
182is($NInfPP, $NInf, "-Inf++ is -Inf");
183is($NInfMM, $NInf, "-Inf-- is -Inf");
38e1c50b 184
0c7df902
JH
185ok($PInf, "+Inf is true");
186ok($NInf, "-Inf is true");
38e1c50b 187
5bf8b78e
JH
188is(abs($PInf), $PInf, "abs(+Inf) is +Inf");
189is(abs($NInf), $PInf, "abs(-Inf) is +Inf");
190
191# One could argue of NaN as the result.
192is(int($PInf), $PInf, "int(+Inf) is +Inf");
193is(int($NInf), $NInf, "int(-Inf) is -Inf");
194
0c7df902 195is(sqrt($PInf), $PInf, "sqrt(+Inf) is +Inf");
5bf8b78e
JH
196# sqrt $NInf doesn't work because negative is caught
197
0c7df902
JH
198is(exp($PInf), $PInf, "exp(+Inf) is +Inf");
199is(exp($NInf), 0, "exp(-Inf) is zero");
38e1c50b 200
0c7df902 201SKIP: {
5bf8b78e
JH
202 if ($PInf == 0) {
203 skip "if +Inf == 0 cannot log(+Inf)", 1;
204 }
205 is(log($PInf), $PInf, "log(+Inf) is +Inf");
206}
207# log $NInf doesn't work because negative is caught
208
209is(rand($PInf), $PInf, "rand(+Inf) is +Inf");
210is(rand($NInf), $NInf, "rand(-Inf) is -Inf");
211
212# XXX Bit operations?
213# +Inf & 1 == +Inf?
214# +Inf | 1 == +Inf?
215# +Inf ^ 1 == +Inf?
216# ~+Inf == 0? or NaN?
217# -Inf ... ???
218# NaN & 1 == NaN?
219# NaN | 1 == NaN?
220# NaN ^ 1 == NaN?
221# ~NaN == NaN???
222# Or just declare insanity and die?
223
98efe49c
JH
224TODO: {
225 local $::TODO;
0c7df902 226 my $here = "$^O $Config{osvers}";
98efe49c
JH
227 $::TODO = "$here: pow (9**9**9) doesn't give Inf"
228 if $here =~ /^(?:hpux 10|os390)/;
0c7df902 229 is(9**9**9, $PInf, "9**9**9 is Inf");
313d3d89
JH
230}
231
3ff98fcf
JH
232SKIP: {
233 my @FInf = qw(Info Infiniti Infinityz);
234 if ($Config{usequadmath}) {
235 skip "quadmath strtoflt128() accepts false infinities", scalar @FInf;
236 }
0ec38c0a
JH
237 # Silence "isn't numeric in addition", that's kind of the point.
238 local $^W = 0;
3ff98fcf 239 for my $i (@FInf) {
0ec38c0a
JH
240 cmp_ok("$i" + 0, '==', 0, "false infinity $i");
241 }
242}
243
8d2f77d8
JH
244{
245 # Silence "Non-finite repeat count", that is tested elsewhere.
246 local $^W = 0;
247 is("a" x $PInf, "", "x +Inf");
248 is("a" x $NInf, "", "x -Inf");
249}
250
34c2b396
JH
251{
252 eval 'for my $x (0..$PInf) { last }';
253 like($@, qr/Range iterator outside integer range/, "0..+Inf fails");
254
255 eval 'for my $x ($NInf..0) { last }';
256 like($@, qr/Range iterator outside integer range/, "-Inf..0 fails");
257}
258
0c7df902 259# === NaN ===
38e1c50b 260
0c7df902
JH
261cmp_ok($NaN, '!=', $NaN, "NaN is NaN numerically (by not being NaN)");
262ok($NaN eq $NaN, "NaN is NaN stringifically");
313d3d89 263
0c7df902 264is("$NaN", "NaN", "$NaN value stringifies as NaN");
313d3d89 265
0c7df902
JH
266is("+NaN" + 0, "NaN", "+NaN is NaN");
267is("-NaN" + 0, "NaN", "-NaN is NaN");
313d3d89 268
5bf8b78e
JH
269is($NaN + 0, $NaN, "NaN + zero is NaN");
270
271is($NaN + 1, $NaN, "NaN + one is NaN");
272
0c7df902
JH
273is($NaN * 2, $NaN, "twice NaN is NaN");
274is($NaN / 2, $NaN, "half of NaN is NaN");
8c12dc63 275
5bf8b78e
JH
276is($NaN * $NaN, $NaN, "NaN * NaN is NaN");
277is($NaN / $NaN, $NaN, "NaN / NaN is NaN");
d06c1c80 278
0c7df902
JH
279for my $f (@printf_fmt) {
280 is(sprintf("%$f", $NaN), "NaN", "$NaN sprintf %$f is NaN");
281}
d1877901 282
0c7df902
JH
283ok(!defined eval { $a = sprintf("%c", $NaN)}, "sprintf %c NaN undef");
284like($@, qr/Cannot printf/, "$NaN sprintf fails");
354b74ae
FC
285ok(!defined eval { $a = sprintf("%c", "NaN")},
286 "sprintf %c stringy NaN undef");
287like($@, qr/Cannot printf/, "stringy $NaN sprintf fails");
313d3d89 288
0c7df902
JH
289ok(!defined eval { $a = chr($NaN) }, "chr NaN undef");
290like($@, qr/Cannot chr/, "NaN chr() fails");
354b74ae
FC
291ok(!defined eval { $a = chr("NaN") }, "chr stringy NaN undef");
292like($@, qr/Cannot chr/, "stringy NaN chr() fails");
1cd88304 293
0c7df902
JH
294for my $f (@packi_fmt) {
295 ok(!defined eval { $a = pack($f, $NaN) }, "pack $f NaN undef");
296 like($@, $f eq 'w' ? qr/Cannot compress NaN/: qr/Cannot pack NaN/,
297 "NaN pack $f fails");
354b74ae
FC
298 ok(!defined eval { $a = pack($f, "NaN") },
299 "pack $f stringy NaN undef");
300 like($@, $f eq 'w' ? qr/Cannot compress NaN/: qr/Cannot pack NaN/,
301 "stringy NaN pack $f fails");
0c7df902 302}
1f4ef0f1 303
0c7df902
JH
304for my $f (@packf_fmt) {
305 ok(defined eval { $a = pack($f, $NaN) }, "pack $f NaN defined");
306 eval { $b = unpack($f, $a) };
307 cmp_ok($b, '!=', $b, "pack $f NaN not-equals $NaN");
308}
1cd88304 309
354b74ae
FC
310for my $f (@packs_fmt) {
311 ok(defined eval { $a = pack($f, $NaN) }, "pack $f NaN defined");
312 is($a, pack($f, "NaN"), "pack $f NaN same as 'NaN'");
313}
314
315is eval { unpack "p", pack 'p', $NaN }, "NaN", "pack p +NaN";
316is eval { unpack "P3", pack 'P', $NaN }, "NaN", "pack P +NaN";
317
0c7df902 318for my $i (@NaN) {
8c12dc63 319 cmp_ok($i + 0, '!=', $i + 0, "$i is NaN numerically (by not being NaN)");
313d3d89 320 is("@{[$i+0]}", "NaN", "$i value stringifies as NaN");
0c7df902 321}
313d3d89 322
0c7df902
JH
323ok(!($NaN < 0), "NaN is not lt zero");
324ok(!($NaN == 0), "NaN is not == zero");
325ok(!($NaN > 0), "NaN is not gt zero");
38e1c50b 326
0c7df902
JH
327ok(!($NaN < $NaN), "NaN is not lt NaN");
328ok(!($NaN > $NaN), "NaN is not gt NaN");
38e1c50b 329
0c7df902
JH
330# is() okay with $NaN because it uses eq.
331is($NaN * 0, $NaN, "NaN times zero is NaN");
332is($NaN * 2, $NaN, "NaN times two is NaN");
87821667 333
0c7df902
JH
334my ($NaNPP, $NaNMM) = ($NaN, $NaN);
335$NaNPP++;
336$NaNMM--;
5bf8b78e
JH
337is($NaNPP, $NaN, "+NaN++ is NaN");
338is($NaNMM, $NaN, "+NaN-- is NaN");
38e1c50b 339
0c7df902
JH
340# You might find this surprising (isn't NaN kind of like of undef?)
341# but this is how it is.
342ok($NaN, "NaN is true");
38e1c50b 343
5bf8b78e
JH
344is(abs($NaN), $NaN, "abs(NaN) is NaN");
345is(int($NaN), $NaN, "int(NaN) is NaN");
0c7df902
JH
346is(sqrt($NaN), $NaN, "sqrt(NaN) is NaN");
347is(exp($NaN), $NaN, "exp(NaN) is NaN");
5bf8b78e
JH
348
349SKIP: {
350 if ($NaN == 0) {
351 skip "if +NaN == 0 cannot log(+NaN)", 1;
352 }
353 is(log($NaN), $NaN, "log(NaN) is NaN");
354}
355
0c7df902 356is(sin($NaN), $NaN, "sin(NaN) is NaN");
5bf8b78e 357is(rand($NaN), $NaN, "rand(NaN) is NaN");
38e1c50b 358
98efe49c
JH
359TODO: {
360 local $::TODO;
0c7df902 361 my $here = "$^O $Config{osvers}";
98efe49c
JH
362 $::TODO = "$here: pow (9**9**9) doesn't give Inf"
363 if $here =~ /^(?:hpux 10|os390)/;
0c7df902 364 is(sin(9**9**9), $NaN, "sin(9**9**9) is NaN");
313d3d89
JH
365}
366
e855f543
JH
367SKIP: {
368 my @FNaN = qw(NaX XNAN Ind Inx);
369 # Silence "isn't numeric in addition", that's kind of the point.
370 local $^W = 0;
371 for my $i (@FNaN) {
372 cmp_ok("$i" + 0, '==', 0, "false nan $i");
373 }
374}
375
8d2f77d8
JH
376{
377 # Silence "Non-finite repeat count", that is tested elsewhere.
378 local $^W = 0;
379 is("a" x $NaN, "", "x NaN");
380}
381
0c7df902 382# === Tests combining Inf and NaN ===
38e1c50b 383
0c7df902
JH
384# is() okay with $NaN because it uses eq.
385is($PInf * 0, $NaN, "Inf times zero is NaN");
386is($PInf * $NaN, $NaN, "Inf times NaN is NaN");
387is($PInf + $NaN, $NaN, "Inf plus NaN is NaN");
388is($PInf - $PInf, $NaN, "Inf minus inf is NaN");
389is($PInf / $PInf, $NaN, "Inf div inf is NaN");
390is($PInf % $PInf, $NaN, "Inf mod inf is NaN");
313d3d89 391
0c7df902
JH
392ok(!($NaN < $PInf), "NaN is not lt +Inf");
393ok(!($NaN == $PInf), "NaN is not eq +Inf");
394ok(!($NaN > $PInf), "NaN is not gt +Inf");
38e1c50b 395
5bf8b78e 396ok(!($NaN < $NInf), "NaN is not lt -Inf");
0c7df902 397ok(!($NaN == $NInf), "NaN is not eq -Inf");
5bf8b78e 398ok(!($NaN > $NInf), "NaN is not gt -Inf");
38e1c50b 399
0c7df902 400is(sin($PInf), $NaN, "sin(+Inf) is NaN");
38e1c50b 401
25a8018c
JH
402{
403 eval 'for my $x (0..$NaN) { last }';
404 like($@, qr/Range iterator outside integer range/, "0..NaN fails");
405
406 eval 'for my $x ($NaN..0) { last }';
407 like($@, qr/Range iterator outside integer range/, "NaN..0 fails");
408}
409
7bb1ed39
JH
410# === Overflows and Underflows ===
411
412# 1e9999 (and 1e-9999) are large (and small) enough for even
413# IEEE quadruple precision (magnitude 10**4932, and 10**-4932).
414
415cmp_ok(1e9999, '==', $PInf, "overflow to +Inf (compile time)");
416cmp_ok('1e9999', '==', $PInf, "overflow to +Inf (runtime)");
417cmp_ok(-1e9999, '==', $NInf, "overflow to -Inf (compile time)");
418cmp_ok('-1e9999', '==', $NInf, "overflow to -Inf (runtime)");
419cmp_ok(1e-9999, '==', 0, "underflow to 0 (compile time) from pos");
420cmp_ok('1e-9999', '==', 0, "underflow to 0 (runtime) from pos");
421cmp_ok(-1e-9999, '==', 0, "underflow to 0 (compile time) from neg");
422cmp_ok('-1e-9999', '==', 0, "underflow to 0 (runtime) from neg");
423
0c7df902 424done_testing();