[perl #6828] Set $AUTOLOAD once more for XS autoloading
authorFather Chrysostomos <sprout@cpan.org>
Wed, 12 Oct 2011 04:35:00 +0000 (21:35 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Wed, 12 Oct 2011 04:35:00 +0000 (21:35 -0700)
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 (05b525f43d5f9785
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


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.


index 5736a7b..d1d3fc0 100644 (file)
@@ -3248,11 +3248,10 @@ int
     SV* comms;
-    STRLEN len;
     SV* class_and_method;
     SV* tmp;
-    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;
index a791e85..bb670e9 100644 (file)
@@ -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 (file)
--- 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);
-        return gv;