Confusing B::Deparse output with unless/elsif #15920
Comments
From @pjcjCreated by @pjcjThis is a bug report for perl from paul@pjcj.net, ----------------------------------------------------------------- $ perl5.25.10 -MO=Deparse -e 'unless ($a) { $b } elsif($c) { $d }' 5.24.1 has the same output as 5.25.10 so it is not strictly a regression, I It is (rightly) quite an uncommon construct so I imagine it was just Perl Info |
From @jkeenanOn Sat, 11 Mar 2017 14:56:49 GMT, paul@pjcj.net wrote:
The change occurred between perl-5.23.7 and perl-5.23.8. Checking out each of those tags and configuring and building perl thereat, I got: ##### My hunch was that any change in lib/B/Deparse.pm during the month when 5.23.8 was in development (Dec 2015-Jan 2016) would explain the problem. The only time B::Deparse was modified during this period was: ##### Deparse the /n flag on regexes [perl #127189] But, when I build perl at dc6dfd6^ and dc6dfd6 and ran the test program, I got the same -- "good" -- results both times: ##### So I haven't yet been able to identify the commit where the problem first appeared. Thank you very much. -- |
|
The RT System itself - Status changed from 'new' to 'open' |
From @csjewellOn Sat, 11 Mar 2017 10:03:55 -0800, jkeenan wrote:
It doesn't necessarily have to be a B::Deparse change that did it... it could be changes in the code tree generation (or whatever it's called) and/or the optimizer. |
From [Unknown Contact. See original ticket]On Sat, 11 Mar 2017 10:03:55 -0800, jkeenan wrote:
It doesn't necessarily have to be a B::Deparse change that did it... it could be changes in the code tree generation (or whatever it's called) and/or the optimizer. |
From @iabynOn Sat, Mar 11, 2017 at 01:30:35PM -0800, Curtis Jewell via RT wrote:
It bisects to this: commit 08b3e84 [perl #127122] warn on unless (assignment) when syntax warnings are on -- |
From @iabynOn Mon, Mar 13, 2017 at 09:47:28AM +0000, Dave Mitchell wrote:
... which triggers an optimisation that causes the 'if' and 'else' Going forward, I think it would be better to set private flags in -- |
From @jkeenanOn Mon, 13 Mar 2017 09:48:03 GMT, davem wrote:
Could you share the bisection approach you took to this? Thank you very much. -- |
From @iabynOn Tue, Mar 14, 2017 at 05:38:28AM -0700, James E Keenan via RT wrote:
Sorry, I didn't spot your email till a week later, so I can't remember #!/bin/sh which does: $ /tmp/s perl5220; echo $? Then ran $ Porting/bisect.pl .... -- /tmp/s ./perl -Ilib -- |
From @jkeenanOn 03/20/2017 04:36 AM, Dave Mitchell wrote:
Thanks. I ran: perl Porting/bisect.pl --start=v5.23.7 --end=v5.23.8 -- /tmp/s ./perl -Ilib ... and got the same results as you did. |
From @tonycozOn Mon, 13 Mar 2017 04:59:15 -0700, davem wrote:
Just differentiating if/else vs ?: wouldn't help in the case of a simple unless/else, though that might be considered harmless. The attached creates a new private flag OPpLOGOP_UNLESS and sets it on the ops generated by newCONDOP(), then detects that in B::Deparse::pp_cond_expr Tony |
From @tonycoz0001-perl-130981-properly-deparse-the-new-form-of-unless-.patchFrom 2d898fd68443a1a5309567998d81e77cee502b36 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 6 Jun 2017 16:58:54 +1000
Subject: [perl #130981] properly deparse the new form of unless ... else
08b3e84f changed unless (expr) { A } else { B } from being generated
as:
!expr ? block A : block B
to:
expr ? block B : block A
resulting in that code being deparsed as an if() instead of unless().
This produced even worse results with elsif() hanging off the end.
Rather than trying to make deparse guess whether a construct is if()
or unless(), set a private flag on the cond_expr (and incidentally on
an "or" op if there's no else) and use that during deparsing to
produce the correct code.
---
lib/B/Deparse.pm | 8 +++-
lib/B/Deparse.t | 8 ++++
lib/B/Op_private.pm | 5 +-
opcode.h | 128 ++++++++++++++++++++++++++--------------------------
perly.act | 4 +-
perly.h | 2 +-
perly.tab | 2 +-
perly.y | 2 +-
regen/op_private | 5 +-
9 files changed, 91 insertions(+), 73 deletions(-)
diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm
index b22683a..5ff16e4 100644
--- a/lib/B/Deparse.pm
+++ b/lib/B/Deparse.pm
@@ -17,7 +17,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
OPpTRANS_SQUASH OPpTRANS_DELETE OPpTRANS_COMPLEMENT OPpTARGET_MY
OPpEXISTS_SUB OPpSORT_NUMERIC OPpSORT_INTEGER OPpREPEAT_DOLIST
OPpSORT_REVERSE OPpMULTIDEREF_EXISTS OPpMULTIDEREF_DELETE
- OPpSPLIT_ASSIGN OPpSPLIT_LEX
+ OPpSPLIT_ASSIGN OPpSPLIT_LEX OPpLOGOP_UNLESS
SVf_IOK SVf_NOK SVf_ROK SVf_POK SVpad_OUR SVf_FAKE SVs_RMG SVs_SMG
SVs_PADTMP SVpad_TYPED
CVf_METHOD CVf_LVALUE
@@ -3805,6 +3805,9 @@ sub pp_cond_expr {
my $true = $cond->sibling;
my $false = $true->sibling;
my $cuddle = $self->{'cuddle'};
+ if ($op->private & OPpLOGOP_UNLESS) {
+ ($true, $false) = ($false, $true);
+ }
unless ($cx < 1 and (is_scope($true) and $true->name ne "null") and
(is_scope($false) || is_ifelse_cont($false))
and $self->{'expand'} < 7) {
@@ -3816,7 +3819,8 @@ sub pp_cond_expr {
$cond = $self->deparse($cond, 1);
$true = $self->deparse($true, 0);
- my $head = $self->keyword("if") . " ($cond) {\n\t$true\n\b}";
+ my $head = $self->keyword(($op->private & OPpLOGOP_UNLESS) ? "unless" : "if")
+ . " ($cond) {\n\t$true\n\b}";
my @elsifs;
my $elsif;
while (!null($false) and is_ifelse_cont($false)) {
diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t
index 57c523c..f666605 100644
--- a/lib/B/Deparse.t
+++ b/lib/B/Deparse.t
@@ -2661,3 +2661,11 @@ our(@oa, %oh);
@oa = %oh{'foo', 'bar'};
@oa = delete @oh{'foo', 'bar'};
@oa = delete %oh{'foo', 'bar'};
+####
+# [perl #130981]
+my($a, $b, $c, $d);
+unless ($a) {
+ $b;
+} elsif ($c) {
+ $d;
+}
diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm
index 0993157..1eedc6c 100644
--- a/lib/B/Op_private.pm
+++ b/lib/B/Op_private.pm
@@ -285,7 +285,7 @@ $bits{chroot}{0} = $bf[0];
$bits{closedir}{0} = $bf[0];
$bits{complement}{0} = $bf[0];
@{$bits{concat}}{1,0} = ($bf[1], $bf[1]);
-$bits{cond_expr}{0} = $bf[0];
+@{$bits{cond_expr}}{6,0} = ('OPpLOGOP_UNLESS', $bf[0]);
@{$bits{connect}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{const}}{6,4,3,2,1} = ('OPpCONST_BARE', 'OPpCONST_ENTERED', 'OPpCONST_STRICT', 'OPpCONST_SHORTCIRCUIT', 'OPpCONST_NOVER');
@{$bits{coreargs}}{7,6,1,0} = ('OPpCOREARGS_PUSHMARK', 'OPpCOREARGS_SCALARMOD', 'OPpCOREARGS_DEREF2', 'OPpCOREARGS_DEREF1');
@@ -633,6 +633,7 @@ our %defines = (
OPpITER_REVERSED => 2,
OPpKVSLICE => 32,
OPpLIST_GUESSED => 64,
+ OPpLOGOP_UNLESS => 64,
OPpLVALUE => 128,
OPpLVAL_DEFER => 64,
OPpLVAL_INTRO => 128,
@@ -731,6 +732,7 @@ our %labels = (
OPpITER_REVERSED => 'REVERSED',
OPpKVSLICE => 'KVSLICE',
OPpLIST_GUESSED => 'GUESSED',
+ OPpLOGOP_UNLESS => 'UNLESS',
OPpLVALUE => 'LV',
OPpLVAL_DEFER => 'LVDEFER',
OPpLVAL_INTRO => 'LVINTRO',
@@ -802,6 +804,7 @@ our %ops_using = (
OPpITER_REVERSED => [qw(enteriter iter)],
OPpKVSLICE => [qw(delete)],
OPpLIST_GUESSED => [qw(list)],
+ OPpLOGOP_UNLESS => [qw(cond_expr)],
OPpLVALUE => [qw(leave leaveloop)],
OPpLVAL_DEFER => [qw(aelem helem multideref)],
OPpLVAL_INTRO => [qw(aelem aslice cond_expr delete enteriter entersub gvsv helem hslice list lvavref lvref lvrefslice multideref padav padhv padrange padsv pushmark refassign rv2av rv2gv rv2hv rv2sv split)],
diff --git a/opcode.h b/opcode.h
index f3ba953..ee3968b 100644
--- a/opcode.h
+++ b/opcode.h
@@ -2277,6 +2277,7 @@ END_EXTERN_C
#define OPpEXISTS_SUB 0x40
#define OPpFLIP_LINENUM 0x40
#define OPpLIST_GUESSED 0x40
+#define OPpLOGOP_UNLESS 0x40
#define OPpLVAL_DEFER 0x40
#define OPpOPEN_OUT_RAW 0x40
#define OPpOUR_INTRO 0x40
@@ -2406,6 +2407,7 @@ EXTCONST char PL_op_private_labels[] = {
'T','A','R','G','\0',
'T','A','R','G','M','Y','\0',
'U','N','I','\0',
+ 'U','N','L','E','S','S','\0',
'U','T','F','\0',
'k','e','y','\0',
'o','f','f','s','e','t','\0',
@@ -2428,11 +2430,11 @@ EXTCONST char PL_op_private_labels[] = {
EXTCONST I16 PL_op_private_bitfields[] = {
0, 8, -1,
0, 8, -1,
- 0, 547, -1,
+ 0, 554, -1,
0, 8, -1,
0, 8, -1,
- 0, 554, -1,
- 0, 543, -1,
+ 0, 561, -1,
+ 0, 550, -1,
1, -1, 0, 520, 1, 33, 2, 283, -1,
4, -1, 1, 164, 2, 171, 3, 178, -1,
4, -1, 0, 520, 1, 33, 2, 283, 3, 110, -1,
@@ -2628,33 +2630,33 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* orassign */
0, /* dorassign */
0, /* method */
- 141, /* entersub */
- 148, /* leavesub */
- 148, /* leavesublv */
+ 142, /* entersub */
+ 149, /* leavesub */
+ 149, /* leavesublv */
0, /* argcheck */
- 150, /* argelem */
+ 151, /* argelem */
0, /* argdefelem */
- 152, /* caller */
+ 153, /* caller */
50, /* warn */
50, /* die */
50, /* reset */
-1, /* lineseq */
- 154, /* nextstate */
- 154, /* dbstate */
+ 155, /* nextstate */
+ 155, /* dbstate */
-1, /* unstack */
-1, /* enter */
- 155, /* leave */
+ 156, /* leave */
-1, /* scope */
- 157, /* enteriter */
- 161, /* iter */
+ 158, /* enteriter */
+ 162, /* iter */
-1, /* enterloop */
- 162, /* leaveloop */
+ 163, /* leaveloop */
-1, /* return */
- 164, /* last */
- 164, /* next */
- 164, /* redo */
- 164, /* dump */
- 164, /* goto */
+ 165, /* last */
+ 165, /* next */
+ 165, /* redo */
+ 165, /* dump */
+ 165, /* goto */
50, /* exit */
0, /* method_named */
0, /* method_super */
@@ -2666,7 +2668,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* leavewhen */
-1, /* break */
-1, /* continue */
- 166, /* open */
+ 167, /* open */
50, /* close */
50, /* pipe_op */
50, /* fileno */
@@ -2682,7 +2684,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
50, /* getc */
50, /* read */
50, /* enterwrite */
- 148, /* leavewrite */
+ 149, /* leavewrite */
-1, /* prtf */
-1, /* print */
-1, /* say */
@@ -2712,33 +2714,33 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* getpeername */
0, /* lstat */
0, /* stat */
- 171, /* ftrread */
- 171, /* ftrwrite */
- 171, /* ftrexec */
- 171, /* fteread */
- 171, /* ftewrite */
- 171, /* fteexec */
- 176, /* ftis */
- 176, /* ftsize */
- 176, /* ftmtime */
- 176, /* ftatime */
- 176, /* ftctime */
- 176, /* ftrowned */
- 176, /* fteowned */
- 176, /* ftzero */
- 176, /* ftsock */
- 176, /* ftchr */
- 176, /* ftblk */
- 176, /* ftfile */
- 176, /* ftdir */
- 176, /* ftpipe */
- 176, /* ftsuid */
- 176, /* ftsgid */
- 176, /* ftsvtx */
- 176, /* ftlink */
- 176, /* fttty */
- 176, /* fttext */
- 176, /* ftbinary */
+ 172, /* ftrread */
+ 172, /* ftrwrite */
+ 172, /* ftrexec */
+ 172, /* fteread */
+ 172, /* ftewrite */
+ 172, /* fteexec */
+ 177, /* ftis */
+ 177, /* ftsize */
+ 177, /* ftmtime */
+ 177, /* ftatime */
+ 177, /* ftctime */
+ 177, /* ftrowned */
+ 177, /* fteowned */
+ 177, /* ftzero */
+ 177, /* ftsock */
+ 177, /* ftchr */
+ 177, /* ftblk */
+ 177, /* ftfile */
+ 177, /* ftdir */
+ 177, /* ftpipe */
+ 177, /* ftsuid */
+ 177, /* ftsgid */
+ 177, /* ftsvtx */
+ 177, /* ftlink */
+ 177, /* fttty */
+ 177, /* fttext */
+ 177, /* ftbinary */
77, /* chdir */
77, /* chown */
71, /* chroot */
@@ -2758,17 +2760,17 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* rewinddir */
0, /* closedir */
-1, /* fork */
- 180, /* wait */
+ 181, /* wait */
77, /* waitpid */
77, /* system */
77, /* exec */
77, /* kill */
- 180, /* getppid */
+ 181, /* getppid */
77, /* getpgrp */
77, /* setpgrp */
77, /* getpriority */
77, /* setpriority */
- 180, /* time */
+ 181, /* time */
-1, /* tms */
0, /* localtime */
50, /* gmtime */
@@ -2788,8 +2790,8 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* require */
0, /* dofile */
-1, /* hintseval */
- 181, /* entereval */
- 148, /* leaveeval */
+ 182, /* entereval */
+ 149, /* leaveeval */
0, /* entertry */
-1, /* leavetry */
0, /* ghbyname */
@@ -2827,18 +2829,18 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* lock */
0, /* once */
-1, /* custom */
- 187, /* coreargs */
- 191, /* avhvswitch */
+ 188, /* coreargs */
+ 192, /* avhvswitch */
3, /* runcv */
0, /* fc */
-1, /* padcv */
-1, /* introcv */
-1, /* clonecv */
- 193, /* padrange */
- 195, /* refassign */
- 201, /* lvref */
- 207, /* lvrefslice */
- 208, /* lvavref */
+ 194, /* padrange */
+ 196, /* refassign */
+ 202, /* lvref */
+ 208, /* lvrefslice */
+ 209, /* lvavref */
0, /* anonconst */
};
@@ -2898,7 +2900,7 @@ EXTCONST U16 PL_op_private_bitdefs[] = {
0x3e18, 0x3574, 0x1310, 0x27ac, 0x38c8, 0x28a4, 0x3241, /* sort */
0x27ac, 0x0003, /* reverse */
0x2b58, 0x0003, /* flip, flop */
- 0x2dbc, 0x0003, /* cond_expr */
+ 0x2dbc, 0x4378, 0x0003, /* cond_expr */
0x2dbc, 0x0ef8, 0x03d6, 0x028c, 0x4168, 0x3fa4, 0x2561, /* entersub */
0x3638, 0x0003, /* leavesub, leavesublv, leavewrite, leaveeval */
0x02aa, 0x0003, /* argelem */
@@ -2908,7 +2910,7 @@ EXTCONST U16 PL_op_private_bitdefs[] = {
0x2dbc, 0x32d8, 0x0f6c, 0x3945, /* enteriter */
0x3945, /* iter */
0x2c5c, 0x0067, /* leaveloop */
- 0x437c, 0x0003, /* last, next, redo, dump, goto */
+ 0x445c, 0x0003, /* last, next, redo, dump, goto */
0x34bc, 0x33d8, 0x2714, 0x2650, 0x018f, /* open */
0x1c70, 0x1ecc, 0x1d88, 0x1b44, 0x0003, /* ftrread, ftrwrite, ftrexec, fteread, ftewrite, fteexec */
0x1c70, 0x1ecc, 0x1d88, 0x0003, /* ftis, ftsize, ftmtime, ftatime, ftctime, ftrowned, fteowned, ftzero, ftsock, ftchr, ftblk, ftfile, ftdir, ftpipe, ftsuid, ftsgid, ftsvtx, ftlink, fttty, fttext, ftbinary */
@@ -3108,7 +3110,7 @@ EXTCONST U8 PL_op_private_valid[] = {
/* OR */ (OPpARG1_MASK),
/* XOR */ (OPpARG2_MASK),
/* DOR */ (OPpARG1_MASK),
- /* COND_EXPR */ (OPpARG1_MASK|OPpLVAL_INTRO),
+ /* COND_EXPR */ (OPpARG1_MASK|OPpLOGOP_UNLESS|OPpLVAL_INTRO),
/* ANDASSIGN */ (OPpARG1_MASK),
/* ORASSIGN */ (OPpARG1_MASK),
/* DORASSIGN */ (OPpARG1_MASK),
diff --git a/perly.act b/perly.act
index 73c44e5..bddbab8 100644
--- a/perly.act
+++ b/perly.act
@@ -369,7 +369,7 @@ case 2:
#line 365 "perly.y" /* yacc.c:1646 */
{
(yyval.opval) = block_end((ps[-4].val.ival),
- newCONDOP(0, (ps[-3].val.opval), (ps[0].val.opval), op_scope((ps[-1].val.opval))));
+ newCONDOP(OPpLOGOP_UNLESS << 8, (ps[-3].val.opval), (ps[0].val.opval), op_scope((ps[-1].val.opval))));
parser->copline = (line_t)(ps[-6].val.ival);
}
@@ -1977,6 +1977,6 @@ case 2:
/* Generated from:
- * a8b5527eacb1205d15c8c01acb4a8f99b494e5b453ddd68a2a2e7fca4be3302a perly.y
+ * 321632cf8a34b157ce477eeabc6bc504f4e47b42e85bef9b9bc3b7eda69e9d93 perly.y
* 153cba5d215c1a083a0459c43f4d55c45fd0a7093c197d7247a456dcde21ea53 regen_perly.pl
* ex: set ro: */
diff --git a/perly.h b/perly.h
index a7e9a43..b3f1cb1 100644
--- a/perly.h
+++ b/perly.h
@@ -181,6 +181,6 @@ int yyparse (void);
/* Generated from:
- * a8b5527eacb1205d15c8c01acb4a8f99b494e5b453ddd68a2a2e7fca4be3302a perly.y
+ * 321632cf8a34b157ce477eeabc6bc504f4e47b42e85bef9b9bc3b7eda69e9d93 perly.y
* 153cba5d215c1a083a0459c43f4d55c45fd0a7093c197d7247a456dcde21ea53 regen_perly.pl
* ex: set ro: */
diff --git a/perly.tab b/perly.tab
index e4065de..e0b1da8 100644
--- a/perly.tab
+++ b/perly.tab
@@ -1109,6 +1109,6 @@ static const toketypes yy_type_tab[] =
};
/* Generated from:
- * a8b5527eacb1205d15c8c01acb4a8f99b494e5b453ddd68a2a2e7fca4be3302a perly.y
+ * 321632cf8a34b157ce477eeabc6bc504f4e47b42e85bef9b9bc3b7eda69e9d93 perly.y
* 153cba5d215c1a083a0459c43f4d55c45fd0a7093c197d7247a456dcde21ea53 regen_perly.pl
* ex: set ro: */
diff --git a/perly.y b/perly.y
index 7d57dea..d3ec03e 100644
--- a/perly.y
+++ b/perly.y
@@ -364,7 +364,7 @@ barestmt: PLUGSTMT
| UNLESS '(' remember mexpr ')' mblock else
{
$$ = block_end($3,
- newCONDOP(0, $4, $7, op_scope($6)));
+ newCONDOP(OPpLOGOP_UNLESS << 8, $4, $7, op_scope($6)));
parser->copline = (line_t)$1;
}
| GIVEN '(' remember mexpr ')' mblock
diff --git a/regen/op_private b/regen/op_private
index 3a2a5d8..7aa24a4 100644
--- a/regen/op_private
+++ b/regen/op_private
@@ -306,7 +306,9 @@ addbits($_, 7 => qw(OPpLVAL_INTRO LVINTRO))
'list', # this gets set in my_attrs() for some reason
;
-
+addbits('cond_expr',
+ 6 => qw(OPpLOGOP_UNLESS UNLESS), # cond_expr, or is a reversed unless
+);
# TARGLEX
#
@@ -780,7 +782,6 @@ addbits('argelem',
},
);
-
1;
# ex: set ts=8 sts=4 sw=4 et:
--
2.1.4
|
From @iabynOn Tue, Jun 06, 2017 at 06:18:29PM -0700, Tony Cook via RT wrote:
I don't understand what you mean there. Setting a flag on the OP_AND op $x && $y; and setting a flag on the OP_OR op would distinguish between $x || $y and setting a flag on the OP_CONDEXPR op would distinguish between $x ? $y : $z
Perhaps instead there should be an extra flag for newCONDOP which -- |
Migrated from rt.perl.org#130981 (status was 'open')
Searchable as RT130981$
The text was updated successfully, but these errors were encountered: