diff options
| -rw-r--r-- | pp_hot.c | 4 | ||||
| -rw-r--r-- | sv.h | 3 | ||||
| -rw-r--r-- | universal.c | 17 |
3 files changed, 16 insertions, 8 deletions
@@ -4365,6 +4365,8 @@ Perl_vivify_ref(pTHX_ SV *sv, U32 to_what) return sv; } +extern char PL_isa_DOES[]; + PERL_STATIC_INLINE HV * S_opmethod_stash(pTHX_ SV* meth) { @@ -4443,7 +4445,7 @@ S_opmethod_stash(pTHX_ SV* meth) && SvOBJECT(ob)))) { Perl_croak(aTHX_ "Can't call method \"%"SVf"\" on unblessed reference", - SVfARG((SvSCREAM(meth) && strEQ(SvPV_nolen_const(meth),"isa")) + SVfARG((SvPVX(meth) == PL_isa_DOES) ? newSVpvs_flags("DOES", SVs_TEMP) : meth)); } @@ -369,7 +369,7 @@ perform the upgrade if necessary. See C<L</svtype>>. #define SVp_IOK 0x00001000 /* has valid non-public integer value */ #define SVp_NOK 0x00002000 /* has valid non-public numeric value */ #define SVp_POK 0x00004000 /* has valid non-public pointer value */ -#define SVp_SCREAM 0x00008000 /* method name is DOES */ +#define SVp_SCREAM 0x00008000 /* currently unused on plain scalars */ #define SVphv_CLONEABLE SVp_SCREAM /* PVHV (stashes) clone its objects */ #define SVpgv_GP SVp_SCREAM /* GV has a valid GP */ #define SVprv_PCS_IMPORTED SVp_SCREAM /* RV is a proxy for a constant @@ -443,7 +443,6 @@ perform the upgrade if necessary. See C<L</svtype>>. SVf_POK, SVp_POK also set: 0x00004400 Normal - 0x0000C400 method name for DOES (SvSCREAM) 0x40004400 FBM compiled (SvVALID) 0x4000C400 *** Formerly used for pad names *** diff --git a/universal.c b/universal.c index 345b75e815..b88d3e22d3 100644 --- a/universal.c +++ b/universal.c @@ -184,6 +184,10 @@ The SV can be a Perl object or the name of a Perl class. #include "XSUB.h" +/* a special string address whose value is "isa", but whicb perl knows + * to treat as if it were really "DOES" */ +char PL_isa_DOES[] = "isa"; + bool Perl_sv_does_sv(pTHX_ SV *sv, SV *namesv, U32 flags) { @@ -222,11 +226,14 @@ Perl_sv_does_sv(pTHX_ SV *sv, SV *namesv, U32 flags) PUSHs(namesv); PUTBACK; - methodname = newSVpvs_flags("isa", SVs_TEMP); - /* ugly hack: use the SvSCREAM flag so S_method_common - * can figure out we're calling DOES() and not isa(), - * and report eventual errors correctly. --rgs */ - SvSCREAM_on(methodname); + /* create a PV with value "isa", but with a special address + * so that perl knows were' realling doing "DOES" instead */ + methodname = newSV_type(SVt_PV); + SvLEN(methodname) = 0; + SvCUR(methodname) = strlen(PL_isa_DOES); + SvPVX(methodname) = PL_isa_DOES; + SvPOK_on(methodname); + sv_2mortal(methodname); call_sv(methodname, G_SCALAR | G_METHOD); SPAGAIN; |