This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #105024] UNIVERSAL::AUTOLOAD and %+
authorFather Chrysostomos <sprout@cpan.org>
Thu, 1 Dec 2011 06:05:03 +0000 (22:05 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Thu, 1 Dec 2011 06:05:03 +0000 (22:05 -0800)
The code in gv.c for loading a tie module automatically
(S_require_tie_mod) was only loading the module if its stash did not
exist or if a particular method (usually TIEHASH) could not be found.
But it was triggering autoloading, such that a universal AUTOLOAD
method would allow it to ‘find’ the method it was looking for, even if
it did not exist.  So autovivifying the package somehow (e.g., by men-
tioning one of its symbols) could prevent the module from loading.

gv.c
t/op/magic.t

diff --git a/gv.c b/gv.c
index 6b78a8c..3a978f2 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1267,7 +1267,7 @@ S_require_tie_mod(pTHX_ GV *gv, const char *varpv, SV* namesv, const char *methp
 
     PERL_ARGS_ASSERT_REQUIRE_TIE_MOD;
 
 
     PERL_ARGS_ASSERT_REQUIRE_TIE_MOD;
 
-    if (!stash || !(gv_fetchmethod(stash, methpv))) {
+    if (!stash || !(gv_fetchmethod_autoload(stash, methpv, FALSE))) {
        SV *module = newSVsv(namesv);
        char varname = *varpv; /* varpv might be clobbered by load_module,
                                  so save it. For the moment it's always
        SV *module = newSVsv(namesv);
        char varname = *varpv; /* varpv might be clobbered by load_module,
                                  so save it. For the moment it's always
index d8d5063..adbdad6 100644 (file)
@@ -5,7 +5,7 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     require './test.pl';
     chdir 't' if -d 't';
     @INC = '../lib';
     require './test.pl';
-    plan (tests => 147);
+    plan (tests => 150);
 }
 
 # Test that defined() returns true for magic variables created on the fly,
 }
 
 # Test that defined() returns true for magic variables created on the fly,
@@ -529,6 +529,24 @@ foreach my $sig (qw(__DIE__ _BOGUS_HOOK KILL THIRSTY)) {
 
 }
 
 
 }
 
+SKIP: {
+    skip_if_miniperl("No XS in miniperl", 3);
+
+    for ( [qw( %- Tie::Hash::NamedCapture )], [qw( $[ arybase )],
+          [qw( %! Errno )] ) {
+       my ($var, $mod) = @$_;
+       my $modfile = $mod =~ s|::|/|gr . ".pm";
+       fresh_perl_is
+          qq 'sub UNIVERSAL::AUTOLOAD{}
+              $mod\::foo() if 0;
+              $var;
+              print "ok\\n" if \$INC{"$modfile"}',
+         "ok\n",
+          { switches => [ '-X' ] },
+         "$var still loads $mod when stash and UNIVERSAL::AUTOLOAD exist";
+    }
+}
+
 # ^^^^^^^^^ New tests go here ^^^^^^^^^
 
 SKIP: {
 # ^^^^^^^^^ New tests go here ^^^^^^^^^
 
 SKIP: {