[PATHCH] Scalar::Util::readonly ...

[p5sagit/p5-mst-13.2.git] / sv.c

diff --git a/sv.c b/sv.c
index 7dd83cc..4f9a625 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -3406,9 +3406,18 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
 
     if (sstr == dstr)
        return;
+
+    if (SvIS_FREED(dstr)) {
+       Perl_croak(aTHX_ "panic: attempt to copy value %" SVf
+                  " to a freed scalar %p", sstr, dstr);
+    }
     SV_CHECK_THINKFIRST_COW_DROP(dstr);
     if (!sstr)
        sstr = &PL_sv_undef;
+    if (SvIS_FREED(sstr)) {
+       Perl_croak(aTHX_ "panic: attempt to copy freed scalar %p to %p", sstr,
+                  dstr);
+    }
     stype = SvTYPE(sstr);
     dtype = SvTYPE(dstr);
 
@@ -8659,7 +8668,10 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            switch (*q) {
            case ' ':
            case '+':
-               plus = *q++;
+               if (plus == '+' && *q == ' ') /* '+' over ' ' */
+                   q++;
+               else
+                   plus = *q++;
                continue;
 
            case '-':
@@ -8796,14 +8808,15 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                else
                    i = (ewix ? ewix <= svmax : svix < svmax)
                        ? SvIVx(svargs[ewix ? ewix-1 : svix++]) : 0;
-               precis = (i < 0) ? 0 : i;
+               precis = i;
+               has_precis = !(i < 0);
            }
            else {
                precis = 0;
                while (isDIGIT(*q))
                    precis = precis * 10 + (*q++ - '0');
+               has_precis = TRUE;
            }
-           has_precis = TRUE;
        }
 
        /* SIZE */
@@ -9026,6 +9039,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            base = 10;
            goto uns_integer;
 
+       case 'B':
        case 'b':
            base = 2;
            goto uns_integer;
@@ -9119,7 +9133,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                    } while (uv >>= 1);
                    if (tempalt) {
                        esignbuf[esignlen++] = '0';
-                       esignbuf[esignlen++] = 'b';
+                       esignbuf[esignlen++] = c;
                    }
                    break;
                default:                /* it had better be ten or less */
@@ -9134,8 +9148,13 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                if (has_precis) {
                    if (precis > elen)
                        zeros = precis - elen;
-                   else if (precis == 0 && elen == 1 && *eptr == '0')
+                   else if (precis == 0 && elen == 1 && *eptr == '0'
+                            && !(base == 8 && alt)) /* "%#.0o" prints "0" */
                        elen = 0;
+
+               /* a precision nullifies the 0 flag. */
+                   if (fill == '0')
+                       fill = ' ';
                }
            }
            break;
@@ -9513,8 +9532,8 @@ ptr_table_* functions.
 
 
 /* Certain cases in Perl_ss_dup have been merged, by relying on the fact
-   that currently av_dup and hv_dup are the same as sv_dup. If this changes,
-   please unmerge ss_dup.  */
+   that currently av_dup, gv_dup and hv_dup are the same as sv_dup.
+   If this changes, please unmerge ss_dup.  */
 #define sv_dup_inc(s,t)        SvREFCNT_inc(sv_dup(s,t))
 #define sv_dup_inc_NN(s,t)     SvREFCNT_inc_NN(sv_dup(s,t))
 #define av_dup(s,t)    (AV*)sv_dup((SV*)s,t)
@@ -10370,6 +10389,7 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
     long longval;
     GP *gp;
     IV iv;
+    I32 i;
     char *c = NULL;
     void (*dptr) (void*);
     void (*dxptr) (pTHX_ void*);
