X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=gv.c;h=b04921894f46341f52450f2e81d898628e44215a;hb=23acf6821d640f06d65b9a368b9c4101c358376d;hp=bbe8d47a5b6ff96379a0da7e4ed299c5571ee1b4;hpb=497b47a829dd93323de2c7f4f6815ab9f23d6ada;p=p5sagit%2Fp5-mst-13.2.git diff --git a/gv.c b/gv.c index bbe8d47..b049218 100644 --- a/gv.c +++ b/gv.c @@ -46,9 +46,9 @@ Perl_gv_IOadd(pTHX_ register GV *gv) if (!gv || SvTYPE((SV*)gv) != SVt_PVGV) Perl_croak(aTHX_ "Bad symbol for filehandle"); if (!GvIOp(gv)) { -#ifdef GV_SHARED_CHECK - if (GvSHARED(gv)) { - Perl_croak(aTHX_ "Bad symbol for filehandle (GV is shared)"); +#ifdef GV_UNIQUE_CHECK + if (GvUNIQUE(gv)) { + Perl_croak(aTHX_ "Bad symbol for filehandle (GV is unique)"); } #endif GvIOp(gv) = newIO(); @@ -938,6 +938,17 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) case '7': case '8': case '9': + /* ensures variable is only digits */ + /* ${"1foo"} fails this test (and is thus writeable) */ + /* added by japhy, but borrowed from is_gv_magical */ + + if (len > 1) { + const char *end = name + len; + while (--end > name) { + if (!isDIGIT(*end)) return gv; + } + } + ro_magicalize: SvREADONLY_on(GvSV(gv)); magicalize: @@ -1361,15 +1372,11 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) int postpr = 0, force_cpy = 0, assignshift = assign ? 1 : 0; #ifdef DEBUGGING int fl=0; - HV* stash=NULL; #endif + HV* stash=NULL; if (!(AMGf_noleft & flags) && SvAMAGIC(left) - && (mg = mg_find((SV*)( -#ifdef DEGUGGING - stash= -#endif - SvSTASH(SvRV(left))), - PERL_MAGIC_overload_table)) + && (stash = SvSTASH(SvRV(left))) + && (mg = mg_find((SV*)stash, PERL_MAGIC_overload_table)) && (ocvp = cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) ? (oamtp = amtp = (AMT*)mg->mg_ptr)->table : (CV **) NULL)) @@ -1486,12 +1493,8 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) } if (!cv) goto not_found; } else if (!(AMGf_noright & flags) && SvAMAGIC(right) - && (mg = mg_find((SV*)( -#ifdef DEBUGGING - stash= -#endif - SvSTASH(SvRV(right))), - PERL_MAGIC_overload_table)) + && (stash = SvSTASH(SvRV(right))) + && (mg = mg_find((SV*)stash, PERL_MAGIC_overload_table)) && (cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) ? (amtp = (AMT*)mg->mg_ptr)->table : (CV **) NULL)) @@ -1590,7 +1593,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) flags & AMGf_unary? "" : lr==1 ? " for right argument": " for left argument", flags & AMGf_unary? " for argument" : "", - HvNAME(stash), + stash ? HvNAME(stash) : "null", fl? ",\n\tassignment variant used": "") ); } #endif