From: Nicholas Clark <nick@ccl4.org>
Date: Tue, 22 Feb 2011 15:19:34 +0000 (+0000)
Subject: Avoid loading modules for %! and %+ on meeting  %{"foo::!"} and %{"foo::+"}
X-Git-Tag: v5.13.11~490
X-Git-Url: https://perl5.git.perl.org/perl5.git/commitdiff_plain/ccdda9cbebc935188ca88f492ce8739de41d890a

Avoid loading modules for %! and %+ on meeting  %{"foo::!"} and %{"foo::+"}

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.
---

diff --git a/gv.c b/gv.c
index 5ddfb56..f417686 100644
--- 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 == '+')
diff --git a/t/op/magic.t b/t/op/magic.t
index 6951850..6701cf7 100644
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -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 } ";