Call get-magic once for *glob=$tied

This is a regression in 5.10.0.

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index d7eddd7..f527418 100644 (file)
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -543,7 +543,8 @@ equivalent to C<setpgrp($foo,0)>.
 
 =item *
 
-An assignment like C<*$tied = \&{"..."}> now calls FETCH only once.
+Assignments like C<*$tied = \&{"..."}> and C<*glob = $tied> now call FETCH
+only once.
 
 =back
 

diff --git a/sv.c b/sv.c
index f555e44..bb9dbd3 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -4161,7 +4161,11 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
                           "Undefined value assigned to typeglob");
        }
        else {
-           GV *gv = gv_fetchsv(sstr, GV_ADD, SVt_PVGV);
+           STRLEN len;
+           const char *nambeg = SvPV_nomg_const(sstr, len);
+           GV *gv = gv_fetchpvn_flags(
+               nambeg, len, SvUTF8(sstr)|GV_ADD, SVt_PVGV
+           );
            if (dstr != (const SV *)gv) {
                const char * const name = GvNAME((const GV *)dstr);
                const STRLEN len = GvNAMELEN(dstr);

diff --git a/t/op/tie_fetch_count.t b/t/op/tie_fetch_count.t
index 5337c05..41d7308 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 => 219);
+    plan (tests => 220);
 }
 
 use strict;
@@ -43,6 +43,10 @@ tie my $var => 'main', 1;
 
 # Assignment.
 $dummy  =  $var         ; check_count "=";
+{
+    no warnings 'once';
+    *dummy  =  $var         ; check_count '*glob = $tied';
+}
 
 # Unary +/-
 $dummy  = +$var         ; check_count "unary +";