printf inf/nan should be inf/nan.

Before: printf %[ducp] for Inf/NaN produced quite surprising results:
1, 0, -1, 18446744073709551615, 9223372036854775808, -9223372036854775807,
bogus Unicode code points, random heap addresses in hex.

diff --git a/sv.c b/sv.c
index fa45bf5..7c334d0 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -11380,6 +11380,25 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
            }
        }
 
+        if (argsv && SvNOK(argsv)) {
+            /* XXX va_arg(*args) case? */
+            NV nv = SvNV(argsv);
+            char g = 0;
+#ifdef Perl_isinf
+            if (Perl_isinf(nv))
+                g = 'g';
+#endif
+#ifdef Perl_isnan
+            if (Perl_isnan(nv))
+                g = 'g';
+#endif
+            if (g) {
+                c = g;
+                q++;
+                goto floating_point;
+            }
+        }
+
        switch (c = *q++) {
 
            /* STRINGS */
@@ -11457,6 +11476,13 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
 #endif
            /* FALLTHROUGH */
        case 'd':
+            /* XXX printf Inf/NaN for %[ducp], now produces quite
+             * surprising results: 1, 0, 18446744073709551615,
+             * 9223372036854775808, -9223372036854775807, bogus
+             * Unicode code points, random heap addresses in hex.
+             *
+             * For the argsv() doable (Perl_isinf, Perl_isnan), but
+             * how to do that for the va_arg(*args, ...)? */
        case 'i':
            if (vectorize) {
                STRLEN ulen;
@@ -11675,6 +11701,8 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
 
            /* FLOATING POINT */
 
+        floating_point:
+
        case 'F':
            c = 'f';            /* maybe %F isn't supported here */
            /* FALLTHROUGH */

diff --git a/t/op/infnan.t b/t/op/infnan.t
index 7455694..41ec84a 100644 (file)
--- a/t/op/infnan.t
+++ b/t/op/infnan.t
@@ -22,8 +22,10 @@ my @NaN = ("NAN", "nan", "qnan", "SNAN", "NanQ", "NANS",
            "NaN123", "NAN(123)", "nan%",
            "nanonano"); # RIP, Robin Williams.
 
-my $inf_tests = 11 + 3 * @PInf + 3 * @NInf + 5;
-my $nan_tests =  9 + 2 * @NaN + 3;
+my @fmt = qw(e f g a d x c p);
+
+my $inf_tests = 11 + @fmt + 3 * @PInf + 3 * @NInf + 5;
+my $nan_tests =  7 + @fmt + 2 * @NaN + 3;
 
 my $infnan_tests = 4;
 
@@ -55,6 +57,10 @@ SKIP: {
   is(sprintf("%g", $PInf), "Inf", "$PInf sprintf %g is Inf");
   is(sprintf("%a", $PInf), "Inf", "$PInf sprintf %a is Inf");
 
+  for my $f (@fmt) {
+      is(sprintf("%$f", $PInf), "Inf", "$PInf sprintf %$f is Inf");
+  }
+
   for my $i (@PInf) {
     cmp_ok($i + 0 , '==', $PInf, "$i is +Inf");
     cmp_ok($i, '>', 0, "$i is positive");
@@ -94,8 +100,9 @@ SKIP: {
   is($NaN * 2, $NaN, "twice NaN is NaN");
   is($NaN / 2, $NaN, "half of NaN is NaN");
 
-  is(sprintf("%g", $NaN), "NaN", "$NaN sprintf %g is NaN");
-  is(sprintf("%a", $NaN), "NaN", "$NaN sprintf %a is NaN");
+  for my $f (@fmt) {
+      is(sprintf("%$f", $NaN), "NaN", "$NaN sprintf %$f is NaN");
+  }
 
   for my $i (@NaN) {
     cmp_ok($i + 0, '!=', $i + 0, "$i is NaN numerically (by not being NaN)");