@@ -10377,13 +10397,20 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
     Newxz(nss, max, ANY);
 
     while (ix > 0) {
-       I32 i = POPINT(ss,ix);
-       TOPINT(nss,ix) = i;
-       switch (i) {
+       const I32 type = POPINT(ss,ix);
+       TOPINT(nss,ix) = type;
+       switch (type) {
+       case SAVEt_HELEM:               /* hash element */
+           sv = (SV*)POPPTR(ss,ix);
+           TOPPTR(nss,ix) = sv_dup_inc(sv, param);
+           /* fall through */
        case SAVEt_ITEM:                        /* normal string */
         case SAVEt_SV:                         /* scalar reference */
            sv = (SV*)POPPTR(ss,ix);
            TOPPTR(nss,ix) = sv_dup_inc(sv, param);
+           /* fall through */
+       case SAVEt_FREESV:
+       case SAVEt_MORTALIZESV:
            sv = (SV*)POPPTR(ss,ix);
            TOPPTR(nss,ix) = sv_dup_inc(sv, param);
            break;
@@ -10404,8 +10431,11 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
         case SAVEt_AV:                         /* array reference */
            sv = (SV*) POPPTR(ss,ix);
            TOPPTR(nss,ix) = sv_dup_inc(sv, param);
-           gv = (GV*)POPPTR(ss,ix);
-           TOPPTR(nss,ix) = gv_dup(gv, param);
+           /* fall through */
+       case SAVEt_COMPPAD:
+       case SAVEt_NSTAB:
+           sv = POPPTR(ss,ix);
+           TOPPTR(nss,ix) = sv_dup(sv, param);
            break;
        case SAVEt_INT:                         /* int reference */
            ptr = POPPTR(ss,ix);
@@ -10416,6 +10446,8 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
        case SAVEt_LONG:                        /* long reference */
            ptr = POPPTR(ss,ix);
            TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+           /* fall through */
+       case SAVEt_CLEARSV:
            longval = (long)POPLONG(ss,ix);
            TOPLONG(nss,ix) = longval;
            break;
@@ -10455,28 +10487,13 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
            c = (char*)POPPTR(ss,ix);
            TOPPTR(nss,ix) = pv_dup(c);
            break;
-       case SAVEt_NSTAB:
-           gv = (GV*)POPPTR(ss,ix);
-           TOPPTR(nss,ix) = gv_dup(gv, param);
-           break;
        case SAVEt_GP:                          /* scalar reference */
            gp = (GP*)POPPTR(ss,ix);
            TOPPTR(nss,ix) = gp = gp_dup(gp, param);
            (void)GpREFCNT_inc(gp);
            gv = (GV*)POPPTR(ss,ix);
            TOPPTR(nss,ix) = gv_dup_inc(gv, param);
-            c = (char*)POPPTR(ss,ix);
-           TOPPTR(nss,ix) = pv_dup(c);
-           iv = POPIV(ss,ix);
-           TOPIV(nss,ix) = iv;
-           iv = POPIV(ss,ix);
-           TOPIV(nss,ix) = iv;
             break;
-       case SAVEt_FREESV:
-       case SAVEt_MORTALIZESV:
-           sv = (SV*)POPPTR(ss,ix);
-           TOPPTR(nss,ix) = sv_dup_inc(sv, param);
-           break;
        case SAVEt_FREEOP:
            ptr = POPPTR(ss,ix);
            if (ptr && (((OP*)ptr)->op_private & OPpREFCOUNTED)) {
@@ -10505,15 +10522,13 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
            c = (char*)POPPTR(ss,ix);
            TOPPTR(nss,ix) = pv_dup_inc(c);
            break;
-       case SAVEt_CLEARSV:
-           longval = POPLONG(ss,ix);
-           TOPLONG(nss,ix) = longval;
-           break;
        case SAVEt_DELETE:
            hv = (HV*)POPPTR(ss,ix);
            TOPPTR(nss,ix) = hv_dup_inc(hv, param);
            c = (char*)POPPTR(ss,ix);
            TOPPTR(nss,ix) = pv_dup_inc(c);
+           /* fall through */
+       case SAVEt_STACK_POS:           /* Position on Perl stack */
            i = POPINT(ss,ix);
            TOPINT(nss,ix) = i;
            break;
@@ -10539,10 +10554,6 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
            TOPINT(nss,ix) = i;
            ix -= i;
            break;
-       case SAVEt_STACK_POS:           /* Position on Perl stack */
-           i = POPINT(ss,ix);
-           TOPINT(nss,ix) = i;
-           break;
        case SAVEt_AELEM:               /* array element */
            sv = (SV*)POPPTR(ss,ix);
            TOPPTR(nss,ix) = sv_dup_inc(sv, param);
@@ -10551,14 +10562,6 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
            av = (AV*)POPPTR(ss,ix);
            TOPPTR(nss,ix) = av_dup_inc(av, param);
            break;
-       case SAVEt_HELEM:               /* hash element */
-           sv = (SV*)POPPTR(ss,ix);
-           TOPPTR(nss,ix) = sv_dup_inc(sv, param);
-           sv = (SV*)POPPTR(ss,ix);
-           TOPPTR(nss,ix) = sv_dup_inc(sv, param);
-           hv = (HV*)POPPTR(ss,ix);
-           TOPPTR(nss,ix) = hv_dup_inc(hv, param);
-           break;
        case SAVEt_OP:
            ptr = POPPTR(ss,ix);
            TOPPTR(nss,ix) = ptr;
@@ -10578,10 +10581,6 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
                TOPPTR(nss,ix) = hv_dup_inc(hv, param);
            }
            break;
-       case SAVEt_COMPPAD:
-           av = (AV*)POPPTR(ss,ix);
-           TOPPTR(nss,ix) = av_dup(av, param);
-           break;
        case SAVEt_PADSV:
            longval = (long)POPLONG(ss,ix);
            TOPLONG(nss,ix) = longval;
@@ -10671,7 +10670,8 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
            TOPPTR(nss,ix) = DUP_WARNINGS((STRLEN*)ptr);
            break;
        default:
-           Perl_croak(aTHX_ "panic: ss_dup inconsistency (%"IVdf")", (IV) i);
+           Perl_croak(aTHX_
+                      "panic: ss_dup inconsistency (%"IVdf")", (IV) type);
        }
     }
 
@@ -11056,6 +11056,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_beginav         = av_dup_inc(proto_perl->Ibeginav, param);
     PL_beginav_save    = av_dup_inc(proto_perl->Ibeginav_save, param);
     PL_checkav_save    = av_dup_inc(proto_perl->Icheckav_save, param);
+    PL_unitcheckav      = av_dup_inc(proto_perl->Iunitcheckav, param);
+    PL_unitcheckav_save = av_dup_inc(proto_perl->Iunitcheckav_save, param);
     PL_endav           = av_dup_inc(proto_perl->Iendav, param);
     PL_checkav         = av_dup_inc(proto_perl->Icheckav, param);
     PL_initav          = av_dup_inc(proto_perl->Iinitav, param);