Make SUPER:: in main less sensitive
authorFather Chrysostomos <sprout@cpan.org>
Fri, 14 Sep 2012 20:13:30 +0000 (13:13 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sat, 15 Sep 2012 05:29:47 +0000 (22:29 -0700)
$ perl -e '$main::SUPER::; sub bar::bar{} @ISA = bar; main->SUPER::bar'
$ perl -e '$SUPER::; sub bar::bar{} @ISA = bar; main->SUPER::bar'
Can't locate object method "bar" via package "main" at -e line 1.

(That’s 5.10.1.  More recent perls say package "SUPER".)

The only differnce that $SUPER:: variable makes is the name of
the SUPER:: package.  It ends up being called SUPER instead of
main::SUPER.

This causes problems because gv_fetchmeth_pvn, seeing a package end-
ing in ::SUPER, strips off the ::SUPER before doing isa lookup.

But SUPER does not end in ::SUPER, so this commit adjusts
gv_fetchmeth_pvn to account.

gv.c
t/op/method.t

diff --git a/gv.c b/gv.c
index e29f2fd..71b9ec9 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -692,10 +692,12 @@ Perl_gv_fetchmeth_pvn(pTHX_ HV *stash, const char *name, STRLEN len, I32 level,
     }
 
     packlen = HvNAMELEN_get(stash);
-    if (packlen >= 7 && strEQ(hvname + packlen - 7, "::SUPER")) {
+    if ((packlen >= 7 && strEQ(hvname + packlen - 7, "::SUPER"))
+     || (packlen == 5 && strEQ(hvname, "SUPER"))) {
         HV* basestash;
-        packlen -= 7;
-        basestash = gv_stashpvn(hvname, packlen,
+        basestash = packlen == 5
+                    ? PL_defstash
+                    : gv_stashpvn(hvname, packlen - 7,
                                 GV_ADD | (HvNAMEUTF8(stash) ? SVf_UTF8 : 0));
         linear_av = mro_get_linear_isa(basestash);
     }
index d0bd64c..5b8c1ee 100644 (file)
@@ -13,7 +13,7 @@ BEGIN {
 use strict;
 no warnings 'once';
 
-plan(tests => 107);
+plan(tests => 108);
 
 @A::ISA = 'B';
 @B::ISA = 'C';
@@ -243,6 +243,12 @@ sub OtherSouper::method { "Isidore Ropen, Draft Manager" }
    ::is $ret[0], 'OtherSaab',
       "->SUPER::method uses current package, not invocant";
 }  
+() = *SUPER::;
+{
+   local our @ISA = "Souper";
+   is eval { (main->SUPER::method)[0] }, 'main',
+      'Mentioning *SUPER:: does not stop ->SUPER from working in main';
+}
 
 # failed method call or UNIVERSAL::can() should not autovivify packages
 is( $::{"Foo::"} || "none", "none");  # sanity check 1