Perl_sv_vcatpvfn_flags: move %*v handling earlier

[perl5.git] / sv.c

diff --git a/sv.c b/sv.c
index 46cfb6d..1355485 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -12003,6 +12003,27 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                evix = ewix;
                ewix = 0;
                asterisk = FALSE;
+                /* vectorizing, but not with the default "." */
+                if (args)
+                    vecsv = va_arg(*args, SV*);
+                else if (evix) {
+                    FETCH_VCATPVFN_ARGUMENT(
+                        vecsv, evix > 0 && evix <= svmax, svargs[evix-1]);
+                } else {
+                    FETCH_VCATPVFN_ARGUMENT(
+                        vecsv, svix < svmax, svargs[svix++]);
+                }
+                dotstr = SvPV_const(vecsv, dotstrlen);
+                /* Keep the DO_UTF8 test *after* the SvPV call, else things go
+                   bad with tied or overloaded values that return UTF8.  */
+                if (DO_UTF8(vecsv))
+                    is_utf8 = TRUE;
+                else if (has_utf8) {
+                    vecsv = sv_mortalcopy(vecsv);
+                    sv_utf8_upgrade(vecsv);
+                    dotstr = SvPV_const(vecsv, dotstrlen);
+                    is_utf8 = TRUE;
+                }
            }
            vectorize = TRUE;
            goto tryasterisk;
@@ -12017,29 +12038,6 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
            width = expect_number(&q);
        }
 
-       if (vectorize && vectorarg) {
-           /* vectorizing, but not with the default "." */
-           if (args)
-               vecsv = va_arg(*args, SV*);
-           else if (evix) {
-                FETCH_VCATPVFN_ARGUMENT(
-                    vecsv, evix > 0 && evix <= svmax, svargs[evix-1]);
-           } else {
-                FETCH_VCATPVFN_ARGUMENT(
-                    vecsv, svix < svmax, svargs[svix++]);
-           }
-           dotstr = SvPV_const(vecsv, dotstrlen);
-           /* Keep the DO_UTF8 test *after* the SvPV call, else things go
-              bad with tied or overloaded values that return UTF8.  */
-           if (DO_UTF8(vecsv))
-               is_utf8 = TRUE;
-           else if (has_utf8) {
-               vecsv = sv_mortalcopy(vecsv);
-               sv_utf8_upgrade(vecsv);
-               dotstr = SvPV_const(vecsv, dotstrlen);
-               is_utf8 = TRUE;
-           }               
-       }
 
        if (asterisk) {
             int i;
@@ -12216,15 +12214,6 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
 
        c = *q++; /* c now holds the conversion type */
 
-        if (argsv && strchr("BbcDdiOouUXx", c)) {
-            /* XXX va_arg(*args) case? need peek, use va_copy? */
-            SvGETMAGIC(argsv);
-            if (UNLIKELY(SvAMAGIC(argsv)))
-                argsv = sv_2num(argsv);
-            if (UNLIKELY(isinfnansv(argsv)))
-                goto handle_infnan_argsv;
-        }
-
        switch (c) {
 
            /* STRINGS */
@@ -12350,9 +12339,20 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
        case 'c':
            if (vectorize)
                goto unknown;
-           uv = (args) ? va_arg(*args, int) : SvIV_nomg(argsv);
+            /* Ignore any size specifiers, since they're not documented as
+             * being allowed for %c (ideally we should warn on e.g. '%hc').
+             * Setting a default intsize, along with a positive
+             * (which signals unsigned) base, causes, for C-ish use, the
+             * va_arg to be interpreted as as unsigned int, when it's
+             * actually signed, which will convert -ve values to high +ve
+             * values. Note that unlike the libc %c, values > 255 will
+             * convert to high unicode points rather than being truncated
+             * to 8 bits. For perlish use, it will do SvUV(argsv), which
+             * will again convert -ve args to high -ve values.
+             */
+            intsize = 0;
             base = 1; /* special value that indicates we're doing a 'c' */
-            goto do_integer;
+            goto get_int_arg_val;
 
        case 'D':
 #ifdef IV_IS_QUAD
@@ -12453,6 +12453,17 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                veclen -= ulen;
            }
            else {
+                /* test arg for inf/nan. This can trigger an unwanted
+                 * 'str' overload, so manually force 'num' overload first
+                 * if necessary */
+                if (argsv) {
+                    SvGETMAGIC(argsv);
+                    if (UNLIKELY(SvAMAGIC(argsv)))
+                        argsv = sv_2num(argsv);
+                    if (UNLIKELY(isinfnansv(argsv)))
+                        goto handle_infnan_argsv;
+                }
+
                 if (base < 0) {
                     /* signed int type */
                     base = -base;