Front page | perl.perl5.porters |
Postings from November 2009
Re: perl-5.11.2 breaks NYTProf savesrc option (Lexer API suspected) [perl #70804]
Thread Previous
|
Thread Next
From:
jesse
Date:
November 25, 2009 15:04
Subject:
Re: perl-5.11.2 breaks NYTProf savesrc option (Lexer API suspected) [perl #70804]
Message ID:
20091125230439.GY21237@bestpractical.com
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 ) = ' ';
--
Thread Previous
|
Thread Next