A bug introduced in #8217 (the undefined variable in the
[p5sagit/p5-mst-13.2.git] / sv.c
diff --git a/sv.c b/sv.c
index 58c6434..93188df 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -2957,6 +2957,7 @@ Perl_sv_utf8_upgrade(pTHX_ register SV *sv)
 
     if (hibit) {
        STRLEN len;
+
        if (SvREADONLY(sv) && SvFAKE(sv)) {
            sv_force_normal(sv);
            s = SvPVX(sv);
@@ -2987,10 +2988,13 @@ Perl_sv_utf8_downgrade(pTHX_ register SV* sv, bool fail_ok)
 {
     if (SvPOK(sv) && SvUTF8(sv)) {
         if (SvCUR(sv)) {
-           char *c = SvPVX(sv);
-           STRLEN len = SvCUR(sv);
+           char *s;
+           STRLEN len;
 
-           if (!utf8_to_bytes((U8*)c, &len)) {
+           if (SvREADONLY(sv) && SvFAKE(sv))
+               sv_force_normal(sv);
+           s = SvPV(sv, len);
+           if (!utf8_to_bytes((U8*)s, &len)) {
                if (fail_ok)
                    return FALSE;
                else {
@@ -3440,7 +3444,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
            *SvEND(dstr) = '\0';
            (void)SvPOK_only(dstr);
        }
-       if ((sflags & SVf_UTF8) && !IN_BYTE)
+       if (sflags & SVf_UTF8)
            SvUTF8_on(dstr);
        /*SUPPRESS 560*/
        if (sflags & SVp_NOK) {
@@ -6704,6 +6708,21 @@ Perl_sv_vsetpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
     sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, maybe_tainted);
 }
 
+I32
+S_expect_number(pTHX_ char** pattern)
+{
+    I32 var = 0;
+    switch (**pattern) {
+    case '1': case '2': case '3':
+    case '4': case '5': case '6':
+    case '7': case '8': case '9':
+       while (isDIGIT(**pattern))
+           var = var * 10 + (*(*pattern)++ - '0');
+    }
+    return var;
+}
+#define EXPECT_NUMBER(pattern, var) (var = S_expect_number(aTHX_ &pattern))
+
 /*
 =for apidoc sv_vcatpvfn
 
@@ -6764,7 +6783,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
        bool alt = FALSE;
        bool left = FALSE;
        bool vectorize = FALSE;
-       bool utf = FALSE;
+       bool vectorarg = FALSE;
+       bool vec_utf = FALSE;
        char fill = ' ';
        char plus = 0;
        char intsize = 0;
@@ -6801,10 +6821,13 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
        STRLEN gap;
        char *dotstr = ".";
        STRLEN dotstrlen = 1;
-       I32 epix = 0; /* explicit parameter index */
+       I32 efix = 0; /* explicit format parameter index */
        I32 ewix = 0; /* explicit width index */
+       I32 epix = 0; /* explicit precision index */
+       I32 evix = 0; /* explicit vector index */
        bool asterisk = FALSE;
 
+       /* echo everything up to the next format specification */
        for (q = p; q < patend && *q != '%'; ++q) ;
        if (q > p) {
            sv_catpvn(sv, p, q - p);
@@ -6813,6 +6836,25 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
        if (q++ >= patend)
            break;
 
+/*
+    We allow format specification elements in this order:
+       \d+\$              explicit format parameter index
+       [-+ 0#]+           flags
+       \*?(\d+\$)?v       vector with optional (optionally specified) arg
+       \d+|\*(\d+\$)?     width using optional (optionally specified) arg
+       \.(\d*|\*(\d+\$)?) precision using optional (optionally specified) arg
+       [hlqLV]            size
+    [%bcdefginopsux_DFOUX] format (mandatory)
+*/
+       if (EXPECT_NUMBER(q, width)) {
+           if (*q == '$') {
+               ++q;
+               efix = width;
+           } else {
+               goto gotwidth;
+           }
+       }
+
        /* FLAGS */
 
        while (*q) {
@@ -6836,63 +6878,60 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                q++;
                continue;
 
-           case '*':                   /* printf("%*vX",":",$ipv6addr) */
-               if (q[1] != 'v')
-                   break;
-               q++;
-               if (args)
-                   vecsv = va_arg(*args, SV*);
-               else if (svix < svmax)
-                   vecsv = svargs[svix++];
-               else
-                   continue;
-               dotstr = SvPVx(vecsv,dotstrlen);
-               if (DO_UTF8(vecsv))
-                   is_utf = TRUE;
-               /* FALL THROUGH */
-
-           case 'v':
-               vectorize = TRUE;
-               q++;
-               continue;
-
            default:
                break;
            }
            break;
        }
 
-       /* WIDTH */
-
-    scanwidth:
-
+      tryasterisk:
        if (*q == '*') {
-           if (asterisk)
-               goto unknown;
+           q++;
+           if (EXPECT_NUMBER(q, ewix))
+               if (*q++ != '$')
+                   goto unknown;
            asterisk = TRUE;
+       }
+       if (*q == 'v') {
            q++;
+           if (vectorize)
+               goto unknown;
+           if (vectorarg = asterisk) {
+               evix = ewix;
+               ewix = 0;
+               asterisk = FALSE;
+           }
+           vectorize = TRUE;
+           goto tryasterisk;
        }
 
-       switch (*q) {
-       case '1': case '2': case '3':
-       case '4': case '5': case '6':
-       case '7': case '8': case '9':
-           width = 0;
-           while (isDIGIT(*q))
-               width = width * 10 + (*q++ - '0');
-           if (*q == '$') {
-               if (asterisk && ewix == 0) {
-                   ewix  = width;
-                   width = 0;
-                   q++;
-                   goto scanwidth;
-               } else if (epix == 0) {
-                   epix  = width;
-                   width = 0;
-                   q++;
-                   goto scanwidth;
-               } else
-                   goto unknown;
+       if (!asterisk)
+           EXPECT_NUMBER(q, width);
+
+       if (vectorize) {
+           if (vectorarg) {
+               if (args)
+                   vecsv = va_arg(*args, SV*);
+               else
+                   vecsv = (evix ? evix <= svmax : svix < svmax) ?
+                       svargs[ewix ? ewix-1 : svix++] : &PL_sv_undef;
+               dotstr = SvPVx(vecsv, dotstrlen);
+               if (DO_UTF8(vecsv))
+                   is_utf = TRUE;
+           }
+           if (args) {
+               vecsv = va_arg(*args, SV*);
+               vecstr = (U8*)SvPVx(vecsv,veclen);
+               vec_utf = DO_UTF8(vecsv);
+           }
+           else if (efix ? efix <= svmax : svix < svmax) {
+               vecsv = svargs[efix ? efix-1 : svix++];
+               vecstr = (U8*)SvPVx(vecsv,veclen);
+               vec_utf = DO_UTF8(vecsv);
+           }
+           else {
+               vecstr = (U8*)"";
+               veclen = 0;
            }
        }
 
@@ -6905,19 +6944,22 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            left |= (i < 0);
            width = (i < 0) ? -i : i;
        }
+      gotwidth:
 
        /* PRECISION */
 
        if (*q == '.') {
            q++;
            if (*q == '*') {
+               q++;
+               if (EXPECT_NUMBER(q, epix) && *q++ != '$')
+                   goto unknown;
                if (args)
                    i = va_arg(*args, int);
                else
                    i = (ewix ? ewix <= svmax : svix < svmax)
                        ? SvIVx(svargs[ewix ? ewix-1 : svix++]) : 0;
                precis = (i < 0) ? 0 : i;
-               q++;
            }
            else {
                precis = 0;
@@ -6927,23 +6969,6 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            has_precis = TRUE;
        }
 
-       if (vectorize) {
-           if (args) {
-               vecsv = va_arg(*args, SV*);
-               vecstr = (U8*)SvPVx(vecsv,veclen);
-               utf = DO_UTF8(vecsv);
-           }
-           else if (epix ? epix <= svmax : svix < svmax) {
-               vecsv = svargs[epix ? epix-1 : svix++];
-               vecstr = (U8*)SvPVx(vecsv,veclen);
-               utf = DO_UTF8(vecsv);
-           }
-           else {
-               vecstr = (U8*)"";
-               veclen = 0;
-           }
-       }
-
        /* SIZE */
 
        switch (*q) {
@@ -6975,21 +7000,22 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 
        /* CONVERSION */
 
+       if (*q == '%') {
+           eptr = q++;
+           elen = 1;
+           goto string;
+       }
+
+       if (!args)
+           argsv = (efix ? efix <= svmax : svix < svmax) ?
+                   svargs[efix ? efix-1 : svix++] : &PL_sv_undef;
+
        switch (c = *q++) {
 
            /* STRINGS */
 
-       case '%':
-           eptr = q - 1;
-           elen = 1;
-           goto string;
-
        case 'c':
-           if (args)
-               uv = va_arg(*args, int);
-           else
-               uv = (epix ? epix <= svmax : svix < svmax) ?
-                   SvIVx(svargs[epix ? epix-1 : svix++]) : 0;
+           uv = args ? va_arg(*args, int) : SvIVx(argsv);
            if ((uv > 255 || (uv > 127 && SvUTF8(sv))) && !IN_BYTE) {
                eptr = (char*)utf8buf;
                elen = uv_to_utf8((U8*)eptr, uv) - utf8buf;
@@ -7018,8 +7044,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                    elen = sizeof nullstr - 1;
                }
            }
-           else if (epix ? epix <= svmax : svix < svmax) {
-               argsv = svargs[epix ? epix-1 : svix++];
+           else {
                eptr = SvPVx(argsv, elen);
                if (DO_UTF8(argsv)) {
                    if (has_precis && precis < elen) {
@@ -7043,7 +7068,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
             */
            if (!args)
                goto unknown;
-           argsv = va_arg(*args,SV*);
+           argsv = va_arg(*args, SV*);
            eptr = SvPVx(argsv, elen);
            if (DO_UTF8(argsv))
                is_utf = TRUE;
@@ -7059,11 +7084,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
        case 'p':
            if (alt)
                goto unknown;
-           if (args)
-               uv = PTR2UV(va_arg(*args, void*));
-           else
-               uv = (epix ? epix <= svmax : svix < svmax) ?
-                   PTR2UV(svargs[epix ? epix-1 : svix++]) : 0;
+           uv = PTR2UV(args ? va_arg(*args, void*) : argsv);
            base = 16;
            goto integer;
 
@@ -7078,11 +7099,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
        case 'i':
            if (vectorize) {
                STRLEN ulen;
-               if (!veclen) {
-                   vectorize = FALSE;
-                   break;
-               }
-               if (utf)
+               if (!veclen)
+                   continue;
+               if (vec_utf)
                    iv = (IV)utf8_to_uv(vecstr, veclen, &ulen, 0);
                else {
                    iv = *vecstr;
@@ -7103,8 +7122,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                }
            }
            else {
-               iv = (epix ? epix <= svmax : svix < svmax) ?
-                   SvIVx(svargs[epix ? epix-1 : svix++]) : 0;
+               iv = SvIVx(argsv);
                switch (intsize) {
                case 'h':       iv = (short)iv; break;
                default:        break;
@@ -7161,11 +7179,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            if (vectorize) {
                STRLEN ulen;
        vector:
-               if (!veclen) {
-                   vectorize = FALSE;
-                   break;
-               }
-               if (utf)
+               if (!veclen)
+                   continue;
+               if (vec_utf)
                    uv = utf8_to_uv(vecstr, veclen, &ulen, 0);
                else {
                    uv = *vecstr;
@@ -7186,8 +7202,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                }
            }
            else {
-               uv = (epix ? epix <= svmax : svix < svmax) ?
-                   SvUVx(svargs[epix ? epix-1 : svix++]) : 0;
+               uv = SvUVx(argsv);
                switch (intsize) {
                case 'h':       uv = (unsigned short)uv; break;
                default:        break;
@@ -7276,11 +7291,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            /* This is evil, but floating point is even more evil */
 
            vectorize = FALSE;
-           if (args)
-               nv = va_arg(*args, NV);
-           else
-               nv = (epix ? epix <= svmax : svix < svmax) ?
-                   SvNVx(svargs[epix ? epix-1 : svix++]) : 0.0;
+           nv = args ? va_arg(*args, NV) : SvNVx(argsv);
 
            need = 0;
            if (c != 'e' && c != 'E') {
@@ -7360,8 +7371,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 #endif
                }
            }
-           else if (epix ? epix <= svmax : svix < svmax)
-               sv_setuv_mg(svargs[epix ? epix-1 : svix++], (UV)i);
+           else
+               sv_setuv_mg(argsv, (UV)i);
            continue;   /* not "break" */
 
            /* UNKNOWN */
@@ -7396,7 +7407,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            /* ... right here, because formatting flags should not apply */
            SvGROW(sv, SvCUR(sv) + elen + 1);
            p = SvEND(sv);
-           memcpy(p, eptr, elen);
+           Copy(eptr, p, elen, char);
            p += elen;
            *p = '\0';
            SvCUR(sv) = p - SvPVX(sv);
@@ -7426,7 +7437,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                *p++ = '0';
        }
        if (elen) {
-           memcpy(p, eptr, elen);
+           Copy(eptr, p, elen, char);
            p += elen;
        }
        if (gap && left) {
@@ -7435,7 +7446,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
        }
        if (vectorize) {
            if (veclen) {
-               memcpy(p, dotstr, dotstrlen);
+               Copy(dotstr, p, dotstrlen, char);
                p += dotstrlen;
            }
            else
@@ -8440,6 +8451,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_scopestack = 0;
     PL_savestack = 0;
     PL_retstack = 0;
+    PL_sig_pending = 0;
 #    else      /* !DEBUGGING */
     Zero(my_perl, 1, PerlInterpreter);
 #    endif     /* DEBUGGING */
@@ -8466,6 +8478,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_scopestack = 0;
     PL_savestack = 0;
     PL_retstack = 0;
+    PL_sig_pending = 0;
 #    else      /* !DEBUGGING */
     Zero(my_perl, 1, PerlInterpreter);
 #    endif     /* DEBUGGING */
@@ -8865,12 +8878,18 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_uudmap['M']     = 0;            /* reinits on demand */
     PL_bitcount                = Nullch;       /* reinits on demand */
 
+    if (proto_perl->Ipsig_pend) {
+       Newz(0, PL_psig_pend, SIG_SIZE, int);
+    }
+    else {
+       PL_psig_pend    = (int*)NULL;
+    }
+
     if (proto_perl->Ipsig_ptr) {
-       int sig_num[] = { SIG_NUM };
-       Newz(0, PL_psig_ptr, sizeof(sig_num)/sizeof(*sig_num), SV*);
-       Newz(0, PL_psig_name, sizeof(sig_num)/sizeof(*sig_num), SV*);
-       for (i = 1; PL_sig_name[i]; i++) {
-           PL_psig_ptr[i] = sv_dup_inc(proto_perl->Ipsig_ptr[i]);
+       Newz(0, PL_psig_ptr,  SIG_SIZE, SV*);
+       Newz(0, PL_psig_name, SIG_SIZE, SV*);
+       for (i = 1; i < SIG_SIZE; i++) {
+           PL_psig_ptr[i]  = sv_dup_inc(proto_perl->Ipsig_ptr[i]);
            PL_psig_name[i] = sv_dup_inc(proto_perl->Ipsig_name[i]);
        }
     }