diff options
| author | Father Chrysostomos <sprout@cpan.org> | 2012-09-14 13:35:53 -0700 |
|---|---|---|
| committer | Father Chrysostomos <sprout@cpan.org> | 2012-09-14 22:29:47 -0700 |
| commit | 0308a534a635b8c34297657046d32a3f05818821 (patch) | |
| tree | 370a0f550c2b30c8c5efda2f966cd83cb8c54a23 | |
| parent | 3c104e59d83f6195ebcc80776f15604d74d666b2 (diff) | |
| download | perl-0308a534a635b8c34297657046d32a3f05818821.tar.gz | |
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.
| -rw-r--r-- | gv.c | 4 | ||||
| -rw-r--r-- | t/op/method.t | 16 |
2 files changed, 17 insertions, 3 deletions
@@ -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 5b8c1eec78..aaa70be6af 100644 --- 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 |