This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
op/infnan.t: Todo tests are now passing on EBCDIC
[perl5.git] / t / op / infnan.t
index ae84111..7a2de7d 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 use strict;
@@ -16,6 +16,9 @@ BEGIN {
         # but Inf is completely broken (e.g. Inf + 0 -> NaN).
         skip_all "$^O with long doubles does not have sane inf/nan";
     }
+    unless ($Config{d_double_has_inf} && $Config{d_double_has_nan}) {
+        skip_all "the doublekind $Config{doublekind} does not have inf/nan";
+    }
 }
 
 my $PInf = "Inf"  + 0;
@@ -27,6 +30,7 @@ my $NaN;
 }
 
 my @PInf = ("Inf", "inf", "INF", "+Inf",
+            "Infinity",
             "1.#INF", "1#INF", "1.#INF00");
 my @NInf = map { "-$_" } grep { ! /^\+/ } @PInf;
 
@@ -34,7 +38,7 @@ my @NaN = ("NAN", "nan", "qnan", "SNAN", "NanQ", "NANS",
            "1.#QNAN", "+1#SNAN", "-1.#NAN", "1#IND", "1.#IND00",
            "NAN(123)");
 
-my @printf_fmt = qw(e f g a d u o i b x p);
+my @printf_fmt = qw(e f g a d u o i b x);
 my @packi_fmt = qw(c C s S l L i I n N v V j J w W U);
 my @packf_fmt = qw(f d F);
 my @packs_fmt = qw(a4 A4 Z5 b20 B20 h10 H10 u);
@@ -239,12 +243,12 @@ TODO: {
     local $::TODO;
     my $here = "$^O $Config{osvers}";
     $::TODO = "$here: pow (9**9**9) doesn't give Inf"
-        if $here =~ /^(?:hpux 10|os390)/;
+        if $here =~ /^(?:hpux 10)/;
     is(9**9**9, $PInf, "9**9**9 is Inf");
 }
 
 SKIP: {
-    my @FInf = qw(Infinity Infinite Info Inf123 Infiniti Infinityz);
+    my @FInf = qw(Infinite Info Inf123 Infiniti Infinityz);
     if ($Config{usequadmath}) {
         skip "quadmath strtoflt128() accepts false infinities", scalar @FInf;
     }
@@ -291,7 +295,12 @@ is($NaN * 2, $NaN, "twice NaN is NaN");
 is($NaN / 2, $NaN, "half of NaN is NaN");
 
 is($NaN * $NaN, $NaN, "NaN * NaN is NaN");
-is($NaN / $NaN, $NaN, "NaN / NaN is NaN");
+SKIP: {
+    if ($NaN == 0) {
+        skip "NaN looks like zero, avoiding dividing by it", 1;
+    }
+    is($NaN / $NaN, $NaN, "NaN / NaN is NaN");
+}
 
 for my $f (@printf_fmt) {
     is(sprintf("%$f", $NaN), "NaN", "$NaN sprintf %$f is NaN");
@@ -385,7 +394,7 @@ TODO: {
     local $::TODO;
     my $here = "$^O $Config{osvers}";
     $::TODO = "$here: pow (9**9**9) doesn't give Inf"
-        if $here =~ /^(?:hpux 10|os390)/;
+        if $here =~ /^(?:hpux 10)/;
     is(sin(9**9**9), $NaN, "sin(9**9**9) is NaN");
 }
 
@@ -455,12 +464,16 @@ cmp_ok('-1e-9999', '==', 0,     "underflow to 0 (runtime) from neg");
     my $T =
         [
          [ "inf",          0, $PInf ],
+         [ "infinity",     0, $PInf ],
          [ "infxy",        1, $PInf ],
          [ "inf34",        1, $PInf ],
          [ "1.#INF",       0, $PInf ],
          [ "1.#INFx",      1, $PInf ],
          [ "1.#INF00",     0, $PInf ],
          [ "1.#INFxy",     1, $PInf ],
+         [ " inf",         0, $PInf ],
+         [ "inf ",         0, $PInf ],
+         [ " inf ",        0, $PInf ],
 
          [ "nan",          0, $NaN ],
          [ "nanxy",        1, $NaN ],
@@ -483,10 +496,13 @@ cmp_ok('-1e-9999', '==', 0,     "underflow to 0 (runtime) from neg");
          [ "1.#IND",       0, $NaN ],
          [ "1.#IND00",     0, $NaN ],
          [ "1.#INDxy",     1, $NaN ],
+         [ " nan",         0, $NaN ],
+         [ "nan ",         0, $NaN ],
+         [ " nan ",        0, $NaN ],
         ];
 
     for my $t (@$T) {
-        print "# $t->[0] compile time\n";
+        print "# '$t->[0]' compile time\n";
         my $a;
         $w = '';
         eval '$a = "'.$t->[0].'" + 1';
@@ -497,7 +513,7 @@ cmp_ok('-1e-9999', '==', 0,     "underflow to 0 (runtime) from neg");
         } else {
             is($w, "", "no warning expected");
         }
-        print "# $t->[0] runtime\n";
+        print "# '$t->[0]' runtime\n";
         my $n = $t->[0];
         my $b;
         $w = '';
@@ -512,4 +528,38 @@ cmp_ok('-1e-9999', '==', 0,     "underflow to 0 (runtime) from neg");
     }
 }
 
+# Size qualifiers shouldn't affect printing Inf/Nan
+#
+# Prior to the commit which introduced these tests and the fix,
+# the code path taken when int-ish formats saw an Inf/Nan was to
+# jump to the floating-point handler, but then that would
+# warn about (valid) qualifiers.
+
+{
+    my @w;
+    local $SIG{__WARN__} = sub { push @w, $_[0] };
+
+    for my $format (qw(B b c D d i O o U u X x)) {
+        # skip unportable: j L q
+        for my $size (qw(hh h l ll t z)) {
+            for my $num ($NInf, $PInf, $NaN) {
+                @w = ();
+                my $res = eval { sprintf "%${size}${format}", $num; };
+                my $desc = "sprintf(\"%${size}${format}\", $num)";
+                if ($format eq 'c') {
+                    like($@, qr/Cannot printf $num with 'c'/, "$desc: like");
+                }
+                else {
+                    is($res, $num, "$desc: equality");
+                }
+
+                is (@w, 0, "$desc: warnings")
+                    or do {
+                        diag("got warning: [$_]") for map { chomp; $_} @w;
+                    };
+            }
+        }
+    }
+}
+
 done_testing();