From: M. J. T. Guy <mjtg@cus.cam.ac.uk>
Date: Mon, 31 Jul 2000 13:28:51 +0000 (+0100)
Subject: allow non-variable as lhs of non-updating tr///
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d897a58d2e5e1e3d2a32d03885d609925ad305e4;p=p5sagit%2Fp5-mst-13.2.git

allow non-variable as lhs of non-updating tr///
Message-Id: <E13JEgd-0003fy-00@libra.cus.cam.ac.uk>

(aka ID 20000730.002)

p4raw-id: //depot/perl@6471
---

diff --git a/op.c b/op.c
index 14c5573..86bd419 100644
--- a/op.c
+++ b/op.c
@@ -1988,7 +1988,9 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
 	right->op_type == OP_SUBST ||
 	right->op_type == OP_TRANS)) {
 	right->op_flags |= OPf_STACKED;
-	if (right->op_type != OP_MATCH)
+	if (right->op_type != OP_MATCH &&
+            ! (right->op_type == OP_TRANS &&
+               right->op_private & OPpTRANS_IDENTICAL))
 	    left = mod(left, right->op_type);
 	if (right->op_type == OP_TRANS)
 	    o = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right);
diff --git a/t/op/tr.t b/t/op/tr.t
index 2c1c4fd..ea665c7 100755
--- a/t/op/tr.t
+++ b/t/op/tr.t
@@ -5,7 +5,7 @@ BEGIN {
     unshift @INC, "../lib";
 }
 
-print "1..23\n";
+print "1..27\n";
 
 $_ = "abcdefghijklmnopqrstuvwxyz";
 
@@ -146,3 +146,20 @@ eval "tr/m-d/ /";
 print (($@ =~ /^Invalid \[\] range "m-d" in transliteration operator/) 
        ? '' : 'not ', "ok 23\n");
 
+# 24: test cannot update if read-only
+eval '$1 =~ tr/x/y/';
+print (($@ =~ /^Modification of a read-only value attempted/) ? '' : 'not ',
+       "ok 24\n");
+
+# 25: test can count read-only
+'abcdef' =~ /(bcd)/;
+print (( eval '$1 =~ tr/abcd//' == 3) ? '' : 'not ', "ok 25\n");
+
+# 26: test lhs OK if not updating
+print ((eval '"123" =~ tr/12//' == 2) ? '' : 'not ', "ok 26\n");
+
+# 27: test lhs bad if updating
+eval '"123" =~ tr/1/1/';
+print (($@ =~ m|^Can't modify constant item in transliteration \(tr///\)|)
+       ? '' : 'not ', "ok 27\n");
+