rurban@cpanel.net (via RT)
2015-08-12 08:31:30 UTC
# New Ticket Created by ***@cpanel.net
# Please include the string: [perl #125792]
# in the subject line of all future correspondence about this issue.
# <URL: https://rt.perl.org/Ticket/Display.html?id=125792 >
This is a bug report for perl from ***@cpanel.net,
generated with the help of perlbug 1.40 running under perl 5.23.2.
Date: Wed, 12 Aug 2015 08:17:18 +0200
Subject: [PATCH 1/2] sassign is wrongly declared as BASEOP, not BINOP.
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="------------2.4.5"
This is a multi-part message in MIME format.
--------------2.4.5
Content-Type: text/plain; charset=UTF-8; format=fixed
Content-Transfer-Encoding: 8bit
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.
---
op.c | 6 ++----
opcode.h | 2 +-
regen/opcodes | 3 +--
3 files changed, 4 insertions(+), 7 deletions(-)
--------------2.4.5
Content-Type: text/x-patch; name="0001-sassign-is-wrongly-declared-as-BASEOP-not-BINOP.patch"
Content-Transfer-Encoding: 8bit
Content-Disposition: attachment; filename="0001-sassign-is-wrongly-declared-as-BASEOP-not-BINOP.patch"
diff --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--
Date: Wed, 12 Aug 2015 09:21:13 +0200
Subject: [PATCH 2/2] sassign was used as UNOP, optimize {or,and,dor}assign
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="------------2.4.5"
This is a multi-part message in MIME format.
--------------2.4.5
Content-Type: text/plain; charset=UTF-8; format=fixed
Content-Transfer-Encoding: 8bit
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.
---
op.c | 11 +++++------
pp_hot.c | 2 +-
2 files changed, 6 insertions(+), 7 deletions(-)
--------------2.4.5
Content-Type: text/x-patch; name="0002-sassign-was-used-as-UNOP-optimize-or-and-dor-assign.patch"
Content-Transfer-Encoding: 8bit
Content-Disposition: attachment; filename="0002-sassign-was-used-as-UNOP-optimize-or-and-dor-assign.patch"
diff --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--
---
Flags:
category=core
severity=medium
---
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:
Local Commit: e9576735f4e1a76e7140b008dc487e7a09774414
Ancestor: 9b669ea1e2997fbb78558e1fc0a7ecae3aa23af0
Platform:
osname=darwin, osvers=14.4.0, archname=darwin-2level
uname='darwin airc.local 14.4.0 darwin kernel version 14.4.0: thu may 28 11:35:04 pdt 2015; root:xnu-2782.30.5~1release_x86_64 x86_64 i386 macbookair6,2 darwin '
config_args='-sder -Dusedevel -Dusecperl -DDEBUGGING -Dcc=gcc-mp-4.9 -Accflags=-march=corei7 -DDEBUG_LEAKING_SCALARS -Doptimize=-g3 -Dinstallman1dir=none -Dinstallman3dir=none -Dinstallsiteman1dir=none -Dinstallsiteman3dir=none'
hint=recommended, useposix=true, d_sigaction=define
useithreads=undef, usemultiplicity=undef
use64bitint=define, use64bitall=define, uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler:
cc='gcc-mp-4.9', ccflags ='-fno-common -DPERL_DARWIN -march=corei7 -DDEBUG_LEAKING_SCALARS -fwrapv -DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/include -I/opt/local/include',
optimize='-g3',
cppflags='-fno-common -DPERL_DARWIN -march=corei7 -DDEBUG_LEAKING_SCALARS -fwrapv -DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/include -I/opt/local/include'
ccversion='', gccversion='4.9.3', gccosandvers=''
intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678, doublekind=3
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16, longdblkind=3
ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
alignbytes=8, prototype=define
Linker and Libraries:
ld='env MACOSX_DEPLOYMENT_TARGET=10.3 gcc-mp-4.9', ldflags =' -fstack-protector-strong -L/opt/local/lib -L/usr/local/lib -L/opt/local/lib/libgcc'
libpth=/opt/local/lib /opt/local/lib/gcc49/gcc/x86_64-apple-darwin14/4.9.3/include-fixed /usr/lib /usr/local/lib /opt/local/lib/libgcc
libs=-lpthread -lgdbm -ldbm -ldl -lm -lutil -lc
perllibs=-lpthread -ldl -lm -lutil -lc
libc=, so=dylib, useshrplib=false, libperl=libperl.a
gnulibc_version=''
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=bundle, d_dlsymun=undef, ccdlflags=' '
cccdlflags=' ', lddlflags=' -bundle -undefined dynamic_lookup -L/opt/local/lib -L/usr/local/lib -L/opt/local/lib/libgcc -fstack-protector-strong'
Locally applied patches:
1de5b756a3b0a0edc1b957e20fc801ecedc77b1c
e9576735f4e1a76e7140b008dc487e7a09774414
---
@INC for perl 5.23.2:
lib
/usr/local/lib/perl5/site_perl/5.23.2/darwin-2level
/usr/local/lib/perl5/site_perl/5.23.2
/usr/local/lib/perl5/5.23.2/darwin-2level
/usr/local/lib/perl5/5.23.2
/usr/local/lib/perl5/site_perl
.
---
Environment for perl 5.23.2:
DYLD_LIBRARY_PATH (unset)
HOME=/Users/rurban
LANG=en_US.UTF-8
LANGUAGE (unset)
LC_CTYPE=en_US.UTF-8
LD_LIBRARY_PATH (unset)
LOGDIR (unset)
PATH=/opt/local/libexec/gnubin:/opt/local/bin:/opt/local/sbin:/Users/rurban/bin:/opt/local/libexec/perl5.18/sitebin:/usr/local/bin:/usr/bin:/bin:/usr/sbin:/sbin:/opt/X11/bin
PERL_BADLANG (unset)
SHELL=/bin/bash
# Please include the string: [perl #125792]
# in the subject line of all future correspondence about this issue.
# <URL: https://rt.perl.org/Ticket/Display.html?id=125792 >
This is a bug report for perl from ***@cpanel.net,
generated with the help of perlbug 1.40 running under perl 5.23.2.
From 5820089dc170ce9b58d622f5f72c9711b3935f03 Mon Sep 17 00:00:00 2001
From: Reini Urban <***@cpanel.net>Date: Wed, 12 Aug 2015 08:17:18 +0200
Subject: [PATCH 1/2] sassign is wrongly declared as BASEOP, not BINOP.
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="------------2.4.5"
This is a multi-part message in MIME format.
--------------2.4.5
Content-Type: text/plain; charset=UTF-8; format=fixed
Content-Transfer-Encoding: 8bit
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.
---
op.c | 6 ++----
opcode.h | 2 +-
regen/opcodes | 3 +--
3 files changed, 4 insertions(+), 7 deletions(-)
--------------2.4.5
Content-Type: text/x-patch; name="0001-sassign-is-wrongly-declared-as-BASEOP-not-BINOP.patch"
Content-Transfer-Encoding: 8bit
Content-Disposition: attachment; filename="0001-sassign-is-wrongly-declared-as-BASEOP-not-BINOP.patch"
diff --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--
From a5ac2142d6243bb0bc54babf42dce91f06ddc3b3 Mon Sep 17 00:00:00 2001
From: Reini Urban <***@cpanel.net>Date: Wed, 12 Aug 2015 09:21:13 +0200
Subject: [PATCH 2/2] sassign was used as UNOP, optimize {or,and,dor}assign
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="------------2.4.5"
This is a multi-part message in MIME format.
--------------2.4.5
Content-Type: text/plain; charset=UTF-8; format=fixed
Content-Transfer-Encoding: 8bit
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.
---
op.c | 11 +++++------
pp_hot.c | 2 +-
2 files changed, 6 insertions(+), 7 deletions(-)
--------------2.4.5
Content-Type: text/x-patch; name="0002-sassign-was-used-as-UNOP-optimize-or-and-dor-assign.patch"
Content-Transfer-Encoding: 8bit
Content-Disposition: attachment; filename="0002-sassign-was-used-as-UNOP-optimize-or-and-dor-assign.patch"
diff --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--
---
Flags:
category=core
severity=medium
---
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:
Local Commit: e9576735f4e1a76e7140b008dc487e7a09774414
Ancestor: 9b669ea1e2997fbb78558e1fc0a7ecae3aa23af0
Platform:
osname=darwin, osvers=14.4.0, archname=darwin-2level
uname='darwin airc.local 14.4.0 darwin kernel version 14.4.0: thu may 28 11:35:04 pdt 2015; root:xnu-2782.30.5~1release_x86_64 x86_64 i386 macbookair6,2 darwin '
config_args='-sder -Dusedevel -Dusecperl -DDEBUGGING -Dcc=gcc-mp-4.9 -Accflags=-march=corei7 -DDEBUG_LEAKING_SCALARS -Doptimize=-g3 -Dinstallman1dir=none -Dinstallman3dir=none -Dinstallsiteman1dir=none -Dinstallsiteman3dir=none'
hint=recommended, useposix=true, d_sigaction=define
useithreads=undef, usemultiplicity=undef
use64bitint=define, use64bitall=define, uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler:
cc='gcc-mp-4.9', ccflags ='-fno-common -DPERL_DARWIN -march=corei7 -DDEBUG_LEAKING_SCALARS -fwrapv -DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/include -I/opt/local/include',
optimize='-g3',
cppflags='-fno-common -DPERL_DARWIN -march=corei7 -DDEBUG_LEAKING_SCALARS -fwrapv -DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/include -I/opt/local/include'
ccversion='', gccversion='4.9.3', gccosandvers=''
intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678, doublekind=3
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16, longdblkind=3
ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
alignbytes=8, prototype=define
Linker and Libraries:
ld='env MACOSX_DEPLOYMENT_TARGET=10.3 gcc-mp-4.9', ldflags =' -fstack-protector-strong -L/opt/local/lib -L/usr/local/lib -L/opt/local/lib/libgcc'
libpth=/opt/local/lib /opt/local/lib/gcc49/gcc/x86_64-apple-darwin14/4.9.3/include-fixed /usr/lib /usr/local/lib /opt/local/lib/libgcc
libs=-lpthread -lgdbm -ldbm -ldl -lm -lutil -lc
perllibs=-lpthread -ldl -lm -lutil -lc
libc=, so=dylib, useshrplib=false, libperl=libperl.a
gnulibc_version=''
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=bundle, d_dlsymun=undef, ccdlflags=' '
cccdlflags=' ', lddlflags=' -bundle -undefined dynamic_lookup -L/opt/local/lib -L/usr/local/lib -L/opt/local/lib/libgcc -fstack-protector-strong'
Locally applied patches:
1de5b756a3b0a0edc1b957e20fc801ecedc77b1c
e9576735f4e1a76e7140b008dc487e7a09774414
---
@INC for perl 5.23.2:
lib
/usr/local/lib/perl5/site_perl/5.23.2/darwin-2level
/usr/local/lib/perl5/site_perl/5.23.2
/usr/local/lib/perl5/5.23.2/darwin-2level
/usr/local/lib/perl5/5.23.2
/usr/local/lib/perl5/site_perl
.
---
Environment for perl 5.23.2:
DYLD_LIBRARY_PATH (unset)
HOME=/Users/rurban
LANG=en_US.UTF-8
LANGUAGE (unset)
LC_CTYPE=en_US.UTF-8
LD_LIBRARY_PATH (unset)
LOGDIR (unset)
PATH=/opt/local/libexec/gnubin:/opt/local/bin:/opt/local/sbin:/Users/rurban/bin:/opt/local/libexec/perl5.18/sitebin:/usr/local/bin:/usr/bin:/bin:/usr/sbin:/sbin:/opt/X11/bin
PERL_BADLANG (unset)
SHELL=/bin/bash