In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/bb619f370aef1336c90dc1522addf0eff4dfd6c6?hp=120b7a08b6eec7ddfe4a829dd2b2ec5ed8612ec1>
- Log -----------------------------------------------------------------
commit bb619f370aef1336c90dc1522addf0eff4dfd6c6
Author: Father Chrysostomos <spr...@cpan.org>
Date: Tue Oct 11 21:35:00 2011 -0700
[perl #6828] Set $AUTOLOAD once more for XS autoloading
In 5.6.0, XS autoloading worked. $AUTOLOAD would be set, as with
a Perl sub.
Commit ed850460 (5.6.1) allowed âsub AUTOLOAD;â to prevent autoload
inheritance. But the code to check for that mistakenly equated an
XSUB with a forward declaration. So XS autoloading simply did not
work any more.
Then someone found it didnât work and introduced it as a ânewâ feature
in 5.8.0, with commit adb5a9ae. For efficiencyâs sake, instead of
joining the package name and sub name together, only to have the XSUB
do the same, it set the CvSTASH and SvPVX fields of the SV.
SvPVX was already being used for the subâs prototype, so 8fa6a409
(just recently) made the autoloaded sub name and the prototype play
along nicely together, with a few fix-up commits (05b525f4, 3d5f9785
and 74ee33f2).
It was only after that that I find out that $AUTOLOAD used to be set
for XSUBs. See the discussion at these two links
http://www.nntp.perl.org/group/perl.perl5.porters/;msgid=4e9468e8.8050...@cpan.org
https://rt.perl.org/rt3/Ticket/Display.html?id=72708
This commit restores the original behaviour of setting $AUTOLOAD for
XSUBs, while retaining the CvSTASH+SvPVX method as well, as it has
been documented for a while.
Steffen Müllerâs AUTOLOAD tests that I committed recently (120b7a08)
needed to be adjusted a bit. The test count was off, which was my
fault (I *thought* I had checked that.) The test XSUB was using
get_sv("AUTOLOAD"), which ended up fetching the callerâs $AUTOLOAD.
It was also using SvPV_set on an undefined scalar, which does not turn
the SvPOK flag on.
-----------------------------------------------------------------------
Summary of changes:
ext/XS-APItest/APItest.xs | 5 ++---
ext/XS-APItest/t/autoload.t | 16 +++++-----------
gv.c | 8 +++-----
3 files changed, 10 insertions(+), 19 deletions(-)
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 5736a7b..d1d3fc0 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -3248,11 +3248,10 @@ int
AUTOLOAD(...)
INIT:
SV* comms;
- STRLEN len;
SV* class_and_method;
SV* tmp;
CODE:
- class_and_method = get_sv("AUTOLOAD", 0);
+ class_and_method = GvSV(CvGV(cv));
comms = get_sv("main::the_method", 1);
if (class_and_method == NULL) {
RETVAL = 1;
@@ -3261,7 +3260,7 @@ AUTOLOAD(...)
} else if (!SvPOK(class_and_method)) {
RETVAL = 3;
} else {
- SvPV_set(comms, SvPV(class_and_method, len));
+ sv_setsv(comms, class_and_method);
RETVAL = 0;
}
OUTPUT: RETVAL
diff --git a/ext/XS-APItest/t/autoload.t b/ext/XS-APItest/t/autoload.t
index a791e85..bb670e9 100644
--- a/ext/XS-APItest/t/autoload.t
+++ b/ext/XS-APItest/t/autoload.t
@@ -7,7 +7,7 @@
use strict;
use warnings;
-use Test::More tests => 27;
+use Test::More tests => 26;
use XS::APItest;
@@ -119,20 +119,14 @@ is($the_method, 'PerlDerived::Boo',
# Test XS AUTOLOAD in base class directly
$the_method = undef;
-TODO: {
- local $TODO = 'Bug: $AUTOLOAD not set for XSUB AUTOLOADs';
- is(XS::APItest::AUTOLOADtest->Blah(), 0,
+is(XS::APItest::AUTOLOADtest->Blah(), 0,
'XS AUTOLOAD gets called and returns success');
- is($the_method, 'XS::APItest::AUTOLOADtest::Blah',
+is($the_method, 'XS::APItest::AUTOLOADtest::Blah',
'Scalar set to correct class/method name');
-}
# Test XS AUTOLOAD in derived class directly
$the_method = undef;
-TODO: {
- local $TODO = 'Bug: $AUTOLOAD not set for XSUB AUTOLOADs';
- is(Derived->Foo(), 0,
+is(Derived->Foo(), 0,
'XS AUTOLOAD gets called and returns success');
- is($the_method, 'Derived::Foo',
+is($the_method, 'Derived::Foo',
'Scalar set to correct class/method name');
-}
diff --git a/gv.c b/gv.c
index 8eb6f6b..1319970 100644
--- a/gv.c
+++ b/gv.c
@@ -1169,10 +1169,9 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name,
STRLEN len, U32 flags)
SVfARG(newSVpvn_flags(name, len, SVs_TEMP |
is_utf8)));
if (CvISXSUB(cv)) {
- /* rather than lookup/init $AUTOLOAD here
- * only to have the XSUB do another lookup for $AUTOLOAD
- * and split that value on the last '::',
- * pass along the same data via the SvPVX field in the CV
+ /* Instead of forcing the XSUB do another lookup for $AUTOLOAD
+ * and split that value on the last '::', pass along the same data
+ * via the SvPVX field in the CV, and the stash in CvSTASH.
*
* Due to an unfortunate accident of history, the SvPVX field
* serves two purposes. It is also used for the subroutineâs pro-
@@ -1220,7 +1219,6 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name,
STRLEN len, U32 flags)
else SvUTF8_off(cv);
}
CvAUTOLOAD_on(cv);
- return gv;
}
/*
--
Perl5 Master Repository
