B::Deparse double do

[p5pRT]

Migrated from rt.perl.org#40055 (status was 'resolved')

Searchable as RT40055$

[p5pRT]

From @nwc10

Created by @nwc10

The pair of do's isn't correct​:

perl -MO=Deparse -e 'if($a) {do {}}' if ($a) {   do {   do {   ()   }   }; } -e syntax OK

$ perl -MO=Deparse -e 'do { 42 } while 0'
do {   do {   '???'   } }; -e syntax OK

I've no idea why it's happening.

Nicholas Clark

Perl Info

``` Flags: category=library severity=low Site configuration information for perl v5.8.8: Configured by mstevens at Thu Jun 22 11:13:55 BST 2006. Summary of my perl5 (revision 5 version 8 subversion 8) configuration: Platform: osname=freebsd, osvers=6.1-release, archname=i386-freebsd-64int uname='freebsd saigo.etla.org 6.1-release freebsd 6.1-release #0: sat may 13 19:14:56 bst 2006 root@saigo.etla.org:usrobjusrsrcsyssaigo2 i386 ' config_args='-sde -Dprefix=/usr/local -Darchlib=/usr/local/lib/perl5/5.8.8/mach -Dprivlib=/usr/local/lib/perl5/5.8.8 -Dman3dir=/usr/local/lib/perl5/5.8.8/perl/man/man3 -Dman1dir=/usr/local/man/man1 -Dsitearch=/usr/local/lib/perl5/site_perl/5.8.8/mach -Dsitelib=/usr/local/lib/perl5/site_perl/5.8.8 -Dscriptdir=/usr/local/bin -Dsiteman3dir=/usr/local/lib/perl5/5.8.8/man/man3 -Dsiteman1dir=/usr/local/man/man1 -Ui_malloc -Ui_iconv -Uinstallusrbinperl -Dcc=cc -Duseshrplib -Dccflags=-DAPPLLIB_EXP="/usr/local/lib/perl5/5.8.8/BSDPAN" -Doptimize=-O2 -fno-strict-aliasing -pipe -march=pentium4 -Ud_dosuid -Ui_gdbm -Dusethreads=n -Dusemymalloc=y -Duse64bitint' hint=recommended, useposix=true, d_sigaction=define usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef useperlio=define d_sfio=undef uselargefiles=define usesocks=undef use64bitint=define use64bitall=undef uselongdouble=undef usemymalloc=y, bincompat5005=undef Compiler: cc='cc', ccflags ='-DAPPLLIB_EXP="/usr/local/lib/perl5/5.8.8/BSDPAN" -DHAS_FPSETMASK -DHAS_FLOATINGPOINT_H -fno-strict-aliasing -pipe -Wdeclaration-after-statement -I/usr/local/include', optimize='-O2 -fno-strict-aliasing -pipe -march=pentium4', cppflags='-DAPPLLIB_EXP="/usr/local/lib/perl5/5.8.8/BSDPAN" -DHAS_FPSETMASK -DHAS_FLOATINGPOINT_H -fno-strict-aliasing -pipe -Wdeclaration-after-statement -I/usr/local/include' ccversion='', gccversion='3.4.4 [FreeBSD] 20050518', gccosandvers='' intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=12345678 d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12 ivtype='long long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8 alignbytes=4, prototype=define Linker and Libraries: ld='cc', ldflags =' -Wl,-E -L/usr/local/lib' libpth=/usr/lib /usr/local/lib libs=-lm -lcrypt -lutil perllibs=-lm -lcrypt -lutil libc=, so=so, useshrplib=true, libperl=libperl.so gnulibc_version='' Dynamic Linking: dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags=' -Wl,-R/usr/local/lib/perl5/5.8.8/mach/CORE' cccdlflags='-DPIC -fPIC', lddlflags='-shared -L/usr/local/lib' Locally applied patches: defined-or @INC for perl v5.8.8: /usr/local/lib/perl5/5.8.8/BSDPAN /usr/local/lib/perl5/site_perl/5.8.8/mach /usr/local/lib/perl5/site_perl/5.8.8 /usr/local/lib/perl5/site_perl /usr/local/lib/perl5/5.8.8/mach /usr/local/lib/perl5/5.8.8 . Environment for perl v5.8.8: HOME=/home/nick LANG (unset) LANGUAGE (unset) LD_LIBRARY_PATH (unset) LOGDIR (unset) PATH=/home/nick/bin:/sbin:/bin:/usr/sbin:/usr/bin:/usr/games:/usr/local/sbin:/usr/local/bin:/usr/X11R6/bin:/home/nick/bin:/usr/local/sbin:/sbin:/usr/sbin PERL_BADLANG (unset) SHELL=/usr/local/bin/bash ```

