Make SUPER::method calls work in moved stashes

BEGIN {
  *foo:: = *bar::;
  *bar:: = *baz;
}
package foo;
@ISA = 'door';
sub door::dohtem { 'dohtem' }
warn bar->SUPER::dohtem;
__END__
Can't locate object method "dohtem" via package "bar::SUPER" at - line 8.

When gv_fetchmethod_pvn_flags looks up a package it changes SUPER to
__PACKAGE__ . "::SUPER" first.  Then gv_fetchmeth_pvn uses HvNAME on
the package and strips off the ::SUPER suffix if any, before doing
isa lookup.

The problem with using __PACKAGE__ (actually HvNAME) is that it might
not be possible to find the current stash under that name.  HvENAME
should be used instead.

The above example happens to work if @ISA is changed to ‘our @ISA’,
but that is because of an @ISA bug.

diff --git a/gv.c b/gv.c
index 71b9ec9..6b6e493 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -994,12 +994,12 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
            /* ->SUPER::method should really be looked up in original stash */
            SV * const tmpstr = sv_2mortal(Perl_newSVpvf(aTHX_
                     "%"HEKf"::SUPER",
-                     HEKfARG(HvNAME_HEK((HV*)CopSTASH(PL_curcop)))
+                     HEKfARG(HvENAME_HEK((HV*)CopSTASH(PL_curcop)))
            ));
            /* __PACKAGE__::SUPER stash should be autovivified */
            stash = gv_get_super_pkg(SvPVX_const(tmpstr), SvCUR(tmpstr), SvUTF8(tmpstr));
            DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n",
-                        origname, HvNAME_get(stash), name) );
+                        origname, HvENAME_get(stash), name) );
        }
        else {
             /* don't autovifify if ->NoSuchStash::method */

diff --git a/t/op/method.t b/t/op/method.t
index 5b8c1ee..aaa70be 100644 (file)
--- a/t/op/method.t
+++ b/t/op/method.t
@@ -13,7 +13,7 @@ BEGIN {
 use strict;
 no warnings 'once';
 
-plan(tests => 108);
+plan(tests => 109);
 
 @A::ISA = 'B';
 @B::ISA = 'C';
@@ -249,6 +249,20 @@ sub OtherSouper::method { "Isidore Ropen, Draft Manager" }
    is eval { (main->SUPER::method)[0] }, 'main',
       'Mentioning *SUPER:: does not stop ->SUPER from working in main';
 }
+{
+    BEGIN {
+        *Mover:: = *Mover2::;
+        *Mover2:: = *foo;
+    }
+    package Mover;
+    no strict;
+    # Not our(@ISA), because the bug we are testing for interacts with an
+    # our() bug that cancels this bug out.
+    @ISA = 'door';
+    sub door::dohtem { 'dohtem' }
+    ::is eval { Mover->SUPER::dohtem; }, 'dohtem',
+        'SUPER inside moved package';
+}
 
 # failed method call or UNIVERSAL::can() should not autovivify packages
 is( $::{"Foo::"} || "none", "none");  # sanity check 1