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 @printf_fmt = qw(e f g a d u o i b x p);
  36 my @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);
  37 my @packf_fmt = qw(f d F);
  38
  39 if ($Config{ivsize} == 8) {
  40     push @packi_fmt, qw(q Q);
  41 }
  42
  43 if ($Config{uselongdouble}) {
  44     push @packf_fmt, 'D';
  45 }
  46
  47 # === Inf tests ===
  48
  49 cmp_ok($PInf, '>', 0, "positive infinity");
  50 cmp_ok($NInf, '<', 0, "negative infinity");
  51
  52 cmp_ok($PInf, '>', $NInf, "positive > negative");
  53 cmp_ok($NInf, '==', -$PInf, "negative == -positive");
  54 cmp_ok(-$NInf, '==', $PInf, "--negative == positive");
  55
  56 is($PInf,  "Inf", "$PInf value stringifies as Inf");
  57 is($NInf, "-Inf", "$NInf value stringifies as -Inf");
  58
  59 cmp_ok($PInf + 0, '==', $PInf, "+Inf + zero is +Inf");
  60 cmp_ok($NInf + 0, '==', $NInf, "-Inf + zero is -Inf");
  61
  62 cmp_ok($PInf + 1, '==', $PInf, "+Inf + one is +Inf");
  63 cmp_ok($NInf + 1, '==', $NInf, "-Inf + one is -Inf");
  64
  65 cmp_ok($PInf + $PInf, '==', $PInf, "+Inf + Inf is +Inf");
  66 cmp_ok($NInf + $NInf, '==', $NInf, "-Inf - Inf is -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 * $PInf, '==', $PInf, "-Inf * +Inf is +Inf");
  72 cmp_ok($NInf * $NInf, '==', $PInf, "-Inf * -Inf 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 (@printf_fmt) {
  78     is(sprintf("%$f", $PInf), "Inf", "$PInf sprintf %$f is Inf");
  79 }
  80
  81 ok(!defined eval { $a = sprintf("%c", $PInf)}, "sprintf %c +Inf undef");
  82 like($@, qr/Cannot printf/, "$PInf sprintf fails");
  83
  84 ok(!defined eval { $a = chr($PInf) }, "chr(+Inf) undef");
  85 like($@, qr/Cannot chr/, "+Inf chr() fails");
  86
  87 ok(!defined eval { $a = sprintf("%c", $NInf)}, "sprintf %c -Inf undef");
  88 like($@, qr/Cannot printf/, "$NInf sprintf fails");
  89
  90 ok(!defined eval { $a = chr($NInf) }, "chr(-Inf) undef");
  91 like($@, qr/Cannot chr/, "-Inf chr() fails");
  92
  93 for my $f (@packi_fmt) {
  94     ok(!defined eval { $a = pack($f, $PInf) }, "pack $f +Inf undef");
  95     like($@, $f eq 'w' ? qr/Cannot compress Inf/: qr/Cannot pack Inf/,
  96          "+Inf pack $f fails");
  97     ok(!defined eval { $a = pack($f, $NInf) }, "pack $f -Inf undef");
  98     like($@, $f eq 'w' ? qr/Cannot compress -Inf/: qr/Cannot pack -Inf/,
  99          "-Inf pack $f fails");
 100 }
 101
 102 for my $f (@packf_fmt) {
 103     ok(defined eval { $a = pack($f, $PInf) }, "pack $f +Inf defined");
 104     eval { $b = unpack($f, $a) };
 105     cmp_ok($b, '==', $PInf, "pack $f +Inf equals $PInf");
 106
 107     ok(defined eval { $a = pack($f, $NInf) }, "pack $f -Inf defined");
 108     eval { $b = unpack($f, $a) };
 109     cmp_ok($b, '==', $NInf, "pack $f -Inf equals $NInf");
 110 }
 111
 112 for my $i (@PInf) {
 113     cmp_ok($i + 0 , '==', $PInf, "$i is +Inf");
 114     cmp_ok($i, '>', 0, "$i is positive");
 115     is("@{[$i+0]}", "Inf", "$i value stringifies as Inf");
 116 }
 117
 118 for my $i (@NInf) {
 119     cmp_ok($i + 0, '==', $NInf, "$i is -Inf");
 120     cmp_ok($i, '<', 0, "$i is negative");
 121     is("@{[$i+0]}", "-Inf", "$i value stringifies as -Inf");
 122 }
 123
 124 is($PInf + $PInf, $PInf, "+Inf plus +Inf is +Inf");
 125 is($NInf + $NInf, $NInf, "-Inf plus -Inf is -Inf");
 126
 127 is(1/$PInf, 0, "one per +Inf is zero");
 128 is(1/$NInf, 0, "one per -Inf is zero");
 129
 130 my ($PInfPP, $PInfMM) = ($PInf, $PInf);
 131 my ($NInfPP, $NInfMM) = ($NInf, $NInf);;
 132 $PInfPP++;
 133 $PInfMM--;
 134 $NInfPP++;
 135 $NInfMM--;
 136 is($PInfPP, $PInf, "+Inf++ is +Inf");
 137 is($PInfMM, $PInf, "+Inf-- is +Inf");
 138 is($NInfPP, $NInf, "-Inf++ is -Inf");
 139 is($NInfMM, $NInf, "-Inf-- is -Inf");
 140
 141 ok($PInf, "+Inf is true");
 142 ok($NInf, "-Inf is true");
 143
 144 is(abs($PInf), $PInf, "abs(+Inf) is +Inf");
 145 is(abs($NInf), $PInf, "abs(-Inf) is +Inf");
 146
 147 # One could argue of NaN as the result.
 148 is(int($PInf), $PInf, "int(+Inf) is +Inf");
 149 is(int($NInf), $NInf, "int(-Inf) is -Inf");
 150
 151 is(sqrt($PInf), $PInf, "sqrt(+Inf) is +Inf");
 152 # sqrt $NInf doesn't work because negative is caught
 153
 154 is(exp($PInf), $PInf, "exp(+Inf) is +Inf");
 155 is(exp($NInf), 0, "exp(-Inf) is zero");
 156
 157 SKIP: {
 158     if ($PInf == 0) {
 159         skip "if +Inf == 0 cannot log(+Inf)", 1;
 160     }
 161     is(log($PInf), $PInf, "log(+Inf) is +Inf");
 162 }
 163 # log $NInf doesn't work because negative is caught
 164
 165 is(rand($PInf), $PInf, "rand(+Inf) is +Inf");
 166 is(rand($NInf), $NInf, "rand(-Inf) is -Inf");
 167
 168 # XXX Bit operations?
 169 # +Inf & 1 == +Inf?
 170 # +Inf | 1 == +Inf?
 171 # +Inf ^ 1 == +Inf?
 172 # ~+Inf    == 0? or NaN?
 173 # -Inf ... ???
 174 # NaN & 1 == NaN?
 175 # NaN | 1 == NaN?
 176 # NaN ^ 1 == NaN?
 177 # ~NaN    == NaN???
 178 # Or just declare insanity and die?
 179
 180 SKIP: {
 181     my $here = "$^O $Config{osvers}";
 182     if ($here =~ /^hpux 10/) {
 183         skip "$here: pow doesn't generate Inf", 1;
 184     }
 185     is(9**9**9, $PInf, "9**9**9 is Inf");
 186 }
 187
 188 SKIP: {
 189     my @FInf = qw(Info Infiniti Infinityz);
 190     if ($Config{usequadmath}) {
 191         skip "quadmath strtoflt128() accepts false infinities", scalar @FInf;
 192     }
 193     # Silence "isn't numeric in addition", that's kind of the point.
 194     local $^W = 0;
 195     for my $i (@FInf) {
 196         cmp_ok("$i" + 0, '==', 0, "false infinity $i");
 197     }
 198 }
 199
 200 # === NaN ===
 201
 202 cmp_ok($NaN, '!=', $NaN, "NaN is NaN numerically (by not being NaN)");
 203 ok($NaN eq $NaN, "NaN is NaN stringifically");
 204
 205 is("$NaN", "NaN", "$NaN value stringifies as NaN");
 206
 207 is("+NaN" + 0, "NaN", "+NaN is NaN");
 208 is("-NaN" + 0, "NaN", "-NaN is NaN");
 209
 210 is($NaN + 0, $NaN, "NaN + zero is NaN");
 211
 212 is($NaN + 1, $NaN, "NaN + one is NaN");
 213
 214 is($NaN * 2, $NaN, "twice NaN is NaN");
 215 is($NaN / 2, $NaN, "half of NaN is NaN");
 216
 217 is($NaN * $NaN, $NaN, "NaN * NaN is NaN");
 218 is($NaN / $NaN, $NaN, "NaN / NaN is NaN");
 219
 220 for my $f (@printf_fmt) {
 221     is(sprintf("%$f", $NaN), "NaN", "$NaN sprintf %$f is NaN");
 222 }
 223
 224 ok(!defined eval { $a = sprintf("%c", $NaN)}, "sprintf %c NaN undef");
 225 like($@, qr/Cannot printf/, "$NaN sprintf fails");
 226
 227 ok(!defined eval { $a = chr($NaN) }, "chr NaN undef");
 228 like($@, qr/Cannot chr/, "NaN chr() fails");
 229
 230 for my $f (@packi_fmt) {
 231     ok(!defined eval { $a = pack($f, $NaN) }, "pack $f NaN undef");
 232     like($@, $f eq 'w' ? qr/Cannot compress NaN/: qr/Cannot pack NaN/,
 233          "NaN pack $f fails");
 234 }
 235
 236 for my $f (@packf_fmt) {
 237     ok(defined eval { $a = pack($f, $NaN) }, "pack $f NaN defined");
 238     eval { $b = unpack($f, $a) };
 239     cmp_ok($b, '!=', $b, "pack $f NaN not-equals $NaN");
 240 }
 241
 242 for my $i (@NaN) {
 243     cmp_ok($i + 0, '!=', $i + 0, "$i is NaN numerically (by not being NaN)");
 244     is("@{[$i+0]}", "NaN", "$i value stringifies as NaN");
 245 }
 246
 247 ok(!($NaN <  0), "NaN is not lt zero");
 248 ok(!($NaN == 0), "NaN is not == zero");
 249 ok(!($NaN >  0), "NaN is not gt zero");
 250
 251 ok(!($NaN < $NaN), "NaN is not lt NaN");
 252 ok(!($NaN > $NaN), "NaN is not gt NaN");
 253
 254 # is() okay with $NaN because it uses eq.
 255 is($NaN * 0, $NaN, "NaN times zero is NaN");
 256 is($NaN * 2, $NaN, "NaN times two is NaN");
 257
 258 my ($NaNPP, $NaNMM) = ($NaN, $NaN);
 259 $NaNPP++;
 260 $NaNMM--;
 261 is($NaNPP, $NaN, "+NaN++ is NaN");
 262 is($NaNMM, $NaN, "+NaN-- is NaN");
 263
 264 # You might find this surprising (isn't NaN kind of like of undef?)
 265 # but this is how it is.
 266 ok($NaN, "NaN is true");
 267
 268 is(abs($NaN), $NaN, "abs(NaN) is NaN");
 269 is(int($NaN), $NaN, "int(NaN) is NaN");
 270 is(sqrt($NaN), $NaN, "sqrt(NaN) is NaN");
 271 is(exp($NaN), $NaN, "exp(NaN) is NaN");
 272
 273 SKIP: {
 274     if ($NaN == 0) {
 275         skip "if +NaN == 0 cannot log(+NaN)", 1;
 276     }
 277     is(log($NaN), $NaN, "log(NaN) is NaN");
 278 }
 279
 280 is(sin($NaN), $NaN, "sin(NaN) is NaN");
 281 is(rand($NaN), $NaN, "rand(NaN) is NaN");
 282
 283 SKIP: {
 284     my $here = "$^O $Config{osvers}";
 285     if ($here =~ /^hpux 10/) {
 286         skip "$here: pow doesn't generate Inf, so sin(Inf) won't happen", 1;
 287     }
 288     is(sin(9**9**9), $NaN, "sin(9**9**9) is NaN");
 289 }
 290
 291 # === Tests combining Inf and NaN ===
 292
 293 # is() okay with $NaN because it uses eq.
 294 is($PInf * 0,     $NaN, "Inf times zero is NaN");
 295 is($PInf * $NaN,  $NaN, "Inf times NaN is NaN");
 296 is($PInf + $NaN,  $NaN, "Inf plus NaN is NaN");
 297 is($PInf - $PInf, $NaN, "Inf minus inf is NaN");
 298 is($PInf / $PInf, $NaN, "Inf div inf is NaN");
 299 is($PInf % $PInf, $NaN, "Inf mod inf is NaN");
 300
 301 ok(!($NaN <  $PInf), "NaN is not lt +Inf");
 302 ok(!($NaN == $PInf), "NaN is not eq +Inf");
 303 ok(!($NaN >  $PInf), "NaN is not gt +Inf");
 304
 305 ok(!($NaN <  $NInf), "NaN is not lt -Inf");
 306 ok(!($NaN == $NInf), "NaN is not eq -Inf");
 307 ok(!($NaN >  $NInf), "NaN is not gt -Inf");
 308
 309 is(sin($PInf), $NaN, "sin(+Inf) is NaN");
 310
 311 done_testing();