X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=sv.c;h=e76e40ffe5adb9505a487ab972c3386dcddd2fa9;hb=be341bcebb03d2f97192fb78a6a1bc33c7bca5ce;hp=f062bbb10c1173ea72b140996e6f730f700dde87;hpb=9c3dd3fe0ef5ca1dd7e835adfcf5e21c1099e72a;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/sv.c b/sv.c
index f062bbb..e76e40f 100644
--- a/sv.c
+++ b/sv.c
@@ -1483,8 +1483,8 @@ Perl_sv_2iv(pTHX_ register SV *sv)
 
 	    if (SvTYPE(sv) < SVt_PVIV)
 		sv_upgrade(sv, SVt_PVIV);
-	    SvIVX(sv) = 0;
 	    (void)SvIOK_on(sv);
+	    SvIVX(sv) = 0;
 	    if (ckWARN(WARN_NUMERIC))
 		not_a_number(sv);
 	}
@@ -1637,10 +1637,10 @@ Perl_sv_2uv(pTHX_ register SV *sv)
 
 	    if (SvTYPE(sv) < SVt_PVIV)
 		sv_upgrade(sv, SVt_PVIV);
-	    SvUVX(sv) = 0;		/* We assume that 0s have the
-					   same bitmap in IV and UV. */
 	    (void)SvIOK_on(sv);
 	    (void)SvIsUV_on(sv);
+	    SvUVX(sv) = 0;		/* We assume that 0s have the
+					   same bitmap in IV and UV. */
 	    if (ckWARN(WARN_NUMERIC))
 		not_a_number(sv);
 	}
