This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
remove DOES's usage of SvSCREAM
authorDavid Mitchell <davem@iabyn.com>
Thu, 10 Nov 2016 20:44:16 +0000 (20:44 +0000)
committerDavid Mitchell <davem@iabyn.com>
Sat, 12 Nov 2016 16:15:09 +0000 (16:15 +0000)
Currently the SvSCREAM flag is set on a temporary SV whose string value
is "isa", but where for the purposes of printing

    Can't call method "XXX"

its name is treated as "DOES" rather than "isa".

Instead, set the temp SV's PVX buffer to point to a special static
string (PL_isa_DOES) whose value is "isa", but the where the error
reporting code can compare the address with PL_isa_DOES and if so, print
"DOES" instead.

This is to reduce the number of odd special cases for the SvSCREAM flag.

pp_hot.c
sv.h
universal.c

index cc86d0a..ad0920c 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -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));
     }
diff --git a/sv.h b/sv.h
index 0c1a42d..01277af 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -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 ***
 
index 345b75e..b88d3e2 100644 (file)
@@ -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;