[perl #78580] Stop a simple *glob from calling get-magic

This also happens to apply to *{ $::{glob} }, but not to *{\*glob} or
*{$thing = *glob}.

In other words, it’s only when the operand is a real glob, and not a
reference or a SVt_FAKE glob.

diff --git a/pp.c b/pp.c
index 45f536e..c73fdbf 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -139,7 +139,7 @@ PP(pp_rv2gv)
 {
     dVAR; dSP; dTOPss;
 
-    SvGETMAGIC(sv);
+    if (!isGV(sv) || SvFAKE(sv)) SvGETMAGIC(sv);
     if (SvROK(sv)) {
       wasref:
        tryAMAGICunDEREF(to_gv);

diff --git a/t/op/gmagic.t b/t/op/gmagic.t
index 65441a6..bc8a926 100644 (file)
--- a/t/op/gmagic.t
+++ b/t/op/gmagic.t
@@ -6,7 +6,7 @@ BEGIN {
     @INC = '../lib';
 }
 
-print "1..22\n";
+print "1..24\n";
 
 my $t = 1;
 tie my $c => 'Tie::Monitor';
@@ -60,6 +60,19 @@ $c = *strat;
 $s = $c;
 ok_string $s, *strat, 1, 1;
 
+# A plain *foo should not call get-magic on *foo.
+# This method of scalar-tying an immutable glob relies on details of the
+# current implementation that are subject to change. This test may need to
+# be rewritten if they do change.
+my $tyre = tie $::{gelp} => 'Tie::Monitor';
+# Compilation of this eval autovivifies the *gelp glob.
+eval '$tyre->init(0); () = \*gelp';
+my($rgot, $wgot) = $tyre->init(0);
+print "not " unless $rgot == 0;
+print "ok ", $t++, " - a plain *foo causes no get-magic\n";
+print "not " unless $wgot == 0;
+print "ok ", $t++, " - a plain *foo causes no set-magic\n";
+
 
 # adapted from Tie::Counter by Abigail
 package Tie::Monitor;