This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
sprintf: handle sized int-ish formats with Inf/Nan
authorDavid Mitchell <davem@iabyn.com>
Tue, 16 May 2017 15:30:13 +0000 (16:30 +0100)
committerDavid Mitchell <davem@iabyn.com>
Wed, 7 Jun 2017 08:11:01 +0000 (09:11 +0100)
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) size
qualifiers. For example before:

    $ perl -we'printf "[%hi]\n", Inf'
    Invalid conversion in printf: "%hi" at -e line 1.
    Redundant argument in printf at -e line 1.
    [%hi]
    $

After this commit:

    $ perl -we'printf "[%hi]\n", Inf'
    [Inf]
    $

It also makes the code simpler.

sv.c
t/op/infnan.t

diff --git a/sv.c b/sv.c
index 6ad9181..620ad58 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -11639,7 +11639,6 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
        I32 epix = 0; /* explicit precision index */
        I32 evix = 0; /* explicit vector index */
        bool asterisk = FALSE;
-        bool infnan = FALSE;
 
        /* echo everything up to the next format specification */
        for (q = p; q < patend && *q != '%'; ++q) ;
@@ -12014,25 +12013,24 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
            }
        }
 
-        if (argsv && strchr("BbcDdiOopuUXx",*q)) {
+       c = *q++; /* c now holds the conversion type */
+
+        if (argsv && strchr("BbcDdiOopuUXx", c)) {
             /* XXX va_arg(*args) case? need peek, use va_copy? */
             SvGETMAGIC(argsv);
             if (UNLIKELY(SvAMAGIC(argsv)))
                 argsv = sv_2num(argsv);
-            infnan = UNLIKELY(isinfnansv(argsv));
+            if (UNLIKELY(isinfnansv(argsv)))
+                goto handle_infnan_argsv;
         }
 
-       switch (c = *q++) {
+       switch (c) {
 
            /* STRINGS */
 
        case 'c':
            if (vectorize)
                goto unknown;
-            if (infnan)
-                Perl_croak(aTHX_ "Cannot printf %" NVgf " with '%c'",
-                           /* no va_arg() case */
-                           SvNV_nomg(argsv), (int)c);
            uv = (args) ? va_arg(*args, int) : SvIV_nomg(argsv);
            if ((uv > 255 ||
                 (!UVCHR_IS_INVARIANT(uv) && SvUTF8(sv)))
@@ -12089,9 +12087,6 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
            /* INTEGERS */
 
        case 'p':
-            if (infnan) {
-                goto floating_point;
-            }
            if (alt || vectorize)
                goto unknown;
            uv = PTR2UV(args ? va_arg(*args, void*) : argsv);
@@ -12107,9 +12102,6 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
            /* FALLTHROUGH */
        case 'd':
        case 'i':
-            if (infnan) {
-                goto floating_point;
-            }
            if (vectorize) {
                STRLEN ulen;
                if (!veclen)
@@ -12211,9 +12203,6 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
            base = 16;
 
        uns_integer:
-            if (infnan) {
-                goto floating_point;
-            }
            if (vectorize) {
                STRLEN ulen;
        vector:
@@ -12330,8 +12319,6 @@ 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 */
@@ -12406,12 +12393,20 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
             }
             else
             {
-                if (!infnan) SvGETMAGIC(argsv);
+                SvGETMAGIC(argsv);
+                /* we jump here if an int-ish format encountered an
+                 * infinite/Nan argsv. After setting nv/fv, it falls
+                 * into the isinfnan block which follows */
+              handle_infnan_argsv:
                 nv = SvNV_nomg(argsv);
                 NV_TO_FV(nv, fv);
             }
 
             if (Perl_isinfnan(nv)) {
+                if (c == 'c')
+                    Perl_croak(aTHX_ "Cannot printf %" NVgf " with '%c'",
+                           SvNV_nomg(argsv), (int)c);
+
                 elen = S_infnan_2pv(nv, ebuf, sizeof(ebuf), plus);
                 assert(elen);
                 eptr = ebuf;
index 1f68cff..2f69367 100644 (file)
@@ -528,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 p U u X x)) {
+        # skip unportable: j
+        for my $size (qw(hh h l q 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();