sassign is wrongly declared as BASEOP, not BINOP.

[ DAPM:
  To clarify: OP_SASSIGN is always allocated as a BINOP (or occasionally
  as a UNOP - see the next commit), but is listed as a BASEOP in
  regen/opcodes. Because of this, various bits of code that rely on e.g.
  PL_opargs[] have to be special-cased for OP_SASSIGN. This commit changes
  the entry in regen/opcodes to list it as BINOP, and removes the
  special-casing.
  I've also added a temporary workaround marked by XXX to make the commit
  work under PERL_OP_PARENT, which is the default now. This will be
  removed in a couple if commits' time.
]

This was wrong from the very beginning:
added with 79072805bf lwall perl 5.0 alpha 2 1993 with class s, not 0,
but missing the 2 S S args, which are present in aassign.
Changed to BASEOP with db173bac9b6de7d by mbeattie in 1997.
The '# sassign is special-cased for op class' comment is suspicious.

Fix it in ck_sassign also, it is created as BINOP in newASSIGNOP.
In 202206897 dapm 2014 complained about it also. Remove some special
cases where it should be a BINOP but was not.

diff --git a/op.c b/op.c
index 0fbee48..271c714 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2648,11 +2648,10 @@ S_finalize_op(pTHX_ OP* o)
               || family == OA_FILESTATOP
               || family == OA_LOOPEXOP
               || family == OA_METHOP
-              /* I don't know why SASSIGN is tagged as OA_BASEOP - DAPM */
-              || type == OP_SASSIGN
               || type == OP_CUSTOM
               || type == OP_NULL /* new_logop does this */
               );
+        if (type == OP_SASSIGN) has_last = 0; /* XXX tmp hack for unary assign */
 
         for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid)) {
 #  ifdef PERL_OP_PARENT
@@ -5121,7 +5120,7 @@ Perl_newBINOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
     BINOP *binop;
 
     ASSUME((PL_opargs[type] & OA_CLASS_MASK) == OA_BINOP
-       || type == OP_SASSIGN || type == OP_NULL || type == OP_CUSTOM);
+       || type == OP_NULL || type == OP_CUSTOM);
 
     NewOp(1101, binop, 1, BINOP);
 
@@ -10497,7 +10496,7 @@ OP *
 Perl_ck_sassign(pTHX_ OP *o)
 {
     dVAR;
-    OP * const kid = cLISTOPo->op_first;
+    OP * const kid = cBINOPo->op_first;
 
     PERL_ARGS_ASSERT_CK_SASSIGN;
 

diff --git a/opcode.h b/opcode.h
index 1f2674f..565cc9f 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -1831,7 +1831,7 @@ EXTCONST U32 PL_opargs[] = {
        0x00000304,     /* substcont */
        0x00001804,     /* trans */
        0x00001804,     /* transr */
-       0x00000004,     /* sassign */
+       0x00011204,     /* sassign */
        0x00022208,     /* aassign */
        0x00002b0d,     /* chop */
        0x00009b8c,     /* schop */

diff --git a/regen/opcodes b/regen/opcodes
index 57dd363..6ad9c62 100644 (file)
--- a/regen/opcodes
+++ b/regen/opcodes
@@ -94,9 +94,8 @@ trans         transliteration (tr///) ck_match        is"     S
 transr         transliteration (tr///) ck_match        is"     S
 
 # Lvalue operators.
-# sassign is special-cased for op class
 
-sassign                scalar assignment       ck_sassign      s0
+sassign                scalar assignment       ck_sassign      s2      S S
 aassign                list assignment         ck_null         t2      L L
 
 chop           chop                    ck_spair        mts%    L