diff options
| -rw-r--r-- | doio.c | 6 | ||||
| -rw-r--r-- | embed.h | 3 | ||||
| -rwxr-xr-x | embed.pl | 1 | ||||
| -rw-r--r-- | global.sym | 1 | ||||
| -rw-r--r-- | objXSUB.h | 4 | ||||
| -rw-r--r-- | pp.c | 26 | ||||
| -rw-r--r-- | pp_hot.c | 14 | ||||
| -rw-r--r-- | proto.h | 2 | ||||
| -rw-r--r-- | scope.c | 8 | ||||
| -rw-r--r-- | sv.c | 71 | ||||
| -rw-r--r-- | sv.h | 2 |
11 files changed, 36 insertions, 102 deletions
@@ -1615,12 +1615,6 @@ do_msgrcv(SV **mark, SV **sp) msize = SvIVx(*++mark); mtype = (long)SvIVx(*++mark); flags = SvIVx(*++mark); - if (SvTHINKFIRST(mstr)) { - if (SvREADONLY(mstr)) - croak("Can't msgrcv to readonly var"); - if (SvROK(mstr)) - sv_unref(mstr); - } SvPV_force(mstr, len); mbuf = SvGROW(mstr, sizeof(long)+msize+1); @@ -868,6 +868,7 @@ #define sv_derived_from Perl_sv_derived_from #define sv_dump Perl_sv_dump #define sv_eq Perl_sv_eq +#define sv_force_normal Perl_sv_force_normal #define sv_free Perl_sv_free #define sv_free_arenas Perl_sv_free_arenas #define sv_gets Perl_sv_gets @@ -2013,7 +2014,6 @@ #define sv_catpvn_mg CPerlObj::Perl_sv_catpvn_mg #define sv_catsv CPerlObj::Perl_sv_catsv #define sv_catsv_mg CPerlObj::Perl_sv_catsv_mg -#define sv_check_thinkfirst CPerlObj::Perl_sv_check_thinkfirst #define sv_chop CPerlObj::Perl_sv_chop #define sv_clean_all CPerlObj::Perl_sv_clean_all #define sv_clean_objs CPerlObj::Perl_sv_clean_objs @@ -2026,6 +2026,7 @@ #define sv_derived_from CPerlObj::Perl_sv_derived_from #define sv_dump CPerlObj::Perl_sv_dump #define sv_eq CPerlObj::Perl_sv_eq +#define sv_force_normal CPerlObj::Perl_sv_force_normal #define sv_free CPerlObj::Perl_sv_free #define sv_free_arenas CPerlObj::Perl_sv_free_arenas #define sv_gets CPerlObj::Perl_sv_gets @@ -227,7 +227,6 @@ my @staticfuncs = qw( del_xrv sv_mortalgrow sv_unglob - sv_check_thinkfirst avhv_index_sv do_report_used do_clean_objs diff --git a/global.sym b/global.sym index 89199578f6..881ee764bc 100644 --- a/global.sym +++ b/global.sym @@ -515,6 +515,7 @@ sv_dec sv_derived_from sv_dump sv_eq +sv_force_normal sv_free sv_free_arenas sv_gets @@ -2893,8 +2893,6 @@ #define sv_catsv pPerl->Perl_sv_catsv #undef sv_catsv_mg #define sv_catsv_mg pPerl->Perl_sv_catsv_mg -#undef sv_check_thinkfirst -#define sv_check_thinkfirst pPerl->Perl_sv_check_thinkfirst #undef sv_chop #define sv_chop pPerl->Perl_sv_chop #undef sv_clean_all @@ -2919,6 +2917,8 @@ #define sv_dump pPerl->Perl_sv_dump #undef sv_eq #define sv_eq pPerl->Perl_sv_eq +#undef sv_force_normal +#define sv_force_normal pPerl->Perl_sv_force_normal #undef sv_free #define sv_free pPerl->Perl_sv_free #undef sv_free_arenas @@ -792,15 +792,8 @@ PP(pp_undef) if (!sv) RETPUSHUNDEF; - if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv)) { - dTHR; - if (PL_curcop != &PL_compiling) - croak(PL_no_modify); - } - if (SvROK(sv)) - sv_unref(sv); - } + if (SvTHINKFIRST(sv)) + sv_force_normal(sv); switch (SvTYPE(sv)) { case SVt_NULL: @@ -817,9 +810,12 @@ PP(pp_undef) CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv))); /* FALL THROUGH */ case SVt_PVFM: - { GV* gv = (GV*)SvREFCNT_inc(CvGV((CV*)sv)); - cv_undef((CV*)sv); - CvGV((CV*)sv) = gv; } /* let user-undef'd sub keep its identity */ + { + /* let user-undef'd sub keep its identity */ + GV* gv = (GV*)SvREFCNT_inc(CvGV((CV*)sv)); + cv_undef((CV*)sv); + CvGV((CV*)sv) = gv; + } break; case SVt_PVGV: if (SvFAKE(sv)) @@ -1037,12 +1033,6 @@ PP(pp_repeat) STRLEN len; tmpstr = POPs; - if (TARG == tmpstr && SvTHINKFIRST(tmpstr)) { - if (SvREADONLY(tmpstr) && PL_curcop != &PL_compiling) - DIE("Can't x= to readonly value"); - if (SvROK(tmpstr)) - sv_unref(tmpstr); - } SvSetSV(TARG, tmpstr); SvPV_force(TARG, len); if (count != 1) { @@ -733,16 +733,10 @@ PP(pp_aassign) } break; default: - if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv) && PL_curcop != &PL_compiling) { - if (!SvIMMORTAL(sv)) - DIE(PL_no_modify); - if (relem <= lastrelem) - relem++; - break; - } - if (SvROK(sv)) - sv_unref(sv); + if (SvIMMORTAL(sv)) { + if (relem <= lastrelem) + relem++; + break; } if (relem <= lastrelem) { sv_setsv(sv, *relem); @@ -717,7 +717,6 @@ void del_xpv _((XPV* p)); void del_xrv _((XRV* p)); void sv_mortalgrow _((void)); void sv_unglob _((SV* sv)); -void sv_check_thinkfirst _((SV *sv)); I32 avhv_index_sv _((SV* sv)); void do_report_used _((SV *sv)); @@ -967,3 +966,4 @@ VIRTUAL void magic_dump _((MAGIC *mg)); VIRTUAL void reginitcolors _((void)); VIRTUAL char* sv_2pv_nolen _((SV* sv)); VIRTUAL char* sv_pv _((SV *sv)); +VIRTUAL void sv_force_normal _((SV *sv)); @@ -742,12 +742,8 @@ leave_scope(I32 base) sv = *(SV**)ptr; /* Can clear pad variable in place? */ if (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) { - if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv)) - croak("panic: leave_scope clearsv"); - if (SvROK(sv)) - sv_unref(sv); - } + if (SvTHINKFIRST(sv)) + sv_force_normal(sv); if (SvMAGICAL(sv)) mg_free(sv); @@ -59,7 +59,6 @@ static void del_xpv _((XPV* p)); static void del_xrv _((XRV* p)); static void sv_mortalgrow _((void)); static void sv_unglob _((SV* sv)); -static void sv_check_thinkfirst _((SV *sv)); #ifndef PURIFY static void *my_safemalloc(MEM_SIZE size); @@ -71,7 +70,7 @@ typedef void (*SVFUNC) _((SV*)); #endif /* PERL_OBJECT */ -#define SV_CHECK_THINKFIRST(sv) if (SvTHINKFIRST(sv)) sv_check_thinkfirst(sv) +#define SV_CHECK_THINKFIRST(sv) if (SvTHINKFIRST(sv)) sv_force_normal(sv) #ifdef PURIFY @@ -1002,11 +1001,6 @@ sv_setiv(register SV *sv, IV i) break; case SVt_PVGV: - if (SvFAKE(sv)) { - sv_unglob(sv); - break; - } - /* FALL THROUGH */ case SVt_PVAV: case SVt_PVHV: case SVt_PVCV: @@ -1062,11 +1056,6 @@ sv_setnv(register SV *sv, double num) break; case SVt_PVGV: - if (SvFAKE(sv)) { - sv_unglob(sv); - break; - } - /* FALL THROUGH */ case SVt_PVAV: case SVt_PVHV: case SVt_PVCV: @@ -1810,13 +1799,6 @@ sv_setsv(SV *dstr, register SV *sstr) stype = SvTYPE(sstr); dtype = SvTYPE(dstr); - if (dtype == SVt_PVGV && (SvFLAGS(dstr) & SVf_FAKE)) { - sv_unglob(dstr); /* so fake GLOB won't perpetuate */ - sv_setpvn(dstr, "", 0); - (void)SvPOK_only(dstr); - dtype = SvTYPE(dstr); - } - SvAMAGIC_off(dstr); /* There's a lot of redundancy below but we're going for speed here */ @@ -1949,9 +1931,9 @@ sv_setsv(SV *dstr, register SV *sstr) } } if (stype == SVt_PVLV) - SvUPGRADE(dstr, SVt_PVNV); + (void)SvUPGRADE(dstr, SVt_PVNV); else - SvUPGRADE(dstr, stype); + (void)SvUPGRADE(dstr, stype); } sflags = SvFLAGS(sstr); @@ -2183,12 +2165,7 @@ sv_setpvn(register SV *sv, register const char *ptr, register STRLEN len) (void)SvOK_off(sv); return; } - if (SvTYPE(sv) >= SVt_PV) { - if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV) - sv_unglob(sv); - } - else - sv_upgrade(sv, SVt_PV); + (void)SvUPGRADE(sv, SVt_PV); SvGROW(sv, len + 1); dptr = SvPVX(sv); @@ -2217,12 +2194,7 @@ sv_setpv(register SV *sv, register const char *ptr) return; } len = strlen(ptr); - if (SvTYPE(sv) >= SVt_PV) { - if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV) - sv_unglob(sv); - } - else - sv_upgrade(sv, SVt_PV); + (void)SvUPGRADE(sv, SVt_PV); SvGROW(sv, len + 1); Move(ptr,SvPVX(sv),len+1,char); @@ -2266,8 +2238,8 @@ sv_usepvn_mg(register SV *sv, register char *ptr, register STRLEN len) SvSETMAGIC(sv); } -STATIC void -sv_check_thinkfirst(register SV *sv) +void +sv_force_normal(register SV *sv) { if (SvREADONLY(sv)) { dTHR; @@ -2276,6 +2248,8 @@ sv_check_thinkfirst(register SV *sv) } if (SvROK(sv)) sv_unref(sv); + else if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV) + sv_unglob(sv); } void @@ -3176,12 +3150,7 @@ sv_gets(register SV *sv, register PerlIO *fp, I32 append) I32 i; SV_CHECK_THINKFIRST(sv); - if (SvTYPE(sv) >= SVt_PV) { - if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV) - sv_unglob(sv); - } - else - sv_upgrade(sv, SVt_PV); + (void)SvUPGRADE(sv, SVt_PV); SvSCREAM_off(sv); @@ -4016,27 +3985,17 @@ sv_pvn_force(SV *sv, STRLEN *lp) { char *s; - if (SvREADONLY(sv)) { - dTHR; - if (PL_curcop != &PL_compiling) - croak(PL_no_modify); - } + if (SvTHINKFIRST(sv) && !SvROK(sv)) + sv_force_normal(sv); if (SvPOK(sv)) { *lp = SvCUR(sv); } else { if (SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM) { - if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV) { - sv_unglob(sv); - s = SvPVX(sv); - *lp = SvCUR(sv); - } - else { - dTHR; - croak("Can't coerce %s to string in %s", sv_reftype(sv,0), - PL_op_name[PL_op->op_type]); - } + dTHR; + croak("Can't coerce %s to string in %s", sv_reftype(sv,0), + PL_op_name[PL_op->op_type]); } else s = sv_2pv(sv, lp); @@ -137,7 +137,7 @@ struct io { #define SVf_BREAK 0x00400000 /* refcnt is artificially low */ #define SVf_READONLY 0x00800000 /* may not be modified */ -#define SVf_THINKFIRST (SVf_READONLY|SVf_ROK) +#define SVf_THINKFIRST (SVf_READONLY|SVf_ROK|SVf_FAKE) #define SVp_IOK 0x01000000 /* has valid non-public integer value */ #define SVp_NOK 0x02000000 /* has valid non-public numeric value */ |