Document the IBM admission of weirdness of AIX long doubles.
[perl.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 + 5 + 3;
38 my $nan_tests =  8 + @num_fmt + 4 + 2 * @NaN + 3;
39
40 my $infnan_tests = 4;
41
42 plan tests => $inf_tests + $nan_tests + $infnan_tests;
43
44 my $has_inf;
45 my $has_nan;
46
47 SKIP: {
48   if ($PInf == 1 && $NInf == 1) {
49     skip $inf_tests, "no infinity found";
50   }
51
52   $has_inf = 1;
53
54   cmp_ok($PInf, '>', 0, "positive infinity");
55   cmp_ok($NInf, '<', 0, "negative infinity");
56
57   cmp_ok($PInf, '>', $NInf, "positive > negative");
58   cmp_ok($NInf, '==', -$PInf, "negative == -positive");
59   cmp_ok(-$NInf, '==', $PInf, "--negative == positive");
60
61   is($PInf,  "Inf", "$PInf value stringifies as Inf");
62   is($NInf, "-Inf", "$NInf value stringifies as -Inf");
63
64   cmp_ok($PInf * 2, '==', $PInf, "twice Inf is Inf");
65   cmp_ok($PInf / 2, '==', $PInf, "half of Inf is Inf");
66
67   cmp_ok($PInf + 1, '==', $PInf, "Inf + one is Inf");
68   cmp_ok($NInf + 1, '==', $NInf, "-Inf + one is -Inf");
69
70   is(sprintf("%g", $PInf), "Inf", "$PInf sprintf %g is Inf");
71   is(sprintf("%a", $PInf), "Inf", "$PInf sprintf %a is Inf");
72
73   for my $f (@num_fmt) {
74       is(sprintf("%$f", $PInf), "Inf", "$PInf sprintf %$f is Inf");
75   }
76
77   {
78       local $^W = 0;
79
80       is(sprintf("%c", $PInf), chr(0xFFFD), "$PInf sprintf %c is Inf");
81       is(chr($PInf), chr(0xFFFD), "$PInf chr() is U+FFFD");
82
83       is(sprintf("%c", $NInf), chr(0xFFFD), "$NInf sprintf %c is Inf");
84       is(chr($NInf), chr(0xFFFD), "$NInf chr() is U+FFFD");
85
86       is(pack('C', $PInf), chr(0xFF), "$PInf pack C is 0xFF byte");
87       is(pack('c', $PInf), chr(0xFF), "$PInf pack c is 0xFF byte");
88
89       is(pack('C', $NInf), chr(0xFF), "$NInf pack C is 0xFF byte");
90       is(pack('c', $NInf), chr(0xFF), "$NInf pack c is 0xFF byte");
91   }
92
93   for my $i (@PInf) {
94     cmp_ok($i + 0 , '==', $PInf, "$i is +Inf");
95     cmp_ok($i, '>', 0, "$i is positive");
96     is("@{[$i+0]}", "Inf", "$i value stringifies as Inf");
97   }
98
99   for my $i (@NInf) {
100     cmp_ok($i + 0, '==', $NInf, "$i is -Inf");
101     cmp_ok($i, '<', 0, "$i is negative");
102     is("@{[$i+0]}", "-Inf", "$i value stringifies as -Inf");
103   }
104
105   is($PInf + $PInf, $PInf, "+inf plus +inf is +inf");
106   is($NInf + $NInf, $NInf, "-inf plus -inf is -inf");
107
108   is(1/$PInf, 0, "one per +Inf is zero");
109   is(1/$NInf, 0, "one per -Inf is zero");
110
111  SKIP: {
112      my $here = "$^O $Config{osvers}";
113      if ($here =~ /^hpux 10/) {
114          skip "$here: pow doesn't generate Inf", 1;
115      }
116      is(9**9**9, $PInf, "9**9**9 is Inf");
117   }
118 }
119
120 {
121     # Silence "isn't numeric in addition", that's kind of the point.
122     local $^W = 0;
123     for my $i (qw(Info Infiniti Infinityz)) {
124         cmp_ok("$i" + 0, '==', 0, "false infinity $i");
125     }
126 }
127
128 SKIP: {
129   if ($NaN == 1) {
130     skip $nan_tests, "no nan found";
131   }
132
133   $has_nan = 1;
134
135   cmp_ok($NaN, '!=', $NaN, "NaN is NaN numerically (by not being NaN)");
136   ok($NaN eq $NaN, "NaN is NaN stringifically");
137
138   is("$NaN", "NaN", "$NaN value stringifies as NaN");
139
140   is("+NaN" + 0, "NaN", "+NaN is NaN");
141   is("-NaN" + 0, "NaN", "-NaN is NaN");
142
143   is($NaN * 2, $NaN, "twice NaN is NaN");
144   is($NaN / 2, $NaN, "half of NaN is NaN");
145
146   is($NaN + 1, $NaN, "NaN + one is NaN");
147
148   for my $f (@num_fmt) {
149       is(sprintf("%$f", $NaN), "NaN", "$NaN sprintf %$f is NaN");
150   }
151
152   {
153       local $^W = 0;
154
155       is(sprintf("%c", $NaN), chr(0xFFFD), "$NaN sprintf %c is Inf");
156       is(chr($NaN), chr(0xFFFD), "$NaN chr() is U+FFFD");
157
158       is(pack('C', $NaN), chr(0xFF), "$NaN pack C is 0xFF byte");
159       is(pack('c', $NaN), chr(0xFF), "$NaN pack c is 0xFF");
160   }
161
162   for my $i (@NaN) {
163     cmp_ok($i + 0, '!=', $i + 0, "$i is NaN numerically (by not being NaN)");
164     is("@{[$i+0]}", "NaN", "$i value stringifies as NaN");
165   }
166
167   # is() okay with $NaN because it uses eq.
168   is($NaN * 0, $NaN, "NaN times zero is NaN");
169   is($NaN * 2, $NaN, "NaN times two is NaN");
170
171  SKIP: {
172      my $here = "$^O $Config{osvers}";
173      if ($here =~ /^hpux 10/) {
174          skip "$here: pow doesn't generate Inf, so sin(Inf) won't happen", 1;
175      }
176      is(sin(9**9**9), $NaN, "sin(9**9**9) is NaN");
177   }
178 }
179
180 SKIP: {
181   unless ($has_inf && $has_nan) {
182     skip $infnan_tests, "no both Inf and Nan";
183   }
184
185   # is() okay with $NaN because it uses eq.
186   is($PInf * 0,     $NaN, "Inf times zero is NaN");
187   is($PInf * $NaN,  $NaN, "Inf times NaN is NaN");
188   is($PInf + $NaN,  $NaN, "Inf plus NaN is NaN");
189   is($PInf - $PInf, $NaN, "Inf minus inf is NaN");
190 }