Tim.Bunce at pobox
Nov 27, 2009, 3:24 AM
Post #12 of 12
(457 views)
Permalink
|
|
Re: perl-5.11.2 breaks NYTProf savesrc option (Lexer API suspected) [perl #70804]
[In reply to]
|
|
Works fine. Thanks!
Tim.
On Wed, Nov 25, 2009 at 03:05:02PM -0800, Jesse via RT wrote:
>
> Thanks, applied.
>
> Tim, How's this do for you?
>
> On Wed, Nov 25, 2009 at 10:17:52PM +0000, Zefram wrote:
> > Tim Bunce wrote:
> > >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
>
> > 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 ) = ' ';
>
>
> --
>
>
|
d0
