X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=sv.c;h=2d38d05416eb8a0d6fe02f8090936ecb4eaa0fe1;hb=f3faeb53b75c95d2773d14d859d4fa9ca1594daa;hp=f74adea79bd3d43a7c405989cf8ab21ae5451c09;hpb=70612e96eacfe1d980494617b001dbed7e9eee65;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/sv.c b/sv.c
index f74adea..2d38d05 100644
--- a/sv.c
+++ b/sv.c
@@ -2054,7 +2054,7 @@ Perl_sv_2iv(pTHX_ register SV *sv)
 		) {
 		SvIOK_on(sv);  /* Can this go wrong with rounding? NWC */
 		DEBUG_c(PerlIO_printf(Perl_debug_log,
-				      "0x%"UVxf" iv(%g => %"IVdf") (precise)\n",
+				      "0x%"UVxf" iv(%"NVgf" => %"IVdf") (precise)\n",
 				      PTR2UV(sv),
 				      SvNVX(sv),
 				      SvIVX(sv)));
@@ -2065,7 +2065,7 @@ Perl_sv_2iv(pTHX_ register SV *sv)
 		   that PV->IV would be better than PV->NV->IV
 		   flags already correct - don't set public IOK.  */
 		DEBUG_c(PerlIO_printf(Perl_debug_log,
-				      "0x%"UVxf" iv(%g => %"IVdf") (imprecise)\n",
+				      "0x%"UVxf" iv(%"NVgf" => %"IVdf") (imprecise)\n",
 				      PTR2UV(sv),
 				      SvNVX(sv),
 				      SvIVX(sv)));
@@ -2348,7 +2348,7 @@ Perl_sv_2uv(pTHX_ register SV *sv)
 		) {
 		SvIOK_on(sv);  /* Can this go wrong with rounding? NWC */
 		DEBUG_c(PerlIO_printf(Perl_debug_log,
-				      "0x%"UVxf" uv(%g => %"IVdf") (precise)\n",
+				      "0x%"UVxf" uv(%"NVgf" => %"IVdf") (precise)\n",
 				      PTR2UV(sv),
 				      SvNVX(sv),
 				      SvIVX(sv)));
@@ -2359,7 +2359,7 @@ Perl_sv_2uv(pTHX_ register SV *sv)
 		   that PV->IV would be better than PV->NV->IV
 		   flags already correct - don't set public IOK.  */
 		DEBUG_c(PerlIO_printf(Perl_debug_log,
-				      "0x%"UVxf" uv(%g => %"IVdf") (imprecise)\n",
+				      "0x%"UVxf" uv(%"NVgf" => %"IVdf") (imprecise)\n",
 				      PTR2UV(sv),
 				      SvNVX(sv),
 				      SvIVX(sv)));
@@ -6050,8 +6050,9 @@ Perl_sv_dec(pTHX_ register SV *sv)
 =for apidoc sv_mortalcopy
 
 Creates a new SV which is a copy of the original SV (using C<sv_setsv>).
-The new SV is marked as mortal. It will be destroyed when the current
-context ends.  See also C<sv_newmortal> and C<sv_2mortal>.
+The new SV is marked as mortal. It will be destroyed "soon", either by an
+explicit call to FREETMPS, or by an implicit call at places such as
+statement boundaries.  See also C<sv_newmortal> and C<sv_2mortal>.
 
 =cut
 */
@@ -6078,8 +6079,9 @@ Perl_sv_mortalcopy(pTHX_ SV *oldstr)
 =for apidoc sv_newmortal
 
 Creates a new null SV which is mortal.  The reference count of the SV is
-set to 1. It will be destroyed when the current context ends.  See
-also C<sv_mortalcopy> and C<sv_2mortal>.
+set to 1. It will be destroyed "soon", either by an explicit call to
+FREETMPS, or by an implicit call at places such as statement boundaries.
+See also C<sv_mortalcopy> and C<sv_2mortal>.
 
 =cut
 */
@@ -6099,8 +6101,9 @@ Perl_sv_newmortal(pTHX)
 /*
 =for apidoc sv_2mortal
 
-Marks an existing SV as mortal.  The SV will be destroyed when the current
-context ends. See also C<sv_newmortal> and C<sv_mortalcopy>.
+Marks an existing SV as mortal.  The SV will be destroyed "soon", either
+by an explicit call to FREETMPS, or by an implicit call at places such as
+statement boundaries.  See also C<sv_newmortal> and C<sv_mortalcopy>.
 
 =cut
 */
@@ -8400,6 +8403,10 @@ Perl_re_dup(pTHX_ REGEXP *r, clone_params *param)
 		ret->regstclass = (regnode*)d->data[i];
 		break;
 	    case 'o':
+		/* Compiled op trees are readonly, and can thus be
+		   shared without duplication. */
+		d->data[i] = (void*)OpREFCNT_inc((OP*)r->data->data[i]);
+		break;
 	    case 'n':
 		d->data[i] = r->data->data[i];
 		break;
@@ -9083,6 +9090,11 @@ Perl_sv_dup(pTHX_ SV *sstr, clone_params* param)
 	CvROOT(dstr)	= OpREFCNT_inc(CvROOT(sstr));
 	CvXSUB(dstr)	= CvXSUB(sstr);
 	CvXSUBANY(dstr)	= CvXSUBANY(sstr);
+	if (CvCONST(sstr)) {
+	    CvXSUBANY(dstr).any_ptr = GvUNIQUE(CvGV(sstr)) ?
+                SvREFCNT_inc(CvXSUBANY(sstr).any_ptr) :
+                sv_dup_inc(CvXSUBANY(sstr).any_ptr, param);
+	}
 	CvGV(dstr)	= gv_dup(CvGV(sstr), param);
 	if (param->flags & CLONEf_COPY_STACKS) {
 	  CvDEPTH(dstr)	= CvDEPTH(sstr);
@@ -9298,7 +9310,7 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, clone_params* param)
     GP *gp;
     IV iv;
     I32 i;
-    char *c;
+    char *c = NULL;
     void (*dptr) (void*);
     void (*dxptr) (pTHXo_ void*);
     OP *o;
@@ -9924,7 +9936,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_origalen		= proto_perl->Iorigalen;
     PL_pidstatus	= newHV();			/* XXX flag for cloning? */
     PL_osname		= SAVEPV(proto_perl->Iosname);
-    PL_sh_path		= SAVEPV(proto_perl->Ish_path);
+    PL_sh_path		= proto_perl->Ish_path; /* XXX never deallocated */
     PL_sighandlerp	= proto_perl->Isighandlerp;
 
 
@@ -9934,7 +9946,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
 #ifdef CSH
     PL_cshlen		= proto_perl->Icshlen;
-    PL_cshname		= SAVEPVN(proto_perl->Icshname, PL_cshlen);
+    PL_cshname		= proto_perl->Icshname; /* XXX never deallocated */
 #endif
 
     PL_lex_state	= proto_perl->Ilex_state;
@@ -10265,6 +10277,9 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_reginterp_cnt	= 0;
     PL_reg_starttry	= 0;
 
+    /* Pluggable optimizer */
+    PL_peepp		= proto_perl->Tpeepp;
+
     if (!(flags & CLONEf_KEEP_PTR_TABLE)) {
         ptr_table_free(PL_ptr_table);
         PL_ptr_table = NULL;