This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
8cb177d9e0c18cf5e3917a273458a0a56ae9c24b
[perl5.git] / t / op / infnan.t
1 #!./perl -w
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6     require './test.pl';
7 }
8
9 use strict;
10
11 use Config;
12
13 BEGIN {
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
21 my $PInf = "Inf"  + 0;
22 my $NInf = "-Inf" + 0;
23 my $NaN  = "NaN"  + 0;
24
25 my @PInf = ("Inf", "inf", "INF", "+Inf",
26             "Infinity", "INFINITE",
27             "1.#INF", "1#INF");
28 my @NInf = map { "-$_" } grep { ! /^\+/ } @PInf;
29
30 my @NaN = ("NAN", "nan", "qnan", "SNAN", "NanQ", "NANS",
31            "1.#QNAN", "+1#SNAN", "-1.#NAN", "1#IND",
32            "NaN123", "NAN(123)", "nan%",
33            "nanonano"); # RIP, Robin Williams.
34
35 my @num_fmt = qw(e f g a d u o b x p);
36
37 my $inf_tests = 13 + @num_fmt + 8 + 3 * @PInf + 3 * @NInf + 14 + 3;
38 my $nan_tests =  8 + @num_fmt + 4 + 2 * @NaN + 14;
39
40 my $infnan_tests = 13;
41
42 plan tests => $inf_tests + 1 + $nan_tests + 1 + $infnan_tests + 1;
43
44 print "# inf_tests    = $inf_tests\n";
45 print "# nan_tests    = $nan_tests\n";
46 print "# infnan_tests = $infnan_tests\n";
47
48 my $has_inf;
49 my $has_nan;
50
51 SKIP: {
52   if ($PInf == 0 && $NInf == 0) {
53     skip $inf_tests, "no infinity found";
54   }
55
56   $has_inf = 1;
57
58   cmp_ok($PInf, '>', 0, "positive infinity");
59   cmp_ok($NInf, '<', 0, "negative infinity");
60
61   cmp_ok($PInf, '>', $NInf, "positive > negative");
62   cmp_ok($NInf, '==', -$PInf, "negative == -positive");
63   cmp_ok(-$NInf, '==', $PInf, "--negative == positive");
64
65   is($PInf,  "Inf", "$PInf value stringifies as Inf");
66   is($NInf, "-Inf", "$NInf value stringifies as -Inf");
67
68   cmp_ok($PInf * 2, '==', $PInf, "twice Inf is Inf");
69   cmp_ok($PInf / 2, '==', $PInf, "half of Inf is Inf");
70
71   cmp_ok($PInf + 1, '==', $PInf, "Inf + one is Inf");
72   cmp_ok($NInf + 1, '==', $NInf, "-Inf + one is -Inf");
73
74   is(sprintf("%g", $PInf), "Inf", "$PInf sprintf %g is Inf");
75   is(sprintf("%a", $PInf), "Inf", "$PInf sprintf %a is Inf");
76
77   for my $f (@num_fmt) {
78       is(sprintf("%$f", $PInf), "Inf", "$PInf sprintf %$f is Inf");
79   }
80
81   {
82       local $^W = 0;
83
84       is(sprintf("%c", $PInf), chr(0xFFFD), "$PInf sprintf %c is Inf");
85       is(chr($PInf), chr(0xFFFD), "$PInf chr() is U+FFFD");
86
87       is(sprintf("%c", $NInf), chr(0xFFFD), "$NInf sprintf %c is Inf");
88       is(chr($NInf), chr(0xFFFD), "$NInf chr() is U+FFFD");
89
90       is(pack('C', $PInf), chr(0xFF), "$PInf pack C is 0xFF byte");
91       is(pack('c', $PInf), chr(0xFF), "$PInf pack c is 0xFF byte");
92
93       is(pack('C', $NInf), chr(0xFF), "$NInf pack C is 0xFF byte");
94       is(pack('c', $NInf), chr(0xFF), "$NInf pack c is 0xFF byte");
95   }
96
97   for my $i (@PInf) {
98     cmp_ok($i + 0 , '==', $PInf, "$i is +Inf");
99     cmp_ok($i, '>', 0, "$i is positive");
100     is("@{[$i+0]}", "Inf", "$i value stringifies as Inf");
101   }
102
103   for my $i (@NInf) {
104     cmp_ok($i + 0, '==', $NInf, "$i is -Inf");
105     cmp_ok($i, '<', 0, "$i is negative");
106     is("@{[$i+0]}", "-Inf", "$i value stringifies as -Inf");
107   }
108
109   is($PInf + $PInf, $PInf, "+inf plus +inf is +inf");
110   is($NInf + $NInf, $NInf, "-inf plus -inf is -inf");
111
112   is(1/$PInf, 0, "one per +Inf is zero");
113   is(1/$NInf, 0, "one per -Inf is zero");
114
115   my ($PInfPP, $PInfMM) = ($PInf, $PInf);
116   my ($NInfPP, $NInfMM) = ($NInf, $NInf);;
117   $PInfPP++;
118   $PInfMM--;
119   $NInfPP++;
120   $NInfMM--;
121   is($PInfPP, $PInf, "+inf++ is +inf");
122   is($PInfMM, $PInf, "+inf-- is +inf");
123   is($NInfPP, $NInf, "-inf++ is -inf");
124   is($NInfMM, $NInf, "-inf-- is -inf");
125
126   ok($PInf, "+inf is true");
127   ok($NInf, "-inf is true");
128
129   is(sqrt($PInf), $PInf, "sqrt(+inf) is +inf");
130   is(exp($PInf), $PInf, "exp(+inf) is +inf");
131   is(exp($NInf), 0, "exp(-inf) is zero");
132
133  SKIP: {
134      my $here = "$^O $Config{osvers}";
135      if ($here =~ /^hpux 10/) {
136          skip "$here: pow doesn't generate Inf", 1;
137      }
138      is(9**9**9, $PInf, "9**9**9 is Inf");
139   }
140 }
141
142 SKIP: {
143     my @FInf = qw(Info Infiniti Infinityz);
144     if ($Config{usequadmath}) {
145         skip "quadmath strtoflt128() accepts false infinities", scalar @FInf;
146     }
147     # Silence "isn't numeric in addition", that's kind of the point.
148     local $^W = 0;
149     for my $i (@FInf) {
150         cmp_ok("$i" + 0, '==', 0, "false infinity $i");
151     }
152 }
153
154 is(curr_test() - 1, $inf_tests, "expected number of inf tests");
155
156 SKIP: {
157   if ($NaN == 0) {
158     skip $nan_tests, "no nan found";
159   }
160
161   $has_nan = 1;
162
163   cmp_ok($NaN, '!=', $NaN, "NaN is NaN numerically (by not being NaN)");
164   ok($NaN eq $NaN, "NaN is NaN stringifically");
165
166   is("$NaN", "NaN", "$NaN value stringifies as NaN");
167
168   is("+NaN" + 0, "NaN", "+NaN is NaN");
169   is("-NaN" + 0, "NaN", "-NaN is NaN");
170
171   is($NaN * 2, $NaN, "twice NaN is NaN");
172   is($NaN / 2, $NaN, "half of NaN is NaN");
173
174   is($NaN + 1, $NaN, "NaN + one is NaN");
175
176   for my $f (@num_fmt) {
177       is(sprintf("%$f", $NaN), "NaN", "$NaN sprintf %$f is NaN");
178   }
179
180   {
181       local $^W = 0;
182
183       is(sprintf("%c", $NaN), chr(0xFFFD), "$NaN sprintf %c is Inf");
184       is(chr($NaN), chr(0xFFFD), "$NaN chr() is U+FFFD");
185
186       is(pack('C', $NaN), chr(0xFF), "$NaN pack C is 0xFF byte");
187       is(pack('c', $NaN), chr(0xFF), "$NaN pack c is 0xFF");
188   }
189
190   for my $i (@NaN) {
191     cmp_ok($i + 0, '!=', $i + 0, "$i is NaN numerically (by not being NaN)");
192     is("@{[$i+0]}", "NaN", "$i value stringifies as NaN");
193   }
194
195   ok(!($NaN <  0), "NaN is not lt zero");
196   ok(!($NaN == 0), "NaN is not == zero");
197   ok(!($NaN >  0), "NaN is not gt zero");
198
199   ok(!($NaN < $NaN), "NaN is not lt NaN");
200   ok(!($NaN > $NaN), "NaN is not gt NaN");
201
202   # is() okay with $NaN because it uses eq.
203   is($NaN * 0, $NaN, "NaN times zero is NaN");
204   is($NaN * 2, $NaN, "NaN times two is NaN");
205
206   my ($NaNPP, $NaNMM) = ($NaN, $NaN);
207   $NaNPP++;
208   $NaNMM--;
209   is($NaNPP, $NaN, "+inf++ is +inf");
210   is($NaNMM, $NaN, "+inf-- is +inf");
211
212   ok($NaN, "NaN is true");
213
214   is(sqrt($NaN), $NaN, "sqrt(nan) is nan");
215   is(exp($NaN), $NaN, "exp(nan) is nan");
216   is(sin($NaN), $NaN, "sin(nan) is nan");
217
218  SKIP: {
219      my $here = "$^O $Config{osvers}";
220      if ($here =~ /^hpux 10/) {
221          skip "$here: pow doesn't generate Inf, so sin(Inf) won't happen", 1;
222      }
223      is(sin(9**9**9), $NaN, "sin(9**9**9) is NaN");
224   }
225 }
226
227 is(curr_test() - 1, $inf_tests + 1 + $nan_tests,
228    "expected number of nan tests");
229
230 SKIP: {
231   unless ($has_inf && $has_nan) {
232     skip $infnan_tests, "no both Inf and Nan";
233   }
234
235   # is() okay with $NaN because it uses eq.
236   is($PInf * 0,     $NaN, "Inf times zero is NaN");
237   is($PInf * $NaN,  $NaN, "Inf times NaN is NaN");
238   is($PInf + $NaN,  $NaN, "Inf plus NaN is NaN");
239   is($PInf - $PInf, $NaN, "Inf minus inf is NaN");
240   is($PInf / $PInf, $NaN, "Inf div inf is NaN");
241   is($PInf % $PInf, $NaN, "Inf mod inf is NaN");
242
243   ok(!($NaN <  $PInf), "NaN is not lt +inf");
244   ok(!($NaN == $PInf), "NaN is not eq +inf");
245   ok(!($NaN >  $PInf), "NaN is not gt +inf");
246
247   ok(!($NaN >  $NInf), "NaN is not lt -inf");
248   ok(!($NaN == $NInf), "NaN is not eq -inf");
249   ok(!($NaN <  $NInf), "NaN is not gt -inf");
250
251   is(sin($PInf), $NaN, "sin(+inf) is nan");
252 }
253
254 is(curr_test() - 1, $inf_tests + 1 + $nan_tests + 1 + $infnan_tests,
255    "expected number of nan tests");