Welcome to 2007! Time to update copyrights from changes earlier

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

diff --git a/sv.c b/sv.c
index 7e327d4..e78fd2e 100644 (file)
--- 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) {