From: Father Chrysostomos <sprout@cpan.org>
Date: Wed, 18 Jan 2012 06:51:32 +0000 (-0800)
Subject: [perl #108480] $cow |= number undefines $cow
X-Git-Tag: accepted/trunk/20130322.191538~1131
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=5ee80e13ad1338a061ce31e1c7ea5c074fc5a0ff;p=platform%2Fupstream%2Fperl.git

[perl #108480] $cow |= number undefines $cow

If a read-only scalar is passed to one of | & ^ and it decides to do
a numeric operation, the numeric flags on the read-only scalar are
turned off afterwards if they were not on to begin with.

This was introduced in commit b20c4ee1f, which did so to stop $x | "0"
from coercing the rhs and making it behave differently the second
time through.

What that commit did not take into account was that the read-only
flag is set on cow scalars, and the same pp function is used for the
assignment forms.  So it was turning off the numeric flags after
$cow |= 1, leaving $cow undef.

I made this numeric flag-twiddling apply only to read-only scalars
(supposedly), because that seemed the most conservative and acceptable
change.  I am actually in favour of extending it to all scalars, to
make these operators less surprising.  For that reason, this commit
preserves the current behaviour with cows in the non-assignment case:
they don’t get coerced into numbers.  Changing them to work the same
way as non-cow writable scalars would make things more consistent, but
more consistently buggy.  I would like to make this non-coercion apply
to all scalars in 5.18.

This commit simply skips the flag-twiddling on the lhs in the assign-
ment case.
---

diff --git a/pp.c b/pp.c
index b54b3ab..2bc1a1a 100644
--- a/pp.c
+++ b/pp.c
@@ -2193,7 +2193,7 @@ PP(pp_bit_and)
 	  const UV u = SvUV_nomg(left) & SvUV_nomg(right);
 	  SETu(u);
 	}
-	if (left_ro_nonnum)  SvNIOK_off(left);
+	if (left_ro_nonnum && left != TARG) SvNIOK_off(left);
 	if (right_ro_nonnum) SvNIOK_off(right);
       }
       else {
@@ -2227,7 +2227,7 @@ PP(pp_bit_or)
 	  const UV result = op_type == OP_BIT_OR ? (l | r) : (l ^ r);
 	  SETu(result);
 	}
-	if (left_ro_nonnum)  SvNIOK_off(left);
+	if (left_ro_nonnum && left != TARG) SvNIOK_off(left);
 	if (right_ro_nonnum) SvNIOK_off(right);
       }
       else {
diff --git a/t/op/bop.t b/t/op/bop.t
index 0f28f79..fa08e98 100644
--- a/t/op/bop.t
+++ b/t/op/bop.t
@@ -15,7 +15,7 @@ BEGIN {
 # If you find tests are failing, please try adding names to tests to track
 # down where the failure is, and supply your new names as a patch.
 # (Just-in-time test naming)
-plan tests => 171 + (10*13*2) + 5;
+plan tests => 174 + (10*13*2) + 5;
 
 # numerics
 ok ((0xdead & 0xbeef) == 0x9ead);
@@ -77,6 +77,18 @@ is _xor "yit", 'RYt', 'str var ^ const str';
 is _xor  0,    '0',   'num var ^ const str';
 is _xor "yit", 'RYt', 'str var ^ const str again';
 
+# But don’t mistake a COW for a constant when assigning to it
+%h=(150=>1);
+$i=(keys %h)[0];
+$i |= 105;
+is $i, 255, '[perl #108480] $cow |= number';
+$i=(keys %h)[0];
+$i &= 105;
+is $i, 0, '[perl #108480] $cow &= number';
+$i=(keys %h)[0];
+$i ^= 105;
+is $i, 255, '[perl #108480] $cow ^= number';
+
 #
 is ("ok \xFF\xFF\n" & "ok 19\n", "ok 19\n");
 is ("ok 20\n" | "ok \0\0\n", "ok 20\n");