Perl_sv_vcatpvfn_flags: simpler special formats

At the top of Perl_sv_vcatpvfn_flags(), certain fixed formats are
special-cased: "", "%s", "%-p", "%.0f".

Simplify the code which handles these. In particular, don't try to issue
"missing" or "redundant" arg warnings there. Instead, check for the
correct number of args as part of the test for whether this can be
special-cased, and if not, fall through to the general code in the main
body of the function to handle that format and issue any warnings.

This makes the code a lot simpler. It also now detects the redundant arg
in printf("%.0f",1,2).

The code is now also more efficient - it tries to check for things like
pat[0] == '%' only once, rather than re-checking for every special-case
variant its trying.

diff --git a/sv.c b/sv.c
index af8c7ee..c97a193 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -11872,60 +11872,60 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
      * should be fixed */
     assert(pat[patlen] == '\0');
 
-    /* special-case "", "%s", and "%-p" (SVf - see below) */
-    if (patlen == 0) {
-       if (svmax && ckWARN(WARN_REDUNDANT))
-           Perl_warner(aTHX_ packWARN(WARN_REDUNDANT), "Redundant argument in %s",
-                       PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()");
-       return;
-    }
-    if (patlen == 2 && pat[0] == '%' && pat[1] == 's') {
-       if (svmax > 1 && ckWARN(WARN_REDUNDANT))
-           Perl_warner(aTHX_ packWARN(WARN_REDUNDANT), "Redundant argument in %s",
-                       PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()");
 
-       if (args) {
-           const char * const s = va_arg(*args, char*);
-           sv_catpv_nomg(sv, s ? s : nullstr);
-       }
-       else if (svix < svmax) {
-           /* we want get magic on the source but not the target. sv_catsv can't do that, though */
-           SvGETMAGIC(*svargs);
-           sv_catsv_nomg(sv, *svargs);
-       }
-       else
-           S_warn_vcatpvfn_missing_argument(aTHX);
-       return;
-    }
-    if (args && patlen == 3 && pat[0] == '%' &&
-               pat[1] == '-' && pat[2] == 'p') {
-       if (svmax > 1 && ckWARN(WARN_REDUNDANT))
-           Perl_warner(aTHX_ packWARN(WARN_REDUNDANT), "Redundant argument in %s",
-                       PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()");
-       argsv = MUTABLE_SV(va_arg(*args, void*));
-       sv_catsv_nomg(sv, argsv);
+    /* Special-case "", "%s", "%-p" (SVf - see below) and "%.0f".
+     * In each case, if there isn't the correct number of args, instead
+     * fall through to the main code to handle the issuing of any
+     * warnings etc.
+     */
+
+    if (patlen == 0 && (args || svmax == 0))
        return;
-    }
 
-#if !defined(USE_LONG_DOUBLE) && !defined(USE_QUADMATH)
-    /* special-case "%.0f" */
-    if (    !args
-         && patlen == 4
-         && pat[0] == '%' && pat[1] == '.' && pat[2] == '0' && pat[3] == 'f'
-         && svmax > 0)
-    {
-        const NV nv = SvNV(*svargs);
-        if (LIKELY(!Perl_isinfnan(nv))) {
-            STRLEN l;
-            char *p;
+    if (patlen <= 4 && pat[0] == '%' && (args || svmax == 1)) {
 
-            if ((p = F0convert(nv, ebuf + sizeof ebuf, &l))) {
-                sv_catpvn_nomg(sv, p, l);
+        /* "%s" */
+        if (patlen == 2 && pat[1] == 's') {
+            if (args) {
+                const char * const s = va_arg(*args, char*);
+                sv_catpv_nomg(sv, s ? s : nullstr);
+            }
+            else {
+                /* we want get magic on the source but not the target.
+                 * sv_catsv can't do that, though */
+                SvGETMAGIC(*svargs);
+                sv_catsv_nomg(sv, *svargs);
+            }
+            return;
+        }
+
+        /* "%-p" */
+        if (args) {
+            if (patlen == 3  && pat[1] == '-' && pat[2] == 'p') {
+                SV *asv = MUTABLE_SV(va_arg(*args, void*));
+                sv_catsv_nomg(sv, asv);
                 return;
             }
-       }
-    }
+        }
+#if !defined(USE_LONG_DOUBLE) && !defined(USE_QUADMATH)
+        /* special-case "%.0f" */
+        else if (   patlen == 4
+                 && pat[1] == '.' && pat[2] == '0' && pat[3] == 'f')
+        {
+            const NV nv = SvNV(*svargs);
+            if (LIKELY(!Perl_isinfnan(nv))) {
+                STRLEN l;
+                char *p;
+
+                if ((p = F0convert(nv, ebuf + sizeof ebuf, &l))) {
+                    sv_catpvn_nomg(sv, p, l);
+                    return;
+                }
+            }
+        }
 #endif /* !USE_LONG_DOUBLE */
+    }
+
 
     patend = (char*)pat + patlen;
     for (p = (char*)pat; p < patend; p = q) {

diff --git a/t/op/sprintf.t b/t/op/sprintf.t
index a47d39c..3bde5df 100644 (file)
--- a/t/op/sprintf.t
+++ b/t/op/sprintf.t
@@ -771,3 +771,5 @@ e>%vd<   >"version"<    >165.133.153.162.137.150.149<   >perl #102586: vector fl
 >%2$vd<>123<   > MISSING<
 >%.f<   >123.432<   >123<   >by tradition, empty precision == 0 <
 >%.001f<   >123.432<   >123.4<   >by tradition, leading zeroes ignored in precison<
+>%.0f<   >[1.2, 3.4]<   >1 REDUNDANT<   >special-cased "%.0f" should check count<
+>%.0f<   >[]<   >0 MISSING<   >special-cased "%.0f" should check count<