diff options
author | Father Chrysostomos <sprout@cpan.org> | 2013-12-04 16:00:48 -0800 |
---|---|---|
committer | Ricardo Signes <rjbs@cpan.org> | 2013-12-06 21:12:39 -0500 |
commit | 5ae8e207a56f9ce452b3cddaeb271c10fbad92db (patch) | |
tree | 35f82a0844f3a2bcaa4e43f3a852c9e262800f7c | |
parent | 70c9f51eb0a9cf038adbfa00fd50ad404dbb6e3c (diff) | |
download | perl-5ae8e207a56f9ce452b3cddaeb271c10fbad92db.tar.gz |
[perl #120694] Fix ->SUPER::foo and AUTOLOAD
Commit aae438050a20 (5.17.4) broke ->SUPER::foo with AUTOLOAD by look-
ing up AUTOLOAD from the current package, rather than the current
package’s superclass.
Instead of keeping track of whether it was doing a SUPER lookup via a
::SUPER prefix on the package name, that commit changed method lookup
to pass a GV_SUPER flag around (to fix another bug) and to pass the
current stash, rather than __PACKAGE__::SUPER. But it did not update
gv_autoload_pvn to pass that flag through to gv_fetchmeth_pvn when
actually looking up the method.
(cherry picked from commit 257dc59d7b864a6cf0ccc9179de1f3f0a797f4e0)
Conflicts:
t/op/method.t
-rw-r--r-- | gv.c | 3 | ||||
-rw-r--r-- | t/op/method.t | 23 |
2 files changed, 24 insertions, 2 deletions
@@ -1123,7 +1123,8 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags) packname = sv_2mortal(newSVhek(HvNAME_HEK(stash))); if (flags & GV_SUPER) sv_catpvs(packname, "::SUPER"); } - if (!(gv = gv_fetchmeth_pvn(stash, S_autoload, S_autolen, FALSE, is_utf8))) + if (!(gv = gv_fetchmeth_pvn(stash, S_autoload, S_autolen, FALSE, + is_utf8 | (flags & GV_SUPER)))) return NULL; cv = GvCV(gv); diff --git a/t/op/method.t b/t/op/method.t index 5ed8f76149..47f639ec29 100644 --- a/t/op/method.t +++ b/t/op/method.t @@ -13,7 +13,7 @@ BEGIN { use strict; no warnings 'once'; -plan(tests => 141); +plan(tests => 142); @A::ISA = 'B'; @B::ISA = 'C'; @@ -268,6 +268,27 @@ sub OtherSouper::method { "Isidore Ropen, Draft Manager" } 'SUPER inside moved package respects method changes'; } +package foo120694 { + BEGIN { our @ISA = qw(bar120694) } + + sub AUTOLOAD { + my $self = shift; + local our $recursive = $recursive; + return "recursive" if $recursive++; + return if our $AUTOLOAD eq 'DESTROY'; + $AUTOLOAD = "SUPER:" . substr $AUTOLOAD, rindex($AUTOLOAD, ':'); + return $self->$AUTOLOAD(@_); + } +} +package bar120694 { + sub AUTOLOAD { + return "xyzzy"; + } +} +is bless( [] => "foo120694" )->plugh, 'xyzzy', + '->SUPER::method autoloading uses parent of current pkg'; + + # failed method call or UNIVERSAL::can() should not autovivify packages is( $::{"Foo::"} || "none", "none"); # sanity check 1 is( $::{"Foo::"} || "none", "none"); # sanity check 2 |