diff options
| -rw-r--r-- | op.c | 4 | ||||
| -rwxr-xr-x | t/op/tr.t | 19 |
2 files changed, 21 insertions, 2 deletions
@@ -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); @@ -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"); + |