Skip Menu |
Report information
Id: 130981
Status: open
Priority: 0/
Queue: perl5

Owner: Nobody
Requestors: paul [at] pjcj.net
Cc:
AdminCc:

Operating System: (no value)
PatchStatus: (no value)
Severity: low
Type: library
Perl Version: 5.25.10
Fixed In: (no value)

Attachments
0001-perl-130981-properly-deparse-the-new-form-of-unless-.patch



CC: paul [...] pjcj.net
Date: Sat, 11 Mar 2017 14:23:17 +0000 (GMT)
To: perlbug [...] perl.org
Subject: Confusing B::Deparse output with unless/elsif
From: paul [...] pjcj.net
Download (untitled) / with headers
text/plain 4.4k
This is a bug report for perl from paul@pjcj.net, generated with the help of perlbug 1.40 running under perl 5.25.10. ----------------------------------------------------------------- B::Deparse outputs some fairly confusing code for unless/elsif constructs: $ perl5.25.10 -MO=Deparse -e 'unless ($a) { $b } elsif($c) { $d }' $a ? do { $c } && do { $d } : do { $b }; -e syntax OK $ perl5.22.3 -MO=Deparse -e 'unless ($a) { $b } elsif($c) { $d }' if (not $a) { $b; } elsif ($c) { $d; } -e syntax OK $ 5.24.1 has the same output as 5.25.10 so it is not strictly a regression, I suppose. I've not confirmed, but I presume it came in somewhere during 5.23.x development. It is (rightly) quite an uncommon construct so I imagine it was just overlooked, but it does rather confuse Devel::Cover. See http://cpancover.com/latest//Net-DNS-1.08_02/blib-lib-Net-DNS-RR-pm--condition.html#113-1 for an example in the wild. [Please do not change anything below this line] ----------------------------------------------------------------- --- Flags: category=library severity=low module=B::Deparse --- Site configuration information for perl 5.25.10: Configured by pjcj at Sat Mar 11 13:42:34 GMT 2017. Summary of my perl5 (revision 5 version 25 subversion 10) configuration: Platform: osname=linux osvers=3.13.0-110-generic archname=x86_64-linux uname='linux cpancover1.default.cpancover.uk0.bigv.io 3.13.0-110-generic #157-ubuntu smp mon feb 20 11:54:05 utc 2017 x86_64 x86_64 x86_64 gnulinux ' config_args='-de -Dprefix=/cover/perls/perlbrew/perls/perl-5.25.10 -Dusedevel -Aeval:scriptdir=/cover/perls/perlbrew/perls/perl-5.25.10/bin' hint=recommended useposix=true d_sigaction=define useithreads=undef usemultiplicity=undef use64bitint=define use64bitall=define uselongdouble=undef usemymalloc=n bincompat5005=undef Compiler: cc='cc' ccflags ='-fwrapv -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64' optimize='-O2' cppflags='-fwrapv -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include' ccversion='' gccversion='4.8.4' 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='cc' ldflags =' -fstack-protector -L/usr/local/lib' libpth=/usr/local/lib /usr/lib/gcc/x86_64-linux-gnu/4.8/include-fixed /usr/include/x86_64-linux-gnu /usr/lib /lib/x86_64-linux-gnu /lib/../lib /usr/lib/x86_64-linux-gnu /usr/lib/../lib /lib libs=-lpthread -lnsl -ldb -ldl -lm -lcrypt -lutil -lc perllibs=-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc libc=libc-2.19.so so=so useshrplib=false libperl=libperl.a gnulibc_version='2.19' Dynamic Linking: dlsrc=dl_dlopen.xs dlext=so d_dlsymun=undef ccdlflags='-Wl,-E' cccdlflags='-fPIC' lddlflags='-shared -O2 -L/usr/local/lib -fstack-protector' Locally applied patches: Devel::PatchPerl 1.38 --- @INC for perl 5.25.10: /cover/perls/perlbrew/perls/perl-5.25.10/lib/site_perl/5.25.10/x86_64-linux /cover/perls/perlbrew/perls/perl-5.25.10/lib/site_perl/5.25.10 /cover/perls/perlbrew/perls/perl-5.25.10/lib/5.25.10/x86_64-linux /cover/perls/perlbrew/perls/perl-5.25.10/lib/5.25.10 --- Environment for perl 5.25.10: HOME=/home/pjcj LANG=en_GB.UTF-8 LANGUAGE=en_GB.UTF-8 LC_ALL=en_GB.UTF-8 LC_COLLATE=en_GB.UTF-8 LC_CTYPE=en_GB.UTF-8 LC_MESSAGES=en_GB.UTF-8 LD_LIBRARY_PATH (unset) LOGDIR (unset) PATH=/cover/perls/perlbrew/bin:/cover/perls/perlbrew/perls/perl-5.25.10/bin:/home/pjcj/g/base/utils:/home/pjcj/.local/bin:/home/pjcj/g/go/bin:/home/pjcj/g/sw/bin:/home/pjcj/.zplug/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games:/usr/local/games PERLBREW=command perlbrew PERLBREW_BASHRC_VERSION=0.75 PERLBREW_HOME=/home/pjcj/.perlbrew PERLBREW_MANPATH=/cover/perls/perlbrew/perls/perl-5.25.10/man PERLBREW_PATH=/cover/perls/perlbrew/bin:/cover/perls/perlbrew/perls/perl-5.25.10/bin PERLBREW_PERL=perl-5.25.10 PERLBREW_ROOT=/cover/perls/perlbrew PERLBREW_VERSION=0.75 PERL_BADLANG (unset) SHELL=/usr/bin/zsh
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 2.6k
On Sat, 11 Mar 2017 14:56:49 GMT, paul@pjcj.net wrote: Show quoted text
> > This is a bug report for perl from paul@pjcj.net, > generated with the help of perlbug 1.40 running under perl 5.25.10. > > > ----------------------------------------------------------------- > B::Deparse outputs some fairly confusing code for unless/elsif > constructs: > > $ perl5.25.10 -MO=Deparse -e 'unless ($a) { $b } elsif($c) { $d }' > $a ? do { > $c > } && do { > $d > } : do { > $b > }; > -e syntax OK > $ perl5.22.3 -MO=Deparse -e 'unless ($a) { $b } elsif($c) { $d }' > if (not $a) { > $b; > } > elsif ($c) { > $d; > } > -e syntax OK > $ > > 5.24.1 has the same output as 5.25.10 so it is not strictly a > regression, I > suppose. I've not confirmed, but I presume it came in somewhere > during > 5.23.x development. > > It is (rightly) quite an uncommon construct so I imagine it was just > overlooked, but it does rather confuse Devel::Cover. See > http://cpancover.com/latest//Net-DNS-1.08_02/blib-lib-Net-DNS-RR-pm-- > condition.html#113-1 > for an example in the wild. >
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: ##### Version: v5.23.7 Previous HEAD position was 8d0cd0d... add new release to perlhist HEAD is now at 0057cac... add in the Known Issue, thanks again to BinGOs++ my($w, $x, $y, $z) = ('') x 4; if (not $w) { $x; } elsif ($y) { $z; } /home/jkeenan/learn/perl/unless.pl syntax OK ##### Version: v5.23.8 Previous HEAD position was 0057cac... add in the Known Issue, thanks again to BinGOs++ HEAD is now at 0d316f7... add new release to perlhist my($w, $x, $y, $z) = ('') x 4; $w ? do { $y } && do { $z } : do { $x }; /home/jkeenan/learn/perl/unless.pl syntax OK ##### 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: ##### commit dc6dfd62197489a4c671a17a43d8555551b5446c Author: Lukas Mai <l.mai@web.de> AuthorDate: Wed Jan 6 15:16:16 2016 +0100 Commit: Lukas Mai <l.mai@web.de> CommitDate: Wed Jan 6 15:27:43 2016 +0100 Deparse the /n flag on regexes [perl #127189] ##### But, when I build perl at dc6dfd62197489a4c671a17a43d8555551b5446c^ and dc6dfd62197489a4c671a17a43d8555551b5446c and ran the test program, I got the same -- "good" -- results both times: ##### my($w, $x, $y, $z) = ('') x 4; if (not $w) { $x; } elsif ($y) { $z; } /home/jkeenan/learn/perl/unless.pl syntax OK ##### So I haven't yet been able to identify the commit where the problem first appeared. Thank you very much. -- James E Keenan (jkeenan@cpan.org)
RT-Send-CC: perl5-porters [...] perl.org
On Sat, 11 Mar 2017 10:03:55 -0800, jkeenan wrote: Show quoted text
> On Sat, 11 Mar 2017 14:56:49 GMT, paul@pjcj.net wrote:
> > > > This is a bug report for perl from paul@pjcj.net, > > generated with the help of perlbug 1.40 running under perl 5.25.10. > > > > > > ----------------------------------------------------------------- > > B::Deparse outputs some fairly confusing code for unless/elsif > > constructs: > > > > $ perl5.25.10 -MO=Deparse -e 'unless ($a) { $b } elsif($c) { $d }' > > $a ? do { > > $c > > } && do { > > $d > > } : do { > > $b > > }; > > -e syntax OK > > $ perl5.22.3 -MO=Deparse -e 'unless ($a) { $b } elsif($c) { $d }' > > if (not $a) { > > $b; > > } > > elsif ($c) { > > $d; > > } > > -e syntax OK > > $ > > > > 5.24.1 has the same output as 5.25.10 so it is not strictly a > > regression, I > > suppose. I've not confirmed, but I presume it came in somewhere > > during > > 5.23.x development. > > > > It is (rightly) quite an uncommon construct so I imagine it was just > > overlooked, but it does rather confuse Devel::Cover. See > > http://cpancover.com/latest//Net-DNS-1.08_02/blib-lib-Net-DNS-RR-pm-- > > condition.html#113-1 > > for an example in the wild. > >
> > 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: > > ##### > Version: v5.23.7 > Previous HEAD position was 8d0cd0d... add new release to perlhist > HEAD is now at 0057cac... add in the Known Issue, thanks again to > BinGOs++ > my($w, $x, $y, $z) = ('') x 4; > if (not $w) { > $x; > } > elsif ($y) { > $z; > } > /home/jkeenan/learn/perl/unless.pl syntax OK > ##### > Version: v5.23.8 > Previous HEAD position was 0057cac... add in the Known Issue, thanks > again to BinGOs++ > HEAD is now at 0d316f7... add new release to perlhist > my($w, $x, $y, $z) = ('') x 4; > $w ? do { > $y > } && do { > $z > } : do { > $x > }; > /home/jkeenan/learn/perl/unless.pl syntax OK > ##### > > 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: > > ##### > commit dc6dfd62197489a4c671a17a43d8555551b5446c > Author: Lukas Mai <l.mai@web.de> > AuthorDate: Wed Jan 6 15:16:16 2016 +0100 > Commit: Lukas Mai <l.mai@web.de> > CommitDate: Wed Jan 6 15:27:43 2016 +0100 > > Deparse the /n flag on regexes [perl #127189] > ##### > > But, when I build perl at dc6dfd62197489a4c671a17a43d8555551b5446c^ > and dc6dfd62197489a4c671a17a43d8555551b5446c and ran the test program, > I got the same -- "good" -- results both times: > > ##### > my($w, $x, $y, $z) = ('') x 4; > if (not $w) { > $x; > } > elsif ($y) { > $z; > } > /home/jkeenan/learn/perl/unless.pl syntax OK > ##### > > So I haven't yet been able to identify the commit where the problem > first appeared. > > Thank you very much.
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.
Date: Mon, 13 Mar 2017 09:47:28 +0000
CC: perl5-porters [...] perl.org
To: Curtis Jewell via RT <perlbug-comment [...] perl.org>
Subject: Re: [perl #130981] Confusing B::Deparse output with unless/elsif
From: Dave Mitchell <davem [...] iabyn.com>
Download (untitled) / with headers
text/plain 741b
On Sat, Mar 11, 2017 at 01:30:35PM -0800, Curtis Jewell via RT wrote: Show quoted text
> 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.
It bisects to this: commit 08b3e84fbb1c493d7157c2ad8d1dec4242c965cc Author: Tony Cook <tony@develop-help.com> Date: Mon Jan 4 10:17:22 2016 +1100 [perl #127122] warn on unless (assignment) when syntax warnings are on Previously the assignment was hidden by the not op wrapped around the condition, but newCONDOP() is sufficiently flexible that it isn't needed. -- Red sky at night - gerroff my land! Red sky at morning - gerroff my land! -- old farmers' sayings #14
CC: perl5-porters [...] perl.org
Date: Mon, 13 Mar 2017 11:58:33 +0000
To: Curtis Jewell via RT <perlbug-comment [...] perl.org>
From: Dave Mitchell <davem [...] iabyn.com>
Subject: Re: [perl #130981] Confusing B::Deparse output with unless/elsif
Download (untitled) / with headers
text/plain 1.1k
On Mon, Mar 13, 2017 at 09:47:28AM +0000, Dave Mitchell wrote: Show quoted text
> On Sat, Mar 11, 2017 at 01:30:35PM -0800, Curtis Jewell via RT 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.
> > It bisects to this: > > commit 08b3e84fbb1c493d7157c2ad8d1dec4242c965cc > Author: Tony Cook <tony@develop-help.com> > Date: Mon Jan 4 10:17:22 2016 +1100 > > [perl #127122] warn on unless (assignment) when syntax warnings are on > > Previously the assignment was hidden by the not op wrapped around the > condition, but newCONDOP() is sufficiently flexible that it isn't > needed.
... which triggers an optimisation that causes the 'if' and 'else' children of the condexpr op to be swapped and a 'not' op eliminated. This is confuses the "is it an if/else or a ?:" heuristics in Deparse.pm and it guesses wrong. Going forward, I think it would be better to set private flags in and/or/condexpr ops to indicate that this was compiled via an 'if/else' rather than getting Deparse to guess. -- No matter how many dust sheets you use, you will get paint on the carpet.
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 831b
On Mon, 13 Mar 2017 09:48:03 GMT, davem wrote: Show quoted text
> On Sat, Mar 11, 2017 at 01:30:35PM -0800, Curtis Jewell via RT 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.
> > It bisects to this: > > commit 08b3e84fbb1c493d7157c2ad8d1dec4242c965cc > Author: Tony Cook <tony@develop-help.com> > Date: Mon Jan 4 10:17:22 2016 +1100 > > [perl #127122] warn on unless (assignment) when syntax warnings are on > > Previously the assignment was hidden by the not op wrapped around the > condition, but newCONDOP() is sufficiently flexible that it isn't > needed. > >
Could you share the bisection approach you took to this? Thank you very much. -- James E Keenan (jkeenan@cpan.org)
CC: perl5-porters [...] perl.org
Date: Mon, 20 Mar 2017 08:36:35 +0000
Subject: Re: [perl #130981] Confusing B::Deparse output with unless/elsif
From: Dave Mitchell <davem [...] iabyn.com>
To: James E Keenan via RT <perlbug-followup [...] perl.org>
Download (untitled) / with headers
text/plain 1.2k
On Tue, Mar 14, 2017 at 05:38:28AM -0700, James E Keenan via RT wrote: Show quoted text
> On Mon, 13 Mar 2017 09:48:03 GMT, davem wrote:
> > On Sat, Mar 11, 2017 at 01:30:35PM -0800, Curtis Jewell via RT 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.
> > > > It bisects to this: > > > > commit 08b3e84fbb1c493d7157c2ad8d1dec4242c965cc > > Author: Tony Cook <tony@develop-help.com> > > Date: Mon Jan 4 10:17:22 2016 +1100 > > > > [perl #127122] warn on unless (assignment) when syntax warnings are on > > > > Previously the assignment was hidden by the not op wrapped around the > > condition, but newCONDOP() is sufficiently flexible that it isn't > > needed. > > > >
> > Could you share the bisection approach you took to this?
Sorry, I didn't spot your email till a week later, so I can't remember exactly. But I probably created a shell script, /tmp/s say, containing: #!/bin/sh $@ -MO=Deparse -e 'unless ($a) { $b } elsif($c) { $d }' 2>&1 | grep -q not which does: $ /tmp/s perl5220; echo $? 0 $ /tmp/s perl5240; echo $? 1 Then ran $ Porting/bisect.pl .... -- /tmp/s ./perl -Ilib -- A problem shared is a problem doubled.
To: perl5-porters [...] perl.org
From: James E Keenan <jkeen [...] verizon.net>
Subject: Re: [perl #130981] Confusing B::Deparse output with unless/elsif
Date: Mon, 20 Mar 2017 11:29:57 -0400
Download (untitled) / with headers
text/plain 1.4k
On 03/20/2017 04:36 AM, Dave Mitchell wrote: Show quoted text
> On Tue, Mar 14, 2017 at 05:38:28AM -0700, James E Keenan via RT wrote:
>> On Mon, 13 Mar 2017 09:48:03 GMT, davem wrote:
>>> On Sat, Mar 11, 2017 at 01:30:35PM -0800, Curtis Jewell via RT 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.
>>> >>> It bisects to this: >>> >>> commit 08b3e84fbb1c493d7157c2ad8d1dec4242c965cc >>> Author: Tony Cook <tony@develop-help.com> >>> Date: Mon Jan 4 10:17:22 2016 +1100 >>> >>> [perl #127122] warn on unless (assignment) when syntax warnings are on >>> >>> Previously the assignment was hidden by the not op wrapped around the >>> condition, but newCONDOP() is sufficiently flexible that it isn't >>> needed. >>> >>>
>> >> Could you share the bisection approach you took to this?
> > Sorry, I didn't spot your email till a week later, so I can't remember > exactly. But I probably created a shell script, /tmp/s say, containing: > > #!/bin/sh > $@ -MO=Deparse -e 'unless ($a) { $b } elsif($c) { $d }' 2>&1 | grep -q not > > which does: > > $ /tmp/s perl5220; echo $? > 0 > $ /tmp/s perl5240; echo $? > 1 > > Then ran > > $ Porting/bisect.pl .... -- /tmp/s ./perl -Ilib > > >
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.
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 1.4k
On Mon, 13 Mar 2017 04:59:15 -0700, davem wrote: Show quoted text
> On Mon, Mar 13, 2017 at 09:47:28AM +0000, Dave Mitchell wrote:
> > On Sat, Mar 11, 2017 at 01:30:35PM -0800, Curtis Jewell via RT 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.
> > > > It bisects to this: > > > > commit 08b3e84fbb1c493d7157c2ad8d1dec4242c965cc > > Author: Tony Cook <tony@develop-help.com> > > Date: Mon Jan 4 10:17:22 2016 +1100 > > > > [perl #127122] warn on unless (assignment) when syntax warnings are on > > > > Previously the assignment was hidden by the not op wrapped around the > > condition, but newCONDOP() is sufficiently flexible that it isn't > > needed.
> > ... which triggers an optimisation that causes the 'if' and 'else' > children of the condexpr op to be swapped and a 'not' op eliminated. > This is confuses the "is it an if/else or a ?:" heuristics in Deparse.pm > and it guesses wrong. > > Going forward, I think it would be better to set private flags in > and/or/condexpr ops to indicate that this was compiled via an 'if/else' > rather than getting Deparse to guess.
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
Subject: 0001-perl-130981-properly-deparse-the-new-form-of-unless-.patch
From 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
Date: Wed, 7 Jun 2017 14:22:48 +0100
From: Dave Mitchell <davem [...] iabyn.com>
CC: perl5-porters [...] perl.org
To: Tony Cook via RT <perlbug-followup [...] perl.org>
Subject: Re: [perl #130981] Confusing B::Deparse output with unless/elsif
Download (untitled) / with headers
text/plain 1.1k
On Tue, Jun 06, 2017 at 06:18:29PM -0700, Tony Cook via RT wrote: Show quoted text
> Just differentiating if/else vs ?: wouldn't help in the case of a simple > unless/else, though that might be considered harmless.
I don't understand what you mean there. Setting a flag on the OP_AND op would let Deparse distinguish between $x && $y; if ($x) { $y } and setting a flag on the OP_OR op would distinguish between $x || $y unless ($x) { $y } and setting a flag on the OP_CONDEXPR op would distinguish between $x ? $y : $z if ($x) { $y } else { $z } Show quoted text
> 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
Perhaps instead there should be an extra flag for newCONDOP which indicates that its args have been reversed: this could then be used as a general hint for deparsing not only unless/else, but also if(!$x)/else and !$x ? $y : $z and the like, assuming that such things get optimised, either now or in the future. (To be used in conjunction with the flag I suggested). -- "Do not dabble in paradox, Edward, it puts you in danger of fortuitous wit." -- Lady Croom, "Arcadia"


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

For issues related to this RT instance (aka "perlbug"), please contact perlbug-admin at perl.org