summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2013-12-04 16:00:48 -0800
committerRicardo Signes <rjbs@cpan.org>2013-12-06 21:12:39 -0500
commit5ae8e207a56f9ce452b3cddaeb271c10fbad92db (patch)
tree35f82a0844f3a2bcaa4e43f3a852c9e262800f7c
parent70c9f51eb0a9cf038adbfa00fd50ad404dbb6e3c (diff)
downloadperl-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.c3
-rw-r--r--t/op/method.t23
2 files changed, 24 insertions, 2 deletions
diff --git a/gv.c b/gv.c
index 23251940a3..4325e9f837 100644
--- a/gv.c
+++ b/gv.c
@@ -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