Don’t call get-magic twice for sym refs

Dereferencing ops (${}, etc.) were calling get-magic on their operand
twice if it was a symbolic reference, except for &{}.

This commit fixes that, adding tests for all the deref ops, including
&{}, for good measure.

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index d03695a..944a7b8 100644 (file)
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -365,6 +365,13 @@ effects like C<ref \$_> returning "CODE" in some instances.
 C<lock>'s prototype has been corrected to C<(\[$@%*])> from C<(\$)>, which
 was just wrong.
 
+=item *
+
+Most dereferencing operators (C<${}>, etc.) used to call C<FETCH> twice on
+a tied operand when doing a symbolic dereference (looking up a variable by
+name, which is not permitted under C<use strict 'refs'>).  Only C<&{}> did
+not have this problem.  This has been fixed.
+
 =back
 
 =head1 Known Problems

diff --git a/pp.c b/pp.c
index b6dabb5..ccbbf35 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -219,7 +219,15 @@ PP(pp_rv2gv)
                       things.  */
                    RETURN;
                }
-               sv = MUTABLE_SV(gv_fetchsv(sv, GV_ADD, SVt_PVGV));
+               {
+                   STRLEN len;
+                   const char * const nambeg = SvPV_nomg_const(sv, len);
+                   sv = MUTABLE_SV(
+                       gv_fetchpvn_flags(
+                           nambeg, len, GV_ADD | SvUTF8(sv), SVt_PVGV
+                       )
+                   );
+               }
            }
            /* FAKE globs in the symbol table cause weird bugs (#77810) */
            if (sv) SvFAKE_off(sv);
@@ -281,7 +289,9 @@ Perl_softref2xv(pTHX_ SV *const sv, const char *const what,
                }
        }
     else {
-       gv = gv_fetchsv(sv, GV_ADD, type);
+       STRLEN len;
+       const char * const nambeg = SvPV_nomg_const(sv, len);
+       gv = gv_fetchpvn_flags(nambeg, len, GV_ADD | SvUTF8(sv), type);
     }
     return gv;
 }

diff --git a/t/op/tie_fetch_count.t b/t/op/tie_fetch_count.t
index 6d2da1c..b9fd275 100644 (file)
--- a/t/op/tie_fetch_count.t
+++ b/t/op/tie_fetch_count.t
@@ -7,7 +7,7 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     require './test.pl';
-    plan (tests => 210);
+    plan (tests => 215);
 }
 
 use strict;
@@ -175,6 +175,16 @@ $dummy  = keys $var3    ; check_count 'keys hashref';
 tie my $var5 => 'main', sub {1};
 $dummy  = &$var5        ; check_count '&{}';
 
+{
+    no strict 'refs';
+    tie my $var1 => 'main', 1;
+    $dummy  = $$var1        ; check_count 'symbolic ${}';
+    $dummy  = @$var1        ; check_count 'symbolic @{}';
+    $dummy  = %$var1        ; check_count 'symbolic %{}';
+    $dummy  = *$var1        ; check_count 'symbolic *{}';
+    local *1 = sub{};
+    $dummy  = &$var1        ; check_count 'symbolic &{}';
+}
 
 ###############################################
 #        Tests for  $foo binop $foo           #