@@ -2724,7 +2724,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 	if (sflags & SVp_IOK) {
 	    (void)SvIOK_on(dstr);
 	    SvIVX(dstr) = SvIVX(sstr);
-	    if (SvIsUV(sstr))
+	    if (sflags & SVf_IVisUV)
 		SvIsUV_on(dstr);
 	}
 	if (SvAMAGIC(sstr)) {
@@ -2762,7 +2762,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 		SvUTF8_off(dstr);
 
 	    SvTEMP_off(dstr);
-	    (void)SvOK_off(sstr);
+	    (void)SvOK_off(sstr);		/* NOTE: nukes most SvFLAGS on sstr */
 	    SvPV_set(sstr, Nullch);
 	    SvLEN_set(sstr, 0);
 	    SvCUR_set(sstr, 0);
@@ -2787,25 +2787,25 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 	if (sflags & SVp_IOK) {
 	    (void)SvIOK_on(dstr);
 	    SvIVX(dstr) = SvIVX(sstr);
-	    if (SvIsUV(sstr))
+	    if (sflags & SVf_IVisUV)
 		SvIsUV_on(dstr);
 	}
     }
     else if (sflags & SVp_NOK) {
 	SvNVX(dstr) = SvNVX(sstr);
 	(void)SvNOK_only(dstr);
-	if (SvIOK(sstr)) {
+	if (sflags & SVf_IOK) {
 	    (void)SvIOK_on(dstr);
 	    SvIVX(dstr) = SvIVX(sstr);
 	    /* XXXX Do we want to set IsUV for IV(ROK)?  Be extra safe... */
-	    if (SvIsUV(sstr))
+	    if (sflags & SVf_IVisUV)
 		SvIsUV_on(dstr);
 	}
     }
     else if (sflags & SVp_IOK) {
 	(void)SvIOK_only(dstr);
 	SvIVX(dstr) = SvIVX(sstr);
-	if (SvIsUV(sstr))
+	if (sflags & SVf_IVisUV)
 	    SvIsUV_on(dstr);
     }
     else {
@@ -3920,10 +3920,19 @@ Perl_sv_eq(pTHX_ register SV *str1, register SV *str2)
     else
 	pv1 = SvPV(str1, cur1);
 
-    if (!str2)
-	return !cur1;
-    else
-	pv2 = SvPV(str2, cur2);
+    if (cur1) {
+	if (!str2)
+	    return 0;
+	if (SvUTF8(str1) != SvUTF8(str2) && !IN_BYTE) {
+	    if (SvUTF8(str1)) {
+		sv_utf8_upgrade(str2);
+	    }
+	    else {
+		sv_utf8_upgrade(str1);
+	    }
+	}
+    }
+    pv2 = SvPV(str2, cur2);
 
     if (cur1 != cur2)
 	return 0;
@@ -4743,6 +4752,25 @@ Perl_newSViv(pTHX_ IV i)
 }
 
 /*
+=for apidoc newSVuv
+
+Creates a new SV and copies an unsigned integer into it.
+The reference count for the SV is set to 1.
+
+=cut
+*/
+
+SV *
+Perl_newSVuv(pTHX_ UV u)
+{
+    register SV *sv;
+
+    new_SV(sv);
+    sv_setuv(sv,u);
+    return sv;
+}
+
+/*
 =for apidoc newRV_noinc
 
 Creates an RV wrapper for an SV.  The reference count for the original
@@ -5168,6 +5196,7 @@ Perl_sv_reftype(pTHX_ SV *sv, int ob)
 	case SVt_PVCV:		return "CODE";
 	case SVt_PVGV:		return "GLOB";
 	case SVt_PVFM:		return "FORMAT";
+	case SVt_PVIO:		return "IO";
 	default:		return "UNKNOWN";
 	}
     }
@@ -5824,7 +5853,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		else if (svix < svmax)
 		    vecsv = svargs[svix++];
 		else {
-		    vecstr = "";
+		    vecstr = (U8*)"";
 		    veclen = 0;
 		    continue;
 		}
@@ -5906,6 +5935,11 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    break;
 	}
 
+#ifdef USE_64_BIT_INT
+	if (!intsize)
+	    intsize = 'q';
+#endif
+
 	/* CONVERSION */
 
 	switch (c = *q++) {
@@ -6382,10 +6416,6 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 #  include "error: USE_THREADS and USE_ITHREADS are incompatible"
 #endif
 
-#ifndef OpREFCNT_inc
-#  define OpREFCNT_inc(o)	((o) ? (++(o)->op_targ, (o)) : Nullop)
-#endif
-
 #ifndef GpREFCNT_inc
 #  define GpREFCNT_inc(gp)	((gp) ? (++(gp)->gp_refcnt, (gp)) : (GP*)NULL)
 #endif
@@ -6976,6 +7006,9 @@ Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max)
 		ncx->blk_loop.iterdata	= (CxPADLOOP(cx)
 					   ? cx->blk_loop.iterdata
 					   : gv_dup((GV*)cx->blk_loop.iterdata));
+		ncx->blk_loop.oldcurpad
+		    = (SV**)ptr_table_fetch(PL_ptr_table,
+					    cx->blk_loop.oldcurpad);
 		ncx->blk_loop.itersave	= sv_dup_inc(cx->blk_loop.itersave);
 		ncx->blk_loop.iterlval	= sv_dup_inc(cx->blk_loop.iterlval);
 		ncx->blk_loop.iterary	= av_dup_inc(cx->blk_loop.iterary);
@@ -7087,6 +7120,7 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl)
     char *c;
     void (*dptr) (void*);
     void (*dxptr) (pTHXo_ void*);
+    OP *o;
 
     Newz(54, nss, max, ANY);
 
@@ -7213,7 +7247,9 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl)
 		case OP_LEAVE:
 		case OP_SCOPE:
 		case OP_LEAVEWRITE:
-		    TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+		    TOPPTR(nss,ix) = ptr;
+		    o = (OP*)ptr;
+		    OpREFCNT_inc(o);
 		    break;
 		default:
 		    TOPPTR(nss,ix) = Nullop;
@@ -7556,7 +7592,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_main_cv		= cv_dup_inc(proto_perl->Imain_cv);
     PL_main_root	= OpREFCNT_inc(proto_perl->Imain_root);
     PL_main_start	= proto_perl->Imain_start;
-    PL_eval_root	= OpREFCNT_inc(proto_perl->Ieval_root);
+    PL_eval_root	= proto_perl->Ieval_root;
     PL_eval_start	= proto_perl->Ieval_start;
 
     /* runtime control stuff */
@@ -7834,6 +7870,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     }
     else {
 	init_stacks();
+	ENTER;			/* perl_destruct() wants to LEAVE; */
     }
 
     PL_start_env	= proto_perl->Tstart_env;	/* XXXXXX */