sassign was used as UNOP, optimize {or,and,dor}assign

[ DAPM:
  To clarify: OP_SASSIGN normally has two args, and is allocated as a
  BINOP. However, in something like $x ||= 1,  the optree looks like:

    4        <|> orassign(other->5) vK/1 ->7
    -           <1> ex-rv2sv sKRM/1 ->4
    3              <#> gvsv[*x] s ->4
    6           <1> sassign sK/BKWARD,1 ->7
    5              <$> const[IV 1] s ->6

  Here the sassign only has a single arg, since the other arg is already
  left on the stack after orassign has executed.

  In this case, perl was allocating the op as a UNOP, which causes
  problems with any code which assumes op_last contains a valid pointer.
  This commit changes it so that the op is always allocated as a BINOP,
  even when it only has one arg. In that case, it sets op_last to NULL
  (but see the next commit).

  Setting OPpASSIGN_BACKWARDS earlier is just a simplification of the
  code.
]

In newASSIGNOP with {or,and,dor}assign, the rhs was wrongly compiled as UNOP sassign.
It caused DEBUGGING corruption in the op finalizer for sassign (first not
pointing to last without sibling) and added random chunk to the last field.
It was never used though, as only {or,and,dor}assign used this op_other op.

{or,and,dor}assign needs the sassign with OPpASSIGN_BACKWARDS, set it
directly, not later in the LOGOP.

finalize_op needs a special case for it, as the last is empty there.

1 files changed, 4 insertions, 5 deletions

diff --git a/op.c b/op.c
index 271c7143fe..a7652d519e 100644
--- a/op.c
+++ b/op.c
@@ -2661,7 +2661,9 @@ S_finalize_op(pTHX_ OP* o)
                 assert(kid->op_sibparent == o);
             }
 #  else
-            if (has_last && !OpHAS_SIBLING(kid))
+            if (has_last && !OpHAS_SIBLING(kid)
+            /* {and,or,xor}assign use a hackish unop'y sassign without last */
+                && (OP_TYPE_ISNT(o, OP_SASSIGN) || cLISTOPo->op_last))
                 assert(kid == cLISTOPo->op_last);
 #  endif
         }
@@ -6509,7 +6511,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 	if (optype == OP_ANDASSIGN || optype == OP_ORASSIGN || optype == OP_DORASSIGN) {
 	    return newLOGOP(optype, 0,
 		op_lvalue(scalar(left), optype),
-		newUNOP(OP_SASSIGN, 0, scalar(right)));
+		newBINOP(OP_SASSIGN, OPpASSIGN_BACKWARDS<<8, scalar(right), NULL));
 	}
 	else {
 	    return newBINOP(optype, OPf_STACKED,
@@ -6984,9 +6986,6 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
 	}
     }
 
-    if (type == OP_ANDASSIGN || type == OP_ORASSIGN || type == OP_DORASSIGN)
-	other->op_private |= OPpASSIGN_BACKWARDS;  /* other is an OP_SASSIGN */
-
     /* optimize AND and OR ops that have NOTs as children */
     if (first->op_type == OP_NOT
         && (first->op_flags & OPf_KIDS)