Confusing B::Deparse output with unless/elsif

[p5pRT]

Migrated from rt.perl.org#130981 (status was 'open')

Searchable as RT130981$

[p5pRT]

From @pjcj

Created by @pjcj

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.

Perl Info

``` 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 ```

[p5pRT]

From @jkeenan

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.

-- James E Keenan (jkeenan@​cpan.org)

[p5pRT]

The RT System itself - Status changed from 'new' to 'open'

[p5pRT]

From @csjewell

On Sat\, 11 Mar 2017 10​:03​:55 -0800\, jkeenan wrote​:

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.

[p5pRT]

From [Unknown Contact. See original ticket]

On Sat\, 11 Mar 2017 10​:03​:55 -0800\, jkeenan wrote​:

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.

[p5pRT]

From @iabyn

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.

-- Red sky at night - gerroff my land! Red sky at morning - gerroff my land!   -- old farmers' sayings #14

[p5pRT]

From @iabyn

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.

-- No matter how many dust sheets you use\, you will get paint on the carpet.

[p5pRT]

From @jkeenan

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?

Thank you very much.

-- James E Keenan (jkeenan@​cpan.org)

[p5pRT]

From @iabyn

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

-- A problem shared is a problem doubled.

[p5pRT]

From @jkeenan

On 03/20/2017 04​:36 AM\, Dave Mitchell wrote​:

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.

[p5pRT]

From @tonycoz

On Mon\, 13 Mar 2017 04​:59​:15 -0700\, davem wrote​:

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

[p5pRT]

From @tonycoz

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

```diff From 2d898fd68443a1a5309567998d81e77cee502b36 Mon Sep 17 00:00:00 2001 From: Tony Cook 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 ```

[p5pRT]

From @iabyn

On Tue\, Jun 06\, 2017 at 06​:18​:29PM -0700\, Tony Cook via RT wrote​:

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 }

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"