[p5pRT]

From maddingue@free.fr

The pair of do's isn't correct​:

perl -MO=Deparse -e 'if($a) {do {}}' if ($a) { do { do { () } }; } -e syntax OK

This can be reduced to​:

$ perl -MO=Deparse -e 'do{}' do {   do {   ()   } }; -e syntax OK

The funny thing is that each literal do{} seems to be replaced by two by B​::Deparse​:

$ perl -MO=Deparse -e 'do{do{}}' do {   do {   do {   do {   ()   }   }   } }; -e syntax OK

But the following cases do not expose the same behaviour​:

$ perl -MO=Deparse -e 'do()' do(()); -e syntax OK

$ perl -MO=Deparse -e 'do({})' do {}; -e syntax OK

$ perl -MO=Deparse -e 'do do {}' do do {   () }; -e syntax OK

-- Sébastien Aperghis-Tramoni

Close the world\, txEn eht nepO.

[p5pRT]

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

[p5pRT]

From rick@bort.ca

On Thu\, Aug 03\, 2006 at 02​:40​:04PM +0200\, Sébastien Aperghis-Tramoni wrote​:

This can be reduced to​:

$ perl -MO=Deparse -e 'do{}' do { do { () } }; -e syntax OK

I changed the way the test generated the regex because it would cause failures when there were trailing spaces in the test code. It would transform something like​:

  "do { } " -> 'do\ \{\ \}\ \ ' -> 'do\s+\{\s+\}\s+\s+'

Now it goes more like

  "do { } " -> 'do \{ \} ' -> 'do\s+\{\s+\}\s+'

which I think gives the intended result.

-- Rick Delaney rick@​bort.ca

Inline Patch

```diff diff -pruN perl-current/ext/B/B/Deparse.pm perl-current-dev/ext/B/B/Deparse.pm --- perl-current/ext/B/B/Deparse.pm 2006-07-13 13:14:46.000000000 -0400 +++ perl-current-dev/ext/B/B/Deparse.pm 2006-08-03 16:07:42.000000000 -0400 @@ -2674,6 +2674,10 @@ sub pp_null { return $self->pp_list($op, $cx); } elsif ($op->first->name eq "enter") { return $self->pp_leave($op, $cx); + } elsif ($op->first->name eq "leave") { + return $self->pp_leave($op->first, $cx); + } elsif ($op->first->name eq "scope") { + return $self->pp_scope($op->first, $cx); } elsif ($op->targ == OP_STRINGIFY) { return $self->dquote($op, $cx); } elsif (!null($op->first->sibling) and diff -pruN perl-current/ext/B/t/deparse.t perl-current-dev/ext/B/t/deparse.t --- perl-current/ext/B/t/deparse.t 2006-06-13 15:28:59.000000000 -0400 +++ perl-current-dev/ext/B/t/deparse.t 2006-08-03 17:03:07.000000000 -0400 @@ -24,7 +24,7 @@ use warnings; use strict; use Config; -print "1..40\n"; +print "1..42\n"; use B::Deparse; my $deparse = B::Deparse->new() or print "not "; @@ -63,13 +63,12 @@ while () { } else { my $deparsed = $deparse->coderef2text( $coderef ); - my $regex = quotemeta($expected); - do { - no warnings 'misc'; - $regex =~ s/\s+/\s+/g; - }; + my $regex = $expected; + $regex =~ s/(\S+)/\Q$1/g; + $regex =~ s/\s+/\\s+/g; + $regex = '^\{\s*' . $regex . '\s*\}$'; - my $ok = ($deparsed =~ /^\{\s*$regex\s*\}$/); + my $ok = ($deparsed =~ /$regex/); print (($ok ? "ok " : "not ok ") . $i++ . "\n"); if (!$ok) { print "# EXPECTED:\n"; @@ -324,3 +323,9 @@ print $_ foreach (reverse 1, 2..5); # 34 (bug #38684) our @ary; @ary = split(' ', 'foo', 0); +#### +# 35 (bug #40055) +do { () }; +#### +# 36 (ibid.) +do { my $x = 1; $x }; ```

[p5pRT]

From @rgs

Rick Delaney wrote​:

diff -pruN perl-current/ext/B/B/Deparse.pm perl-current-dev/ext/B/B/Deparse.pm --- perl-current/ext/B/B/Deparse.pm 2006-07-13 13​:14​:46.000000000 -0400 +++ perl-current-dev/ext/B/B/Deparse.pm 2006-08-03 16​:07​:42.000000000 -0400

Thanks\, applied as #28656.

[p5pRT]

@rgs - Status changed from 'open' to 'resolved'