New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
[2 PATCHES] sassign is wrongly declared as BASEOP #14846
Comments
From @rurbanThis is a bug report for perl from rurban@cpanel.net, From 5820089dc170ce9b58d622f5f72c9711b3935f03 Mon Sep 17 00:00:00 2001 This is a multi-part message in MIME format. This was wrong from the very beginning: Fix it in ck_sassign also, it is created as BINOP in newASSIGNOP. op.c | 6 ++---- --------------2.4.5 Inline Patchdiff --git op.c op.c
index cd8a9e7..af9bbfe 100644
--- op.c
+++ op.c
@@ -2553,8 +2553,6 @@ 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 */
);
@@ -4943,7 +4941,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);
@@ -10445,7 +10443,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 opcode.h opcode.h
index a73989a..54cfcdc 100644
--- opcode.h
+++ opcode.h
@@ -1835,7 +1835,7 @@ EXTCONST U32 PL_opargs[] = {
0x00000304, /* substcont */
0x00001804, /* trans */
0x00001804, /* transr */
- 0x00000004, /* sassign */
+ 0x00011204, /* sassign */
0x00022208, /* aassign */
0x00002b0d, /* chop */
0x00009b8c, /* schop */
diff --git regen/opcodes regen/opcodes
index b74c82a..4adb6d5 100644
--- regen/opcodes
+++ 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
--------------2.4.5--
This is a multi-part message in MIME format. In newASSIGNOP with {or,and,dor}assign, the rhs was wrongly compiled as UNOP sassign. {or,and,dor}assign needs the sassign with OPpASSIGN_BACKWARDS, set it finalize_op needs a special case for it, as the last is empty there. op.c | 11 +++++------ --------------2.4.5 Inline Patchdiff --git op.c op.c
index af9bbfe..269e9ec 100644
--- op.c
+++ op.c
@@ -2565,7 +2565,9 @@ S_finalize_op(pTHX_ OP* o)
assert(kid->op_sibparent == o);
}
# else
- if (has_last && !OpHAS_SIBLING(kid))
+ /* {and,or,xor}assign use a hackish unop'y sassign without last */
+ if (has_last && !OpHAS_SIBLING(kid)
+ && (OP_TYPE_ISNT(o, OP_SASSIGN) || cLISTOPo->op_last))
assert(kid == cLISTOPo->op_last);
# endif
}
@@ -6462,8 +6464,8 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
if (optype) {
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)));
+ op_lvalue(scalar(left), optype),
+ newBINOP(OP_SASSIGN, OPpASSIGN_BACKWARDS<<8, scalar(right), NULL));
}
else {
return newBINOP(optype, OPf_STACKED,
@@ -6985,9 +6987,6 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
if (!other)
return first;
- if (type == OP_ANDASSIGN || type == OP_ORASSIGN || type == OP_DORASSIGN)
- other->op_private |= OPpASSIGN_BACKWARDS; /* other is an OP_SASSIGN */
-
logop = S_alloc_LOGOP(aTHX_ type, first, LINKLIST(other));
logop->op_flags |= (U8)flags;
logop->op_private = (U8)(1 | (flags >> 8));
diff --git pp_hot.c pp_hot.c
index 34f23f8..8e17081 100644
--- pp_hot.c
+++ pp_hot.c
@@ -136,7 +136,7 @@ PP(pp_sassign)
*/
SV *left = POPs; SV *right = TOPs;
- if (PL_op->op_private & OPpASSIGN_BACKWARDS) {
+ if (PL_op->op_private & OPpASSIGN_BACKWARDS) { /* {or,and.dor}assign */
SV * const temp = left;
left = right; right = temp;
}
--------------2.4.5--
---
Site configuration information for perl 5.23.2: Configured by rurban at Wed Aug 12 10:07:44 CEST 2015. Summary of my perl5 (revision 5 version 23 subversion 2) configuration: Locally applied patches: @INC for perl 5.23.2: Environment for perl 5.23.2: |
From @bulk88So why does sassign need to go from being a UNOP to BINOP and take more memory? I see the op_last is set to NULL in your patch, wouldn't UNOP be correct then? -- |
The RT System itself - Status changed from 'new' to 'open' |
From @rurbanOn Wed Aug 12 02:58:36 2015, bulk88 wrote:
sassign is a BINOP. allocating it as UNOP as done here, will use the next random UNOP* as op_last, which is of course wrong. |
From @tonycozOn Wed Aug 12 01:31:29 2015, rurban@cpanel.net wrote:
Fails early when built with -DPERL_OP_PARENT: cc -fstack-protector -L/usr/local/lib -o miniperl \ Tony |
From @iabynOn Wed, Aug 12, 2015 at 05:38:28PM -0700, Tony Cook via RT wrote:
I've now applied these two commits, along with: 1257c08 sassign is wrongly declared as BASEOP, not BINOP. -- |
@iabyn - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#125792 (status was 'resolved')
Searchable as RT125792$
The text was updated successfully, but these errors were encountered: