TODO test for $AUTOLOAD with XS AUTOLOAD
authorSteffen Mueller <smueller@cpan.org>
Wed, 12 Oct 2011 01:20:06 +0000 (18:20 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Wed, 12 Oct 2011 01:20:51 +0000 (18:20 -0700)
If an AUTOLOAD sub is an XSUB, $AUTOLOAD won't be set. This is intended
as an optimization, but $AUTOLOAD *was* set back in 5.6.0, so this is
a regression.

Committer’s note: I modified the commit message and the comments, as
the original author did not know about the autoload mechanism setting
CvSTASH.  For that matter, neither did I till yesterday.

ext/XS-APItest/APItest.pm
ext/XS-APItest/APItest.xs
ext/XS-APItest/t/autoload.t

index c6426d3..00a30de 100644 (file)
@@ -24,8 +24,8 @@ sub import {
            if ($sym_name =~ /::$/) {
                # Skip any subpackages that are clearly OO
                next if *{$glob}{HASH}{'new'};
-               # Skip AutoLoader, too, as it’s a special case
-               next if $sym_name eq 'AutoLoader::';
+               # and any that have AUTOLOAD
+               next if *{$glob}{HASH}{AUTOLOAD};
                push @stashes, "$stash_name$sym_name", *{$glob}{HASH};
            } elsif (ref $glob eq 'SCALAR' || *{$glob}{CODE}) {
                if ($exports) {
index a83830a..5736a7b 100644 (file)
@@ -3242,6 +3242,31 @@ OUTPUT:
     RETVAL
 
 
+MODULE = XS::APItest PACKAGE = XS::APItest::AUTOLOADtest
+
+int
+AUTOLOAD(...)
+  INIT:
+    SV* comms;
+    STRLEN len;
+    SV* class_and_method;
+    SV* tmp;
+  CODE:
+    class_and_method = get_sv("AUTOLOAD", 0);
+    comms = get_sv("main::the_method", 1);
+    if (class_and_method == NULL) {
+      RETVAL = 1;
+    } else if (!SvOK(class_and_method)) {
+      RETVAL = 2;
+    } else if (!SvPOK(class_and_method)) {
+      RETVAL = 3;
+    } else {
+      SvPV_set(comms, SvPV(class_and_method, len));
+      RETVAL = 0;
+    }
+  OUTPUT: RETVAL
+
+
 MODULE = XS::APItest           PACKAGE = XS::APItest::Magic
 
 PROTOTYPES: DISABLE
index 756618b..a791e85 100644 (file)
@@ -7,7 +7,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 15;
+use Test::More tests => 27;
 
 use XS::APItest;
 
@@ -63,3 +63,76 @@ is join(" ", eval 'a "b", "c"'), '$',
     like $w, qr/^Prototype mismatch: sub main::a \(\$\) vs \(\*\$\)/m,
         'GV assignment proto warnings respect AUTOLOAD prototypes';
 }
+
+
+#
+# This is a test for AUTOLOAD implemented as an XSUB.
+# It tests that $AUTOLOAD is set correctly, including the
+# case of inheritance.
+#
+# Rationale: Due to change ed850460, $AUTOLOAD is not currently set
+# for XSUB AUTOLOADs at all.  Instead, as of adb5a9ae the PV of the
+# AUTOLOAD XSUB is set to the name of the method. We cruelly test it
+# regardless.
+#
+
+# First, make sure we have the XS AUTOLOAD available for testing
+ok(XS::APItest::AUTOLOADtest->can('AUTOLOAD'), 'Test class ->can AUTOLOAD');
+
+# Used to communicate from the XS AUTOLOAD to Perl land
+use vars '$the_method';
+
+# First, set up the Perl equivalent to what we're testing in
+# XS so we have a comparison
+package PerlBase;
+use vars '$AUTOLOAD';
+sub AUTOLOAD {
+  Test::More::ok(defined $AUTOLOAD);
+  return 1 if not defined $AUTOLOAD;
+  $main::the_method = $AUTOLOAD;
+  return 0;
+}
+
+package PerlDerived;
+use vars '@ISA';
+@ISA = qw(PerlBase);
+
+package Derived;
+use vars '@ISA';
+@ISA = qw(XS::APItest::AUTOLOADtest);
+
+package main;
+
+# Test Perl AUTOLOAD in base class directly
+$the_method = undef;
+is(PerlBase->Blah(), 0,
+   "Perl AUTOLOAD gets called and returns success");
+is($the_method, 'PerlBase::Blah',
+   'Scalar set to correct class/method name');
+
+# Test Perl AUTOLOAD in derived class
+$the_method = undef;
+is(PerlDerived->Boo(), 0,
+   'Perl AUTOLOAD on derived class gets called and returns success');
+is($the_method, 'PerlDerived::Boo',
+   'Scalar set to correct class/method name');
+
+# 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,
+     'XS AUTOLOAD gets called and returns success');
+  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,
+     'XS AUTOLOAD gets called and returns success');
+  is($the_method, 'Derived::Foo',
+     'Scalar set to correct class/method name');
+}