Avoid loading modules for %! and %+ on meeting %{"foo::!"} and %{"foo::+"}
authorNicholas Clark <nick@ccl4.org>
Tue, 22 Feb 2011 15:19:34 +0000 (15:19 +0000)
committerNicholas Clark <nick@ccl4.org>
Tue, 22 Feb 2011 15:19:34 +0000 (15:19 +0000)
Previously, just %{"foo::!"} would not trigger a load of Errno, but
${"foo::!"}; %{"foo::!"}; would, due to the different code paths taken through
Perl_gv_fetchpvn_flags(). As the modules themselves are responsible for calling
tie on the relevant global variables, there never was a problem with the wrong
variables *getting* their behaviour. However, the attempted load of the XS
module Tie::Hash::NamedCapture for %{"foo::-} meant that t/op/leaky-magic.t
would not pass under minitest. This commit resolves that failure.

gv.c
t/op/magic.t

diff --git a/gv.c b/gv.c
index 5ddfb56..f417686 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1239,7 +1239,8 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
        if (add) {
            GvMULTI_on(gv);
            gv_init_sv(gv, sv_type);
-           if (len == 1 && (sv_type == SVt_PVHV || sv_type == SVt_PVGV)) {
+           if (len == 1 && stash == PL_defstash
+               && (sv_type == SVt_PVHV || sv_type == SVt_PVGV)) {
                if (*name == '!')
                    require_tie_mod(gv, "!", newSVpvs("Errno"), "TIEHASH", 1);
                else if (*name == '-' || *name == '+')
index 6951850..6701cf7 100644 (file)
@@ -12,7 +12,7 @@ BEGIN {
 use warnings;
 use Config;
 
-plan (tests => 83);
+plan (tests => 87);
 
 $Is_MSWin32  = $^O eq 'MSWin32';
 $Is_NetWare  = $^O eq 'NetWare';
@@ -445,6 +445,25 @@ SKIP:  {
     ok ${"!"}{ENOENT};
 }
 
+# Check that we don't auto-load packages
+foreach (['powie::!', 'Errno'],
+        ['powie::+', 'Tie::Hash::NamedCapture']) {
+    my ($symbol, $package) = @$_;
+    foreach my $scalar_first ('', '$$symbol;') {
+       my $desc = qq{Referencing %{"$symbol"}};
+       $desc .= qq{ after mentioning \${"$symbol"}} if $scalar_first;
+       $desc .= " doesn't load $package";
+
+       fresh_perl_is(<<"EOP", 0, {}, $desc);
+use strict qw(vars subs);
+my \$symbol = '$symbol';
+$scalar_first;
+1 if %{\$symbol};
+print scalar %${package}::;
+EOP
+    }
+}
+
 is $^S, 0;
 eval { is $^S,1 };
 eval " BEGIN { ok ! defined \$^S } ";