Re: perl-5.11.2 breaks NYTProf savesrc option (Lexer API suspected)
Jesse
I've bounced this into RT. Once it comes through, I'll make it a 5.12 blocker.
-j
On Sat, Nov 21, 2009 at 11:47:23PM +0000, Tim Bunce wrote:
> I've just noticed this failure
> http://www.nntp.perl.org/group/perl.cpan.testers/2009/11/msg6070403.html
> and reproduced it myself.
>
> I presume something in the lexer API patch changed how the source code
> is saved in the @{"_<$filename"} array (which is accessed in C via
> GvAV(gv_fetchfile_flags(...)).
>
> I've no time to dig deeper now (hopefully tomorrow) but it looks like
> the first source code line is being now stored at array index 0, whereas
> it used to be stored at array index 1.
>
> Tim.
>
--
Tim Bunce
Zefram
>the first source code line is being now stored at array index 0, whereas
>it used to be stored at array index 1.
I did check that, and in my tests it worked as before. But the lexer
stuff is nevertheless the prime suspect for breaking this. I'll play
with the Devel::NYTProf test suite.
-zefram
Tim Bunce
> Tim Bunce wrote:
> >the first source code line is being now stored at array index 0, whereas
> >it used to be stored at array index 1.
>
> I did check that, and in my tests it worked as before.
I couldn't see any tests for this in the test suite.
Did I miss them?
> But the lexer
> stuff is nevertheless the prime suspect for breaking this.
> I'll play with the Devel::NYTProf test suite.
Devel::NYTProf's core and test suite are ia fairly complex beasts.
I think you'd probably be better off working with perl tests. I'll work
on the NYTProf side (and any relevant perl tests you identify or add to
the repository). We'll meet in the middle, so to speak.
Tim.
Tim Bunce
>
> I've bounced this into RT.
D'oh. I should have used perlbug, sorry.
I can't see it yet. Stuck somewhere?
Meanwhile, here's a simple test case:
-----------------------------------------------------------------
Perl 5.8.6:
$ echo 1 > a.pl; perl -MData::Dumper -e 'BEGIN { $^P=0x2 } do "a.pl"; print Dumper(\@{"_<a.pl"})'
$VAR1 = [
undef,
'1
'
];
Perl 5.11.2:
$ echo 1 > a.pl; perl -MData::Dumper -e 'BEGIN { $^P=0x2 } do "a.pl"; print Dumper(\@{"_<a.pl"})'
$VAR1 = [
'1
',
';',
';'
];
The primary problem is that source code line 1 used to be stored at index 1 but
is now stored at index 0. This breaks NYTProf tests and probably affects use of
the perl debugger.
A secondary problem is the extra semicolons that weren't in the original file.
A third problem is lack of tests for this in the test suite ;)
-----------------------------------------------------------------
> Once it comes through, I'll make it a 5.12 blocker.
It probably also affects use of the perl debugger.
Tim.
Tim Bunce
Zefram, any news?
Jesse, I can't see this in rt, should I just create a new ticket?
(I don't want to duplicate if you have one queued up somewhere.)
Tim.
Jesse
It looks like I must have fumble-fingered it. Please feel free to
resubmit. Point me at the ID and I'll blockerize it
>
> Tim.
>
--
Zefram
>Zefram, any news?
I've got a test script, and I'm working on the fix. Turns out those
semicolons are coming from more than one place, btw.
-zefram
Tim Bunce
I know perl appends "\n;\n" to the source saved for a string eval.
I'm not too worried by that kind of thing - although I'd rather it didn't.
I can change the NYTProf test to deal with that.
The primary issue is the off-by-one error in the array indexing.
Tim.
Tim Bunce
# Please include the string: [perl #70804]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=70804 >
This is a bug report for perl from ti...@timac.local,
generated with the help of perlbug 1.39 running under perl 5.11.2.
-----------------------------------------------------------------
[Please describe your issue here]
Perl 5.8.6:
$ echo 1 > a.pl; perl -MData::Dumper -e 'BEGIN { $^P=0x2 } do "a.pl"; print Dumper(\@{"_<a.pl"})'
$VAR1 = [
undef,
'1
'
];
Perl 5.11.2:
$ echo 1 > a.pl; perl -MData::Dumper -e 'BEGIN { $^P=0x2 } do "a.pl"; print Dumper(\@{"_<a.pl"})'
$VAR1 = [
'1
',
';',
';'
];
The primary problem is that source code line 1 used to be stored at index 1 but
is now stored at index 0. This breaks NYTProf tests and probably affects use of
the perl debugger.
A secondary problem is the extra semicolons that weren't in the original file.
A third problem is lack of tests for this in the test suite ;)
[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
category=core
severity=high
---
Site configuration information for perl 5.11.2:
Configured by timbo at Sat Nov 21 22:55:20 GMT 2009.
Summary of my perl5 (revision 5 version 11 subversion 2) configuration:
Platform:
osname=darwin, osvers=9.8.0, archname=darwin-2level
uname='darwin timac.local 9.8.0 darwin kernel version 9.8.0: wed jul 15 16:55:01 pdt 2009; root:xnu-1228.15.4~1release_i386 i386 '
config_args='-des -Dusedevel -Dprefix=/usr/local/perl5112'
hint=recommended, useposix=true, d_sigaction=define
useithreads=undef, usemultiplicity=undef
useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
use64bitint=undef, use64bitall=undef, uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler:
cc='cc', ccflags ='-fno-common -DPERL_DARWIN -no-cpp-precomp -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -I/opt/local/include',
optimize='-O3',
cppflags='-no-cpp-precomp -fno-common -DPERL_DARWIN -no-cpp-precomp -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -I/opt/local/include'
ccversion='', gccversion='4.0.1 (Apple Inc. build 5465)', gccosandvers=''
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
alignbytes=8, prototype=define
Linker and Libraries:
ld='env MACOSX_DEPLOYMENT_TARGET=10.3 cc', ldflags =' -fstack-protector -L/usr/local/lib -L/opt/local/lib'
libpth=/usr/local/lib /opt/local/lib /usr/lib
libs=-lgdbm -ldbm -ldl -lm -lutil -lc
perllibs=-ldl -lm -lutil -lc
libc=/usr/lib/libc.dylib, 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/usr/local/lib -L/opt/local/lib -fstack-protector'
Locally applied patches:
---
@INC for perl 5.11.2:
/usr/local/perl5112/lib/site_perl/5.11.2/darwin-2level
/usr/local/perl5112/lib/site_perl/5.11.2
/usr/local/perl5112/lib/5.11.2/darwin-2level
/usr/local/perl5112/lib/5.11.2
.
---
Environment for perl 5.11.2:
HOME=/Users/timbo
LANG=en_IE.UTF-8
LANGUAGE (unset)
LC_ALL=en_IE.UTF-8
LD_LIBRARY_PATH (unset)
LOGDIR (unset)
PATH=/usr/local/perl5112/bin:/usr/local/openjdk6-b16-24_apr_2009-r1/bin:/opt/local/lib/postgresql83/bin:/Users/timbo/bin:/usr/local/perl58-i/bin:/usr/local/mysql/bin:/usr/local/bin:/opt/local/bin:/opt/local/sbin:/usr/bin:/bin:/usr/sbin:/sbin:/usr/local/bin:/usr/X11/bin
PERLCRITIC=/Users/timbo/.setdev/perlcriticrc
PERLTIDY=/Users/timbo/.setdev/perltidyrc
PERL_BADLANG (unset)
SHELL=/bin/bash
Zefram
>The primary issue is the off-by-one error in the array indexing.
There's a bit more to it than that. The indexing was off-by-one for
*some* places that process a new line, but correct for others, so the
saved source as a whole was mangled rather than simply offset. Also,
there were some redundant calls to update_debugger_info(), so some lines
got saved twice, in some cases off-by-one for one saving and not for
the other. The saved source is, therefore, hopelessly broken in 5.11.2.
Attached patch fixes the source saving. Includes a new test, which works
through all reachable places that source lines get saved. This should
close RT #70804.
-zefram
Jesse
Thanks, applied.
Tim, How's this do for you?
> diff --git a/MANIFEST b/MANIFEST
> index b857ae1..5830edc 100644
> --- a/MANIFEST
> +++ b/MANIFEST
> @@ -4189,6 +4189,8 @@ t/comp/decl.t See if declarations work
> t/comp/fold.t See if constant folding works
> t/comp/hints.aux Auxillary file for %^H test
> t/comp/hints.t See if %^H works
> +t/comp/line_debug_0.aux Auxiliary file for @{"_<$file"} test
> +t/comp/line_debug.t See if @{"_<$file"} works
> t/comp/multiline.t See if multiline strings work
> t/comp/opsubs.t See if q() etc. are not parsed as functions
> t/comp/our.t Tests for our declaration
> diff --git a/t/comp/line_debug.t b/t/comp/line_debug.t
> new file mode 100644
> index 0000000..175c71a
> --- /dev/null
> +++ b/t/comp/line_debug.t
> @@ -0,0 +1,31 @@
> +#!./perl
> +
> +chdir 't' if -d 't';
> +
> +sub ok {
> + my($test,$ok) = @_;
> + print "not " unless $ok;
> + print "ok $test\n";
> +}
> +
> +# The auxiliary file contains a bunch of code that systematically exercises
> +# every place that can call lex_next_chunk() (except for the one that's not
> +# used by the main Perl parser).
> +open AUX, "<", "comp/line_debug_0.aux" or die $!;
> +my @lines = <AUX>;
> +close AUX;
> +my $nlines = @lines;
> +
> +print "1..", 2+$nlines, "\n";
> +
> +$^P = 0x2;
> +do "comp/line_debug_0.aux";
> +
> +ok 1, scalar(@{"_<comp/line_debug_0.aux"}) == 1+$nlines;
> +ok 2, !defined(${"_<comp/line_debug_0.aux"}[0]);
> +
> +for(1..$nlines) {
> + ok 2+$_, ${"_<comp/line_debug_0.aux"}[$_] eq $lines[$_-1];
> +}
> +
> +1;
> diff --git a/t/comp/line_debug_0.aux b/t/comp/line_debug_0.aux
> new file mode 100644
> index 0000000..2d31d74
> --- /dev/null
> +++ b/t/comp/line_debug_0.aux
> @@ -0,0 +1,20 @@
> +$z = 'line one';
> +$z
> + =
> + 'multiline statement';
> +$z = 'line five';
> +$z = '
> + multiline
> + string
> +';
> +$z = 'line ten';
> +$z = <<EOS;
> + multiline
> + heredoc
> +EOS
> +$z = 'line fifteen';
> +format Z =
> + @<<<< multiline format
> + $z
> +.
> +$z = 'line twenty';
> diff --git a/toke.c b/toke.c
> index a4e9471..226caac 100644
> --- a/toke.c
> +++ b/toke.c
> @@ -1197,6 +1197,7 @@ Perl_lex_next_chunk(pTHX_ U32 flags)
> STRLEN old_bufend_pos, new_bufend_pos;
> STRLEN bufptr_pos, oldbufptr_pos, oldoldbufptr_pos;
> STRLEN linestart_pos, last_uni_pos, last_lop_pos;
> + bool got_some_for_debugger = 0;
> bool got_some;
> if (flags & ~(LEX_KEEP_PREVIOUS|LEX_FAKE_EOF))
> Perl_croak(aTHX_ "Lexing code internal error (%s)", "lex_next_chunk");
> @@ -1231,6 +1232,7 @@ Perl_lex_next_chunk(pTHX_ U32 flags)
> got_some = 0;
> } else if (filter_gets(linestr, old_bufend_pos)) {
> got_some = 1;
> + got_some_for_debugger = 1;
> } else {
> if (!SvPOK(linestr)) /* can get undefined by filter_gets */
> sv_setpvs(linestr, "");
> @@ -1270,7 +1272,7 @@ Perl_lex_next_chunk(pTHX_ U32 flags)
> PL_parser->last_uni = buf + last_uni_pos;
> if (PL_parser->last_lop)
> PL_parser->last_lop = buf + last_lop_pos;
> - if (got_some && (PERLDB_LINE || PERLDB_SAVESRC) &&
> + if (got_some_for_debugger && (PERLDB_LINE || PERLDB_SAVESRC) &&
> PL_curstash != PL_debstash) {
> /* debugger active and we're not compiling the debugger code,
> * so store the line into the debugger's array of lines
> @@ -4324,10 +4326,13 @@ Perl_yylex(pTHX)
> fake_eof = LEX_FAKE_EOF;
> }
> PL_bufptr = PL_bufend;
> + CopLINE_inc(PL_curcop);
> if (!lex_next_chunk(fake_eof)) {
> + CopLINE_dec(PL_curcop);
> s = PL_bufptr;
> TOKEN(';'); /* not infinite loop because rsfp is NULL now */
> }
> + CopLINE_dec(PL_curcop);
> #ifdef PERL_MAD
> if (!PL_rsfp)
> PL_realtokenstart = -1;
> @@ -4363,8 +4368,6 @@ Perl_yylex(pTHX)
> incline(s);
> } while (PL_doextract);
> PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = s;
> - if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash)
> - update_debugger_info(PL_linestr, NULL, 0);
> PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
> PL_last_lop = PL_last_uni = NULL;
> if (CopLINE(PL_curcop) == 1) {
> @@ -12018,10 +12021,12 @@ S_scan_heredoc(pTHX_ register char *s)
> }
> #endif
> PL_bufptr = s;
> + CopLINE_inc(PL_curcop);
> if (!outer || !lex_next_chunk(0)) {
> CopLINE_set(PL_curcop, (line_t)PL_multi_start);
> missingterm(PL_tokenbuf);
> }
> + CopLINE_dec(PL_curcop);
> s = PL_bufptr;
> #ifdef PERL_MAD
> stuffstart = s - SvPVX(PL_linestr);
> @@ -12044,8 +12049,6 @@ S_scan_heredoc(pTHX_ register char *s)
> else if (PL_bufend - PL_linestart == 1 && PL_bufend[-1] == '\r')
> PL_bufend[-1] = '\n';
> #endif
> - if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash)
> - update_debugger_info(PL_linestr, NULL, 0);
> if (*s == term && memEQ(s,PL_tokenbuf,len)) {
> STRLEN off = PL_bufend - 1 - SvPVX_const(PL_linestr);
> *(SvPVX(PL_linestr) + off ) = ' ';
--
Tim Bunce
Tim.