X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=sv.c;h=4f9a625d81771cd4e08566b614857a2af9842adf;hb=802134916c56985ba8dc700565240474646eb9f7;hp=7dd83cc13fd00a4d1eeb0a06ee6aa200542f9057;hpb=59b61096be97d8d463125e3b0422c5a6bd05f1e5;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/sv.c b/sv.c
index 7dd83cc..4f9a625 100644
--- 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);