This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make pack-as-int/sprintf-%c-ing/chr-ring inf/nan fatal.
[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
JH
35my @printf_fmt = qw(e f g a d u o i b x p);
36my @packi_fmt = qw(a A Z b B h H c C s S l L i I n N v V j J w W p P u U);
37my @packf_fmt = qw(f d F);
540a63d6 38
0c7df902
JH
39if ($Config{ivsize} == 8) {
40 push @packi_fmt, qw(q Q);
41}
38e1c50b 42
0c7df902
JH
43if ($Config{uselongdouble}) {
44 push @packf_fmt, 'D';
45}
313d3d89 46
0c7df902 47# === Inf tests ===
313d3d89 48
0c7df902
JH
49cmp_ok($PInf, '>', 0, "positive infinity");
50cmp_ok($NInf, '<', 0, "negative infinity");
313d3d89 51
0c7df902
JH
52cmp_ok($PInf, '>', $NInf, "positive > negative");
53cmp_ok($NInf, '==', -$PInf, "negative == -positive");
54cmp_ok(-$NInf, '==', $PInf, "--negative == positive");
313d3d89 55
0c7df902
JH
56is($PInf, "Inf", "$PInf value stringifies as Inf");
57is($NInf, "-Inf", "$NInf value stringifies as -Inf");
8c12dc63 58
0c7df902
JH
59cmp_ok($PInf * 2, '==', $PInf, "twice Inf is Inf");
60cmp_ok($PInf / 2, '==', $PInf, "half of Inf is Inf");
313d3d89 61
0c7df902
JH
62cmp_ok($PInf + 1, '==', $PInf, "Inf + one is Inf");
63cmp_ok($NInf + 1, '==', $NInf, "-Inf + one is -Inf");
313d3d89 64
0c7df902
JH
65is(sprintf("%g", $PInf), "Inf", "$PInf sprintf %g is Inf");
66is(sprintf("%a", $PInf), "Inf", "$PInf sprintf %a is Inf");
d06c1c80 67
0c7df902
JH
68for my $f (@printf_fmt) {
69 is(sprintf("%$f", $PInf), "Inf", "$PInf sprintf %$f is Inf");
70}
d1877901 71
0c7df902
JH
72ok(!defined eval { $a = sprintf("%c", $PInf)}, "sprintf %c +Inf undef");
73like($@, qr/Cannot printf/, "$PInf sprintf fails");
313d3d89 74
0c7df902
JH
75ok(!defined eval { $a = chr($PInf) }, "chr(+Inf) undef");
76like($@, qr/Cannot chr/, "+Inf chr() fails");
540a63d6 77
0c7df902
JH
78ok(!defined eval { $a = sprintf("%c", $NInf)}, "sprintf %c -Inf undef");
79like($@, qr/Cannot printf/, "$NInf sprintf fails");
1cd88304 80
0c7df902
JH
81ok(!defined eval { $a = chr($NInf) }, "chr(-Inf) undef");
82like($@, qr/Cannot chr/, "-Inf chr() fails");
1cd88304 83
0c7df902
JH
84for my $f (@packi_fmt) {
85 ok(!defined eval { $a = pack($f, $PInf) }, "pack $f +Inf undef");
86 like($@, $f eq 'w' ? qr/Cannot compress Inf/: qr/Cannot pack Inf/,
87 "+Inf pack $f fails");
88 ok(!defined eval { $a = pack($f, $NInf) }, "pack $f -Inf undef");
89 like($@, $f eq 'w' ? qr/Cannot compress -Inf/: qr/Cannot pack -Inf/,
90 "-Inf pack $f fails");
91}
1f4ef0f1 92
0c7df902
JH
93for my $f (@packf_fmt) {
94 ok(defined eval { $a = pack($f, $PInf) }, "pack $f +Inf defined");
95 eval { $b = unpack($f, $a) };
96 cmp_ok($b, '==', $PInf, "pack $f +Inf equals $PInf");
1f4ef0f1 97
0c7df902
JH
98 ok(defined eval { $a = pack($f, $NInf) }, "pack $f -Inf defined");
99 eval { $b = unpack($f, $a) };
100 cmp_ok($b, '==', $NInf, "pack $f -Inf equals $NInf");
101}
1cd88304 102
0c7df902 103for my $i (@PInf) {
8c12dc63
JH
104 cmp_ok($i + 0 , '==', $PInf, "$i is +Inf");
105 cmp_ok($i, '>', 0, "$i is positive");
313d3d89 106 is("@{[$i+0]}", "Inf", "$i value stringifies as Inf");
0c7df902 107}
313d3d89 108
0c7df902 109for my $i (@NInf) {
8c12dc63
JH
110 cmp_ok($i + 0, '==', $NInf, "$i is -Inf");
111 cmp_ok($i, '<', 0, "$i is negative");
313d3d89 112 is("@{[$i+0]}", "-Inf", "$i value stringifies as -Inf");
0c7df902 113}
313d3d89 114
0c7df902
JH
115is($PInf + $PInf, $PInf, "+Inf plus +Inf is +Inf");
116is($NInf + $NInf, $NInf, "-Inf plus -Inf is -Inf");
313d3d89 117
0c7df902
JH
118is(1/$PInf, 0, "one per +Inf is zero");
119is(1/$NInf, 0, "one per -Inf is zero");
87821667 120
0c7df902
JH
121my ($PInfPP, $PInfMM) = ($PInf, $PInf);
122my ($NInfPP, $NInfMM) = ($NInf, $NInf);;
123$PInfPP++;
124$PInfMM--;
125$NInfPP++;
126$NInfMM--;
127is($PInfPP, $PInf, "+Inf++ is +Inf");
128is($PInfMM, $PInf, "+Inf-- is +Inf");
129is($NInfPP, $NInf, "-Inf++ is -Inf");
130is($NInfMM, $NInf, "-Inf-- is -Inf");
38e1c50b 131
0c7df902
JH
132ok($PInf, "+Inf is true");
133ok($NInf, "-Inf is true");
38e1c50b 134
0c7df902
JH
135is(sqrt($PInf), $PInf, "sqrt(+Inf) is +Inf");
136is(exp($PInf), $PInf, "exp(+Inf) is +Inf");
137is(exp($NInf), 0, "exp(-Inf) is zero");
38e1c50b 138
0c7df902
JH
139SKIP: {
140 my $here = "$^O $Config{osvers}";
141 if ($here =~ /^hpux 10/) {
142 skip "$here: pow doesn't generate Inf", 1;
143 }
144 is(9**9**9, $PInf, "9**9**9 is Inf");
313d3d89
JH
145}
146
3ff98fcf
JH
147SKIP: {
148 my @FInf = qw(Info Infiniti Infinityz);
149 if ($Config{usequadmath}) {
150 skip "quadmath strtoflt128() accepts false infinities", scalar @FInf;
151 }
0ec38c0a
JH
152 # Silence "isn't numeric in addition", that's kind of the point.
153 local $^W = 0;
3ff98fcf 154 for my $i (@FInf) {
0ec38c0a
JH
155 cmp_ok("$i" + 0, '==', 0, "false infinity $i");
156 }
157}
158
0c7df902 159# === NaN ===
38e1c50b 160
0c7df902
JH
161cmp_ok($NaN, '!=', $NaN, "NaN is NaN numerically (by not being NaN)");
162ok($NaN eq $NaN, "NaN is NaN stringifically");
313d3d89 163
0c7df902 164is("$NaN", "NaN", "$NaN value stringifies as NaN");
313d3d89 165
0c7df902
JH
166is("+NaN" + 0, "NaN", "+NaN is NaN");
167is("-NaN" + 0, "NaN", "-NaN is NaN");
313d3d89 168
0c7df902
JH
169is($NaN * 2, $NaN, "twice NaN is NaN");
170is($NaN / 2, $NaN, "half of NaN is NaN");
8c12dc63 171
0c7df902 172is($NaN + 1, $NaN, "NaN + one is NaN");
d06c1c80 173
0c7df902
JH
174for my $f (@printf_fmt) {
175 is(sprintf("%$f", $NaN), "NaN", "$NaN sprintf %$f is NaN");
176}
d1877901 177
0c7df902
JH
178ok(!defined eval { $a = sprintf("%c", $NaN)}, "sprintf %c NaN undef");
179like($@, qr/Cannot printf/, "$NaN sprintf fails");
313d3d89 180
0c7df902
JH
181ok(!defined eval { $a = chr($NaN) }, "chr NaN undef");
182like($@, qr/Cannot chr/, "NaN chr() fails");
1cd88304 183
0c7df902
JH
184for my $f (@packi_fmt) {
185 ok(!defined eval { $a = pack($f, $NaN) }, "pack $f NaN undef");
186 like($@, $f eq 'w' ? qr/Cannot compress NaN/: qr/Cannot pack NaN/,
187 "NaN pack $f fails");
188}
1f4ef0f1 189
0c7df902
JH
190for my $f (@packf_fmt) {
191 ok(defined eval { $a = pack($f, $NaN) }, "pack $f NaN defined");
192 eval { $b = unpack($f, $a) };
193 cmp_ok($b, '!=', $b, "pack $f NaN not-equals $NaN");
194}
1cd88304 195
0c7df902 196for my $i (@NaN) {
8c12dc63 197 cmp_ok($i + 0, '!=', $i + 0, "$i is NaN numerically (by not being NaN)");
313d3d89 198 is("@{[$i+0]}", "NaN", "$i value stringifies as NaN");
0c7df902 199}
313d3d89 200
0c7df902
JH
201ok(!($NaN < 0), "NaN is not lt zero");
202ok(!($NaN == 0), "NaN is not == zero");
203ok(!($NaN > 0), "NaN is not gt zero");
38e1c50b 204
0c7df902
JH
205ok(!($NaN < $NaN), "NaN is not lt NaN");
206ok(!($NaN > $NaN), "NaN is not gt NaN");
38e1c50b 207
0c7df902
JH
208# is() okay with $NaN because it uses eq.
209is($NaN * 0, $NaN, "NaN times zero is NaN");
210is($NaN * 2, $NaN, "NaN times two is NaN");
87821667 211
0c7df902
JH
212my ($NaNPP, $NaNMM) = ($NaN, $NaN);
213$NaNPP++;
214$NaNMM--;
215is($NaNPP, $NaN, "+Inf++ is +Inf");
216is($NaNMM, $NaN, "+Inf-- is +Inf");
38e1c50b 217
0c7df902
JH
218# You might find this surprising (isn't NaN kind of like of undef?)
219# but this is how it is.
220ok($NaN, "NaN is true");
38e1c50b 221
0c7df902
JH
222is(sqrt($NaN), $NaN, "sqrt(NaN) is NaN");
223is(exp($NaN), $NaN, "exp(NaN) is NaN");
224is(sin($NaN), $NaN, "sin(NaN) is NaN");
38e1c50b 225
0c7df902
JH
226SKIP: {
227 my $here = "$^O $Config{osvers}";
228 if ($here =~ /^hpux 10/) {
229 skip "$here: pow doesn't generate Inf, so sin(Inf) won't happen", 1;
230 }
231 is(sin(9**9**9), $NaN, "sin(9**9**9) is NaN");
313d3d89
JH
232}
233
0c7df902 234# === Tests combining Inf and NaN ===
38e1c50b 235
0c7df902
JH
236# is() okay with $NaN because it uses eq.
237is($PInf * 0, $NaN, "Inf times zero is NaN");
238is($PInf * $NaN, $NaN, "Inf times NaN is NaN");
239is($PInf + $NaN, $NaN, "Inf plus NaN is NaN");
240is($PInf - $PInf, $NaN, "Inf minus inf is NaN");
241is($PInf / $PInf, $NaN, "Inf div inf is NaN");
242is($PInf % $PInf, $NaN, "Inf mod inf is NaN");
313d3d89 243
0c7df902
JH
244ok(!($NaN < $PInf), "NaN is not lt +Inf");
245ok(!($NaN == $PInf), "NaN is not eq +Inf");
246ok(!($NaN > $PInf), "NaN is not gt +Inf");
38e1c50b 247
0c7df902
JH
248ok(!($NaN > $NInf), "NaN is not lt -Inf");
249ok(!($NaN == $NInf), "NaN is not eq -Inf");
250ok(!($NaN < $NInf), "NaN is not gt -Inf");
38e1c50b 251
0c7df902 252is(sin($PInf), $NaN, "sin(+Inf) is NaN");
38e1c50b 253
0c7df902 254done_testing();