This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix for RT#1804: Anonymous glob breaks when assigned through
authorFather Chrysostomos <sprout@cpan.org>
Sat, 10 Jul 2010 19:09:51 +0000 (15:09 -0400)
committerRafael Garcia-Suarez <rgs@consttype.org>
Mon, 26 Jul 2010 08:16:55 +0000 (10:16 +0200)
The problem here is that globs are scalars and the = operator can only
distinguish between scalar and glob assignments by the flags on the
glob. It only sees the return value of *{}, not the *{} itself. We can
fix this by having the pp_sassign look for a rv2gv (*{}) on its LHS,
to decide what type of assignment to do.

pp_hot.c
t/op/gv.t

index d5a4572..bd0f909 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -112,6 +112,7 @@ PP(pp_and)
 PP(pp_sassign)
 {
     dVAR; dSP; dPOPTOPssrl;
+    U32 wasfake = 0;
 
     if (PL_op->op_private & OPpASSIGN_BACKWARDS) {
        SV * const temp = left;
@@ -197,7 +198,14 @@ PP(pp_sassign)
        }
 
     }
+    /* Allow glob assignments like *$x = ..., which, when the glob has a
+       SVf_FAKE flag, cannot be distinguished from $x = ... without looking
+       at the op tree. */
+    if( SvTYPE(right) == SVt_PVGV && cBINOP->op_last->op_type == OP_RV2GV
+     && (wasfake = SvFLAGS(right) & SVf_FAKE) )
+       SvFLAGS(right) &= ~SVf_FAKE;
     SvSetMagicSV(right, left);
+    if(wasfake) SvFLAGS(right) |= SVf_FAKE;
     SETs(right);
     RETURN;
 }
index f3511e3..13da980 100644 (file)
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -12,7 +12,7 @@ BEGIN {
 use warnings;
 
 require './test.pl';
-plan( tests => 191 );
+plan( tests => 192 );
 
 # type coersion on assignment
 $foo = 'foo';
@@ -623,6 +623,17 @@ is ($@, '', "Can localize FAKE glob that's present in stash");
 is (scalar $::{fake}, "*main::sym",
        "Localized FAKE glob's value was correctly restored");
 
+# [perl #1804] *$x assignment when $x is a copy of another glob
+{
+    no warnings 'once';
+    my $x = *_random::glob_that_is_not_used_elsewhere;
+    *$x = sub{};
+    is(
+      "$x", '*_random::glob_that_is_not_used_elsewhere',
+      '[perl #1804] *$x assignment when $x is FAKE',
+    );
+}
+
 __END__
 Perl
 Rules