X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=sv.c;h=e78fd2eddab75271425fcd22071f7706f9d8e87f;hb=7272f7c1c568f39f233065b3b8585640a398a76e;hp=7e327d46da0830e41ea5e42480b6df2f64324062;hpb=2e5b91de24d62e1e2bf0fd32a1d4d1d849cafc82;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/sv.c b/sv.c
index 7e327d4..e78fd2e 100644
--- a/sv.c
+++ b/sv.c
@@ -1,7 +1,7 @@
 /*    sv.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -887,6 +887,11 @@ static const struct body_details bodies_by_type[] = {
     { sizeof(HE), 0, 0, SVt_NULL,
       FALSE, NONV, NOARENA, FIT_ARENA(0, sizeof(HE)) },
 
+    /* The bind placeholder pretends to be an RV for now.
+       Also it's marked as "can't upgrade" top stop anyone using it before it's
+       implemented.  */
+    { 0, 0, 0, SVt_BIND, TRUE, NONV, NOARENA, 0 },
+
     /* IVs are in the head, so the allocation size is 0.
        However, the slot is overloaded for PTEs.  */
     { sizeof(struct ptr_tbl_ent), /* This is used for PTEs.  */
@@ -904,9 +909,6 @@ static const struct body_details bodies_by_type[] = {
     /* RVs are in the head now.  */
     { 0, 0, 0, SVt_RV, FALSE, NONV, NOARENA, 0 },
 
-    /* The bind placeholder pretends to be an RV for now.  */
-    { 0, 0, 0, SVt_BIND, FALSE, NONV, NOARENA, 0 },
-
     /* 8 bytes on most ILP32 with IEEE doubles */
     { sizeof(xpv_allocated),
       copy_length(XPV, xpv_len)
@@ -4356,7 +4358,7 @@ to contain an C<SV*> and is stored as-is with its REFCNT incremented.
 =cut
 */
 MAGIC *	
-Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, MGVTBL *vtable,
+Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, const MGVTBL *vtable,
 		 const char* name, I32 namlen)
 {
     dVAR;
@@ -4418,7 +4420,7 @@ Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, MGVTBL *vtable,
 	else
 	    mg->mg_ptr = (char *) name;
     }
-    mg->mg_virtual = vtable;
+    mg->mg_virtual = (MGVTBL *) vtable;
 
     mg_magical(sv);
     if (SvGMAGICAL(sv))
@@ -4445,7 +4447,7 @@ void
 Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 namlen)
 {
     dVAR;
-    MGVTBL *vtable;
+    const MGVTBL *vtable;
     MAGIC* mg;
 
 #ifdef PERL_OLD_COPY_ON_WRITE
@@ -10296,6 +10298,7 @@ Perl_any_dup(pTHX_ void *v, const PerlInterpreter *proto_perl)
 ANY *
 Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
 {
+    dVAR;
     ANY * const ss	= proto_perl->Tsavestack;
     const I32 max	= proto_perl->Tsavestack_max;
     I32 ix		= proto_perl->Tsavestack_ix;
@@ -11040,9 +11043,17 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     if (PL_my_cxt_size) {
 	Newx(PL_my_cxt_list, PL_my_cxt_size, void *);
 	Copy(proto_perl->Imy_cxt_list, PL_my_cxt_list, PL_my_cxt_size, void *);
+#ifdef PERL_GLOBAL_STRUCT_PRIVATE
+	Newx(PL_my_cxt_keys, PL_my_cxt_size, char *);
+	Copy(proto_perl->Imy_cxt_keys, PL_my_cxt_keys, PL_my_cxt_size, char *);
+#endif
     }
-    else
+    else {
 	PL_my_cxt_list	= (void**)NULL;
+#ifdef PERL_GLOBAL_STRUCT_PRIVATE
+	PL_my_cxt_keys	= (void**)NULL;
+#endif
+    }
     PL_modglobal	= hv_dup_inc(proto_perl->Imodglobal, param);
     PL_custom_op_names  = hv_dup_inc(proto_perl->Icustom_op_names,param);
     PL_custom_op_descs  = hv_dup_inc(proto_perl->Icustom_op_descs,param);
@@ -11130,28 +11141,15 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_nexttoke		= proto_perl->Inexttoke;
 #endif
 
-    /* XXX This is probably masking the deeper issue of why
-     * SvANY(proto_perl->Ilinestr) can be NULL at this point. For test case:
-     * http://archive.develooper.com/perl5-porters%40perl.org/msg83298.html
-     * (A little debugging with a watchpoint on it may help.)
-     */
-    if (SvANY(proto_perl->Ilinestr)) {
-	PL_linestr		= sv_dup_inc(proto_perl->Ilinestr, param);
-	i = proto_perl->Ibufptr - SvPVX_const(proto_perl->Ilinestr);
-	PL_bufptr		= SvPVX(PL_linestr) + (i < 0 ? 0 : i);
-	i = proto_perl->Ioldbufptr - SvPVX_const(proto_perl->Ilinestr);
-	PL_oldbufptr	= SvPVX(PL_linestr) + (i < 0 ? 0 : i);
-	i = proto_perl->Ioldoldbufptr - SvPVX_const(proto_perl->Ilinestr);
-	PL_oldoldbufptr	= SvPVX(PL_linestr) + (i < 0 ? 0 : i);
-	i = proto_perl->Ilinestart - SvPVX_const(proto_perl->Ilinestr);
-	PL_linestart	= SvPVX(PL_linestr) + (i < 0 ? 0 : i);
-    }
-    else {
-        PL_linestr = newSV(79);
-        sv_upgrade(PL_linestr,SVt_PVIV);
-        sv_setpvn(PL_linestr,"",0);
-	PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart = SvPVX(PL_linestr);
-    }
+    PL_linestr		= sv_dup_inc(proto_perl->Ilinestr, param);
+    i = proto_perl->Ibufptr - SvPVX_const(proto_perl->Ilinestr);
+    PL_bufptr		= SvPVX(PL_linestr) + (i < 0 ? 0 : i);
+    i = proto_perl->Ioldbufptr - SvPVX_const(proto_perl->Ilinestr);
+    PL_oldbufptr	= SvPVX(PL_linestr) + (i < 0 ? 0 : i);
+    i = proto_perl->Ioldoldbufptr - SvPVX_const(proto_perl->Ilinestr);
+    PL_oldoldbufptr	= SvPVX(PL_linestr) + (i < 0 ? 0 : i);
+    i = proto_perl->Ilinestart - SvPVX_const(proto_perl->Ilinestr);
+    PL_linestart	= SvPVX(PL_linestr) + (i < 0 ? 0 : i);
     PL_bufend		= SvPVX(PL_linestr) + SvCUR(PL_linestr);
     PL_pending_ident	= proto_perl->Ipending_ident;
     PL_sublex_info	= proto_perl->Isublex_info;	/* XXX not quite right */
@@ -11167,19 +11165,11 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_subline		= proto_perl->Isubline;
     PL_subname		= sv_dup_inc(proto_perl->Isubname, param);
 
-    /* XXX See comment on SvANY(proto_perl->Ilinestr) above */
-    if (SvANY(proto_perl->Ilinestr)) {
-	i = proto_perl->Ilast_uni - SvPVX_const(proto_perl->Ilinestr);
-	PL_last_uni		= SvPVX(PL_linestr) + (i < 0 ? 0 : i);
-	i = proto_perl->Ilast_lop - SvPVX_const(proto_perl->Ilinestr);
-	PL_last_lop		= SvPVX(PL_linestr) + (i < 0 ? 0 : i);
-	PL_last_lop_op	= proto_perl->Ilast_lop_op;
-    }
-    else {
-	PL_last_uni	= SvPVX(PL_linestr);
-	PL_last_lop	= SvPVX(PL_linestr);
-	PL_last_lop_op	= 0;
-    }
+    i = proto_perl->Ilast_uni - SvPVX_const(proto_perl->Ilinestr);
+    PL_last_uni		= SvPVX(PL_linestr) + (i < 0 ? 0 : i);
+    i = proto_perl->Ilast_lop - SvPVX_const(proto_perl->Ilinestr);
+    PL_last_lop		= SvPVX(PL_linestr) + (i < 0 ? 0 : i);
+    PL_last_lop_op	= proto_perl->Ilast_lop_op;
     PL_in_my		= proto_perl->Iin_my;
     PL_in_my_stash	= hv_dup(proto_perl->Iin_my_stash, param);
 #ifdef FCRYPT
@@ -11691,8 +11681,7 @@ S_varname(pTHX_ GV *gv, const char gvtype, PADOFFSET targ,
 	    return NULL;
 	av = (AV*)(*av_fetch(CvPADLIST(cv), 0, FALSE));
 	sv = *av_fetch(av, targ, FALSE);
-	/* SvLEN in a pad name is not to be trusted */
-	sv_setpv(name, SvPV_nolen_const(sv));
+	sv_setpvn(name, SvPV_nolen_const(sv), SvCUR(sv));
     }
 
     if (subscript_type == FUV_SUBSCRIPT_HASH) {