SvTYPE(SvRV(sstr)) == SVt_PVGV) {
sstr = SvRV(sstr);
if (sstr == dstr) {
- if (PL_curcop->cop_stash != GvSTASH(dstr))
+ if (GvIMPORTED(dstr) != GVf_IMPORTED
+ && CopSTASH(PL_curcop) != GvSTASH(dstr))
+ {
GvIMPORTED_on(dstr);
+ }
GvMULTI_on(dstr);
return;
}
gp_free((GV*)dstr);
GvGP(dstr) = gp_ref(GvGP(sstr));
SvTAINT(dstr);
- if (PL_curcop->cop_stash != GvSTASH(dstr))
+ if (GvIMPORTED(dstr) != GVf_IMPORTED
+ && CopSTASH(PL_curcop) != GvSTASH(dstr))
+ {
GvIMPORTED_on(dstr);
+ }
GvMULTI_on(dstr);
return;
}
else
dref = (SV*)GvAV(dstr);
GvAV(dstr) = (AV*)sref;
- if (PL_curcop->cop_stash != GvSTASH(dstr))
+ if (GvIMPORTED_AV_off(dstr)
+ && CopSTASH(PL_curcop) != GvSTASH(dstr))
+ {
GvIMPORTED_AV_on(dstr);
+ }
break;
case SVt_PVHV:
if (intro)
else
dref = (SV*)GvHV(dstr);
GvHV(dstr) = (HV*)sref;
- if (PL_curcop->cop_stash != GvSTASH(dstr))
+ if (GvIMPORTED_HV_off(dstr)
+ && CopSTASH(PL_curcop) != GvSTASH(dstr))
+ {
GvIMPORTED_HV_on(dstr);
+ }
break;
case SVt_PVCV:
if (intro) {
GvASSUMECV_on(dstr);
PL_sub_generation++;
}
- if (PL_curcop->cop_stash != GvSTASH(dstr))
+ if (GvIMPORTED_CV_off(dstr)
+ && CopSTASH(PL_curcop) != GvSTASH(dstr))
+ {
GvIMPORTED_CV_on(dstr);
+ }
break;
case SVt_PVIO:
if (intro)
else
dref = (SV*)GvSV(dstr);
GvSV(dstr) = sref;
- if (PL_curcop->cop_stash != GvSTASH(dstr))
+ if (GvIMPORTED_SV_off(dstr)
+ && CopSTASH(PL_curcop) != GvSTASH(dstr))
+ {
GvIMPORTED_SV_on(dstr);
+ }
break;
}
if (dref)
/* SIZE */
switch (*q) {
-#ifdef Quad_t
+#ifdef HAS_QUAD
case 'L': /* Ld */
case 'q': /* qd */
intsize = 'q';
break;
#endif
case 'l':
-#ifdef Quad_t
+#ifdef HAS_QUAD
if (*(q + 1) == 'l') { /* lld */
intsize = 'q';
q += 2;
if (args) {
eptr = va_arg(*args, char*);
if (eptr)
+#ifdef MACOS_TRADITIONAL
+ /* On MacOS, %#s format is used for Pascal strings */
+ if (alt)
+ elen = *eptr++;
+ else
+#endif
elen = strlen(eptr);
else {
eptr = nullstr;
default: iv = va_arg(*args, int); break;
case 'l': iv = va_arg(*args, long); break;
case 'V': iv = va_arg(*args, IV); break;
-#ifdef Quad_t
+#ifdef HAS_QUAD
case 'q': iv = va_arg(*args, Quad_t); break;
#endif
}
default: iv = (int)iv; break;
case 'l': iv = (long)iv; break;
case 'V': break;
-#ifdef Quad_t
+#ifdef HAS_QUAD
case 'q': iv = (Quad_t)iv; break;
#endif
}
default: uv = va_arg(*args, unsigned); break;
case 'l': uv = va_arg(*args, unsigned long); break;
case 'V': uv = va_arg(*args, UV); break;
-#ifdef Quad_t
+#ifdef HAS_QUAD
case 'q': uv = va_arg(*args, Quad_t); break;
#endif
}
default: uv = (unsigned)uv; break;
case 'l': uv = (unsigned long)uv; break;
case 'V': break;
-#ifdef Quad_t
+#ifdef HAS_QUAD
case 'q': uv = (Quad_t)uv; break;
#endif
}
default: *(va_arg(*args, int*)) = i; break;
case 'l': *(va_arg(*args, long*)) = i; break;
case 'V': *(va_arg(*args, IV*)) = i; break;
-#ifdef Quad_t
+#ifdef HAS_QUAD
case 'q': *(va_arg(*args, Quad_t*)) = i; break;
#endif
}
#endif
#ifndef OpREFCNT_inc
-# define OpREFCNT_inc(o) o
+# 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
+
+
#define sv_dup_inc(s) SvREFCNT_inc(sv_dup(s))
#define av_dup(s) (AV*)sv_dup((SV*)s)
#define av_dup_inc(s) (AV*)SvREFCNT_inc(sv_dup((SV*)s))
GP *ret;
if (!gp)
return (GP*)NULL;
+ /* look for it in the table first */
+ ret = (GP*)sv_table_fetch(PL_sv_table, (SV*)gp);
+ if (ret)
+ return ret;
+
+ /* create anew and remember what it is */
Newz(0, ret, 1, GP);
+ sv_table_store(PL_sv_table, (SV*)gp, (SV*)ret);
+
+ /* clone */
ret->gp_sv = sv_dup_inc(gp->gp_sv);
ret->gp_io = io_dup_inc(gp->gp_io);
ret->gp_form = cv_dup_inc(gp->gp_form);
ret->gp_av = av_dup_inc(gp->gp_av);
ret->gp_hv = hv_dup_inc(gp->gp_hv);
- ret->gp_egv = gv_dup_inc(gp->gp_egv);
+ ret->gp_egv = 0;
ret->gp_cv = cv_dup_inc(gp->gp_cv);
ret->gp_cvgen = gp->gp_cvgen;
ret->gp_flags = gp->gp_flags;
MAGIC *mgprev;
if (!mg)
return (MAGIC*)NULL;
+ /* XXX need to handle aliases here? */
+
for (; mg; mg = mg->mg_moremagic) {
MAGIC *nmg;
Newz(0, nmg, 1, MAGIC);
nmg->mg_len = mg->mg_len;
nmg->mg_ptr = mg->mg_ptr; /* XXX random ptr? */
if (mg->mg_ptr && mg->mg_type != 'g') {
- if (mg->mg_len >= 0)
+ if (mg->mg_len >= 0) {
nmg->mg_ptr = SAVEPVN(mg->mg_ptr, mg->mg_len);
+ if (mg->mg_type == 'c' && AMT_AMAGIC((AMT*)mg->mg_ptr)) {
+ AMT *amtp = (AMT*)mg->mg_ptr;
+ AMT *namtp = (AMT*)nmg->mg_ptr;
+ I32 i;
+ for (i = 1; i < NofAMmeth; i++) {
+ namtp->table[i] = cv_dup_inc(amtp->table[i]);
+ }
+ }
+ }
else if (mg->mg_len == HEf_SVKEY)
nmg->mg_ptr = (char*)sv_dup_inc((SV*)mg->mg_ptr);
}
}
}
+#ifdef DEBUGGING
+DllExport char *PL_watch_pvx;
+#endif
+
SV *
Perl_sv_dup(pTHX_ SV *sstr)
{
int stype;
SV *dstr;
- if (!sstr)
+ if (!sstr || SvTYPE(sstr) == SVTYPEMASK)
return Nullsv;
/* look for it in the table first */
dstr = sv_table_fetch(PL_sv_table, sstr);
SvFLAGS(dstr) &= ~SVf_OOK; /* don't propagate OOK hack */
SvREFCNT(dstr) = 0;
+#ifdef DEBUGGING
+ if (SvANY(sstr) && PL_watch_pvx && SvPVX(sstr) == PL_watch_pvx)
+ PerlIO_printf(Perl_debug_log, "watch at %p hit, found string \"%s\"\n",
+ PL_watch_pvx, SvPVX(sstr));
+#endif
+
switch (SvTYPE(sstr)) {
case SVt_NULL:
SvANY(dstr) = NULL;
SvANY(dstr) = new_XPV();
SvCUR(dstr) = SvCUR(sstr);
SvLEN(dstr) = SvLEN(sstr);
- if (SvPOKp(sstr) && SvLEN(sstr))
- SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+ if (SvROK(sstr))
+ SvRV(dstr) = sv_dup_inc(SvRV(sstr));
+ else if (SvPVX(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
else
SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
break;
SvCUR(dstr) = SvCUR(sstr);
SvLEN(dstr) = SvLEN(sstr);
SvIVX(dstr) = SvIVX(sstr);
- if (SvPOKp(sstr) && SvLEN(sstr))
- SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+ if (SvROK(sstr))
+ SvRV(dstr) = sv_dup_inc(SvRV(sstr));
+ else if (SvPVX(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
else
SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
break;
SvLEN(dstr) = SvLEN(sstr);
SvIVX(dstr) = SvIVX(sstr);
SvNVX(dstr) = SvNVX(sstr);
- if (SvPOKp(sstr) && SvLEN(sstr))
- SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+ if (SvROK(sstr))
+ SvRV(dstr) = sv_dup_inc(SvRV(sstr));
+ else if (SvPVX(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
else
SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
break;
SvIVX(dstr) = SvIVX(sstr);
SvNVX(dstr) = SvNVX(sstr);
SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr));
- if (SvSMAGICAL(sstr) && mg_find(sstr, 'l'))
- SvSTASH(dstr) = SvSTASH(sstr); /* COP* in disguise */
- else
- SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
- if (SvPOKp(sstr) && SvLEN(sstr))
- SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+ SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
+ if (SvROK(sstr))
+ SvRV(dstr) = sv_dup_inc(SvRV(sstr));
+ else if (SvPVX(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
else
SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
break;
SvIVX(dstr) = SvIVX(sstr);
SvNVX(dstr) = SvNVX(sstr);
SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr));
- if (SvSMAGICAL(sstr) && mg_find(sstr, 'l'))
- SvSTASH(dstr) = SvSTASH(sstr); /* COP* in disguise */
- else
- SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
- if (SvPOKp(sstr) && SvLEN(sstr))
+ SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
+ if (SvROK(sstr))
+ SvRV(dstr) = sv_dup_inc(SvRV(sstr));
+ else if (SvPVX(sstr) && SvLEN(sstr))
SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
else
SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
SvIVX(dstr) = SvIVX(sstr);
SvNVX(dstr) = SvNVX(sstr);
SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr));
- if (SvSMAGICAL(sstr) && mg_find(sstr, 'l'))
- SvSTASH(dstr) = SvSTASH(sstr); /* COP* in disguise */
- else
- SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
- if (SvPOKp(sstr) && SvLEN(sstr))
- SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+ SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
+ if (SvROK(sstr))
+ SvRV(dstr) = sv_dup_inc(SvRV(sstr));
+ else if (SvPVX(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
else
SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
LvTARGOFF(dstr) = LvTARGOFF(sstr); /* XXX sometimes holds PMOP* when DEBUGGING */
SvIVX(dstr) = SvIVX(sstr);
SvNVX(dstr) = SvNVX(sstr);
SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr));
- if (SvSMAGICAL(sstr) && mg_find(sstr, 'l'))
- SvSTASH(dstr) = SvSTASH(sstr); /* COP* in disguise */
- else
- SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
- if (SvPOKp(sstr) && SvLEN(sstr))
- SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+ SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
+ if (SvROK(sstr))
+ SvRV(dstr) = sv_dup_inc(SvRV(sstr));
+ else if (SvPVX(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
else
SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
GvNAMELEN(dstr) = GvNAMELEN(sstr);
GvSTASH(dstr) = hv_dup_inc(GvSTASH(sstr));
GvFLAGS(dstr) = GvFLAGS(sstr);
GvGP(dstr) = gp_dup(GvGP(sstr));
- GvGP(dstr)->gp_refcnt++;
+ (void)GpREFCNT_inc(GvGP(dstr));
+ if (GvEGV(sstr) == (GV*)sstr)
+ GvEGV(dstr) = (GV*)dstr;
+ else
+ GvEGV(dstr) = gv_dup_inc(GvEGV(sstr));
break;
case SVt_PVIO:
SvANY(dstr) = new_XPVIO();
SvIVX(dstr) = SvIVX(sstr);
SvNVX(dstr) = SvNVX(sstr);
SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr));
- if (SvSMAGICAL(sstr) && mg_find(sstr, 'l'))
- SvSTASH(dstr) = SvSTASH(sstr); /* COP* in disguise */
- else
- SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
- if (SvPOKp(sstr) && SvLEN(sstr))
- SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+ SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
+ if (SvROK(sstr))
+ SvRV(dstr) = sv_dup_inc(SvRV(sstr));
+ else if (SvPVX(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
else
SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
IoIFP(dstr) = fp_dup(IoIFP(sstr), IoTYPE(sstr));
else
dxhv->xhv_eiter = (HE*)NULL;
}
- else
+ else {
SvPVX(dstr) = Nullch;
+ HvEITER((HV*)dstr) = (HE*)NULL;
+ }
HvPMROOT((HV*)dstr) = HvPMROOT((HV*)sstr); /* XXX */
HvNAME((HV*)dstr) = SAVEPV(HvNAME((HV*)sstr));
break;
SvIVX(dstr) = SvIVX(sstr);
SvNVX(dstr) = SvNVX(sstr);
SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr));
- if (SvSMAGICAL(sstr) && mg_find(sstr, 'l'))
- SvSTASH(dstr) = SvSTASH(sstr); /* COP* in disguise */
- else
- SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
- if (SvPOKp(sstr) && SvLEN(sstr))
- SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+ SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
+ if (SvPVX(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
else
SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
CvSTASH(dstr) = hv_dup(CvSTASH(sstr));/* NOTE: not refcounted */
CvXSUBANY(dstr) = CvXSUBANY(sstr);
CvGV(dstr) = gv_dup_inc(CvGV(sstr));
CvDEPTH(dstr) = CvDEPTH(sstr);
- CvPADLIST(dstr) = av_dup_inc(CvPADLIST(sstr));
+ if (CvPADLIST(sstr) && !AvREAL(CvPADLIST(sstr))) {
+ /* XXX padlists are real, but pretend to be not */
+ AvREAL_on(CvPADLIST(sstr));
+ CvPADLIST(dstr) = av_dup_inc(CvPADLIST(sstr));
+ AvREAL_off(CvPADLIST(sstr));
+ AvREAL_off(CvPADLIST(dstr));
+ }
+ else
+ CvPADLIST(dstr) = av_dup_inc(CvPADLIST(sstr));
CvOUTSIDE(dstr) = cv_dup_inc(CvOUTSIDE(sstr));
CvFLAGS(dstr) = CvFLAGS(sstr);
break;
PERL_SET_INTERP(my_perl);
#ifdef DEBUGGING
- memset(my_perl, 0xab, sizeof(PerlInterpreter));
+ memset(my_perl, 0x0, sizeof(PerlInterpreter));
PL_markstack = 0;
PL_scopestack = 0;
PL_savestack = 0;
sv_table_store(PL_sv_table, (SV*)proto_perl->Istrtab, (SV*)PL_strtab);
PL_compiling = proto_perl->Icompiling;
- PL_compiling.cop_stash = hv_dup(PL_compiling.cop_stash);
+ PL_compiling.cop_stashpv = SAVEPV(PL_compiling.cop_stashpv);
PL_compiling.cop_file = SAVEPV(PL_compiling.cop_file);
- PL_compiling.cop_warnings = sv_dup_inc(PL_compiling.cop_warnings);
+ if (!specialWARN(PL_compiling.cop_warnings))
+ PL_compiling.cop_warnings = sv_dup_inc(PL_compiling.cop_warnings);
if (proto_perl->Tcurcop == &proto_perl->Icompiling)
PL_curcop = &PL_compiling;
else
PL_forkprocess = proto_perl->Iforkprocess;
/* subprocess state */
- PL_fdpid = av_dup(proto_perl->Ifdpid);
+ PL_fdpid = av_dup_inc(proto_perl->Ifdpid);
/* internal state */
PL_tainting = proto_perl->Itainting;
}
else
PL_exitlist = (PerlExitListEntry*)NULL;
- PL_modglobal = hv_dup(proto_perl->Imodglobal);
+ PL_modglobal = hv_dup_inc(proto_perl->Imodglobal);
PL_profiledata = NULL; /* XXX */
PL_rsfp = fp_dup(proto_perl->Irsfp, '<');
/* XXX PL_rsfp_filters entries have fake IoDIRP() */
- PL_rsfp_filters = av_dup(proto_perl->Irsfp_filters);
+ PL_rsfp_filters = av_dup_inc(proto_perl->Irsfp_filters);
PL_compcv = cv_dup(proto_perl->Icompcv);
PL_comppad = av_dup(proto_perl->Icomppad);
PL_comppad_name = av_dup(proto_perl->Icomppad_name);
PL_comppad_name_fill = proto_perl->Icomppad_name_fill;
PL_comppad_name_floor = proto_perl->Icomppad_name_floor;
- PL_curpad = AvARRAY(PL_comppad); /* XXX */
+ PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : (SV**)NULL;
#ifdef HAVE_INTERP_INTERN
sys_intern_dup(&proto_perl->Isys_intern, &PL_sys_intern);
PL_statbuf = proto_perl->Tstatbuf;
PL_statcache = proto_perl->Tstatcache;
PL_statgv = gv_dup(proto_perl->Tstatgv);
- PL_statname = sv_dup(proto_perl->Tstatname);
+ PL_statname = sv_dup_inc(proto_perl->Tstatname);
#ifdef HAS_TIMES
PL_timesbuf = proto_perl->Ttimesbuf;
#endif
projects / p5sagit/p5-mst-13.2.git / blobdiff