This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Stop folding of ops from changing mutability
authorFather Chrysostomos <sprout@cpan.org>
Sun, 23 Jun 2013 14:08:24 +0000 (07:08 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Fri, 26 Jul 2013 06:48:00 +0000 (23:48 -0700)
If $a+$b produces a mutable value, then so should 1+2.

ext/Devel-Peek/t/Peek.t
op.c
t/comp/fold.t
t/op/readline.t
t/op/vec.t
t/uni/readline.t

index 625e98b..32dc7a8 100644 (file)
@@ -443,7 +443,8 @@ do_test('string with Unicode',
        chr(256).chr(0).chr(512),
 'SV = PV\\($ADDR\\) at $ADDR
   REFCNT = 1
-  FLAGS = \\((?:$PADTMP,)?POK,READONLY,pPOK,UTF8\\)
+  FLAGS = \\((?:$PADTMP,)?POK,READONLY,pPOK,UTF8\\)    # $] < 5.019002
+  FLAGS = \\((?:$PADTMP,)?POK,pPOK,UTF8\\)             # $] >=5.019002
   PV = $ADDR "\\\214\\\101\\\0\\\235\\\101"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\]
   CUR = 5
   LEN = \\d+');
@@ -452,7 +453,8 @@ do_test('string with Unicode',
        chr(256).chr(0).chr(512),
 'SV = PV\\($ADDR\\) at $ADDR
   REFCNT = 1
-  FLAGS = \\((?:$PADTMP,)?POK,READONLY,pPOK,UTF8\\)
+  FLAGS = \\((?:$PADTMP,)?POK,READONLY,pPOK,UTF8\\)    # $] < 5.019002
+  FLAGS = \\((?:$PADTMP,)?POK,pPOK,UTF8\\)             # $] >=5.019002
   PV = $ADDR "\\\304\\\200\\\0\\\310\\\200"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\]
   CUR = 5
   LEN = \\d+');
diff --git a/op.c b/op.c
index dc8cf22..cfbe11c 100644 (file)
--- a/op.c
+++ b/op.c
@@ -3333,6 +3333,7 @@ S_fold_constants(pTHX_ OP *o)
     op_free(o);
 #endif
     assert(sv);
+    if (!SvIMMORTAL(sv)) SvPADTMP_on(sv);
     if (type == OP_RV2GV)
        newop = newGVOP(OP_GV, 0, MUTABLE_GV(sv));
     else
index f6a9470..c483c99 100644 (file)
@@ -156,5 +156,5 @@ for(1+2) {
     print "not " unless $_ eq 4;
     print "ok ", ++$test,
           " - 1+2 returns mutable value, just like \$a+\$b",
-          " # TODO\n";
+          "\n";
 }
index 944cd7a..1cfd78c 100644 (file)
@@ -10,7 +10,8 @@ plan tests => 30;
 
 # [perl #19566]: sv_gets writes directly to its argument via
 # TARG. Test that we respect SvREADONLY.
-eval { for (\2) { $_ = <FH> } };
+use constant roref => \2;
+eval { for (roref) { $_ = <FH> } };
 like($@, 'Modification of a read-only value attempted', '[perl #19566]');
 
 # [perl #21628]
index 1743c18..b4afcf9 100644 (file)
@@ -108,6 +108,7 @@ $destroyed = 0;
 }
 is($destroyed, 1, 'Timely scalar destruction with lvalue vec');
 
-eval { for (\1) { vec($_,0,1) = 1 } };
+use constant roref => \1;
+eval { for (roref) { vec($_,0,1) = 1 } };
 like($@, qr/^Modification of a read-only value attempted at /,
         'err msg when modifying read-only refs');
index 495172c..a83558e 100644 (file)
@@ -13,7 +13,8 @@ use open qw( :utf8 :std );
 
 # [perl #19566]: sv_gets writes directly to its argument via
 # TARG. Test that we respect SvREADONLY.
-eval { for (\2) { $_ = <Fʜ> } };
+use constant roref=>\2;
+eval { for (roref) { $_ = <Fʜ> } };
 like($@, 'Modification of a read-only value attempted', '[perl #19566]');
 
 # [perl #21628]