This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
don't mistake tr/// for assignable reference
authorZefram <zefram@fysh.org>
Wed, 6 Dec 2017 00:50:05 +0000 (00:50 +0000)
committerZefram <zefram@fysh.org>
Wed, 6 Dec 2017 00:50:05 +0000 (00:50 +0000)
For the lhs of an assignment to be an assignable srefgen, the
srefgen must be its top-level op.  ck_refassign() asserted that, but
S_assignment_type() was delving inside a null op looking for the srefgen,
the same way it looks for things that distinguish between scalar and
list assignment.  This showed up in a weird situation where a no-op
transliteration could be applied to an srefgen, getting an srefgen inside
a null op.  Fixes [perl #130578].

op.c
t/op/lvref.t

diff --git a/op.c b/op.c
index 072d3ce..a27e4b1 100644 (file)
--- a/op.c
+++ b/op.c
@@ -7579,11 +7579,24 @@ S_assignment_type(pTHX_ const OP *o)
     if (!o)
        return TRUE;
 
     if (!o)
        return TRUE;
 
-    if ((o->op_type == OP_NULL) && (o->op_flags & OPf_KIDS))
-       o = cUNOPo->op_first;
+    if (o->op_type == OP_SREFGEN)
+    {
+       OP * const kid = cUNOPx(cUNOPo->op_first)->op_first;
+       type = kid->op_type;
+       flags = o->op_flags | kid->op_flags;
+       if (!(flags & OPf_PARENS)
+         && (kid->op_type == OP_RV2AV || kid->op_type == OP_PADAV ||
+             kid->op_type == OP_RV2HV || kid->op_type == OP_PADHV ))
+           return ASSIGN_REF;
+       ret = ASSIGN_REF;
+    } else {
+       if ((o->op_type == OP_NULL) && (o->op_flags & OPf_KIDS))
+           o = cUNOPo->op_first;
+       flags = o->op_flags;
+       type = o->op_type;
+       ret = 0;
+    }
 
 
-    flags = o->op_flags;
-    type = o->op_type;
     if (type == OP_COND_EXPR) {
         OP * const sib = OpSIBLING(cLOGOPo->op_first);
         const I32 t = assignment_type(sib);
     if (type == OP_COND_EXPR) {
         OP * const sib = OpSIBLING(cLOGOPo->op_first);
         const I32 t = assignment_type(sib);
@@ -7596,19 +7609,6 @@ S_assignment_type(pTHX_ const OP *o)
        return FALSE;
     }
 
        return FALSE;
     }
 
-    if (type == OP_SREFGEN)
-    {
-       OP * const kid = cUNOPx(cUNOPo->op_first)->op_first;
-       type = kid->op_type;
-       flags |= kid->op_flags;
-       if (!(flags & OPf_PARENS)
-         && (kid->op_type == OP_RV2AV || kid->op_type == OP_PADAV ||
-             kid->op_type == OP_RV2HV || kid->op_type == OP_PADHV ))
-           return ASSIGN_REF;
-       ret = ASSIGN_REF;
-    }
-    else ret = 0;
-
     if (type == OP_LIST &&
        (flags & OPf_WANT) == OPf_WANT_SCALAR &&
        o->op_private & OPpLVAL_INTRO)
     if (type == OP_LIST &&
        (flags & OPf_WANT) == OPf_WANT_SCALAR &&
        o->op_private & OPpLVAL_INTRO)
index a943e55..28adc6a 100644 (file)
@@ -4,7 +4,7 @@ BEGIN {
     set_up_inc("../lib");
 }
 
     set_up_inc("../lib");
 }
 
-plan 155;
+plan 156;
 
 eval '\$x = \$y';
 like $@, qr/^Experimental aliasing via reference not enabled/,
 
 eval '\$x = \$y';
 like $@, qr/^Experimental aliasing via reference not enabled/,
@@ -488,6 +488,10 @@ eval '$foo ? \%{"42"} : \%43 = 42';
 like $@,
     qr/^Can't modify reference to hash dereference in scalar assignment a/,
    "Can't modify ref to whatever in scalar assignment via cond expr";
 like $@,
     qr/^Can't modify reference to hash dereference in scalar assignment a/,
    "Can't modify ref to whatever in scalar assignment via cond expr";
+eval '\$0=~y///=0';
+like $@,
+    qr#^Can't modify transliteration \(tr///\) in scalar assignment a#,
+   "Can't modify transliteration (tr///) in scalar assignment";
 
 # Miscellaneous
 
 
 # Miscellaneous