From 559a021f1d52c32a82cbdf9184aa59a58e898b08 Mon Sep 17 00:00:00 2001
From: David Mitchell <davem@iabyn.com>
Date: Tue, 16 May 2017 16:30:13 +0100
Subject: [PATCH] sprintf: handle sized int-ish formats with Inf/Nan

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          | 35 +++++++++++++++--------------------
 t/op/infnan.t | 34 ++++++++++++++++++++++++++++++++++
 2 files changed, 49 insertions(+), 20 deletions(-)

diff --git a/sv.c b/sv.c
index 6ad9181ac796..620ad580efdd 100644
--- 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;
diff --git a/t/op/infnan.t b/t/op/infnan.t
index 1f68cff8c1ad..2f69367c243d 100644
--- a/t/op/infnan.t
+++ b/t/op/infnan.t
@@ -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();