In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/f0feb466830b0a22719e82175d819093f785b375?hp=ffdb8b167ec4e9c0f37371dfd7b0abb01e413f90>
- Log ----------------------------------------------------------------- commit f0feb466830b0a22719e82175d819093f785b375 Author: Father Chrysostomos <[email protected]> Date: Sun Sep 1 14:51:29 2013 -0700 toke.c:scan_const: Donât use PL_bufptr PL_bufptr is passed in as an argument, yet scan_const was some- times looking at its argument (start) and sometimes using PL_bufptr directly. This is just confusing. M toke.c commit 3df5c4b513c5e5c2f25d831f556f2a1c5693ce98 Author: Father Chrysostomos <[email protected]> Date: Sun Sep 1 14:47:38 2013 -0700 Teach mro code about null array elements This is part of ticket #119433. Commit ce0d49f changed AVs to use NULL for nonexistent elements. The mro lookup code was not accounting for that, causing Class::Contractâs tests to crash (and perhaps other modules, too). M ext/mro/mro.xs M mro.c M t/mro/basic.t M t/mro/isa_c3.t commit cbf45e8454c586302a9f324433b3155521872636 Author: Father Chrysostomos <[email protected]> Date: Sun Sep 1 14:26:29 2013 -0700 Refactor some parser.t line number tests The check() function is designed to check the file set by #line, but the last half dozen tests have no need to test for that. (I know because I wrote them.) So make a new check_line function that just checks the line number, and have them use that. M t/comp/parser.t commit 65c68e17188d09c96250348d769c0c309500d5b9 Author: Father Chrysostomos <[email protected]> Date: Sun Sep 1 13:49:33 2013 -0700 Fix debugger lines with keyword <newline> => Commit 2179133 (in 5.19.2) modified the parser to look past newlines when searching for => after a keyword. In doing so, it stopped the parser from saving lines correctly for the debugger: $ PERL5DB='sub DB::DB{}' perl5.18.1 -detime -e'=>;' -e 'print @{"_<-e"}' sub DB::DB{}; time =>; print @{"_<-e"} $ PERL5DB='sub DB::DB{}' perl5.19.3 -detime -e'=>;' -e 'print @{"_<-e"}' sub DB::DB{}; =>; print @{"_<-e"} Notice how line 1 is missing in 5.19.3. When peeking ahead past the end of the line, lex_read_space does need to avoid incrementing the line number from the callerâs (yylexâs) per- spective, but it still needs to increment it for lex_next_chunk to put the lines for the debugger in the right slot. So this commit changes lex_read_space to increment the line number but set it back again after calling lex_next_chunk. Another problem was that the buffer pointer was being restored for a keyword followed by a line break, but only if there was *no* fat arrow on the following line. M t/comp/line_debug_0.aux M toke.c commit 5239c153d07c7f3ed720062743a8b89ae671a95f Author: Father Chrysostomos <[email protected]> Date: Sun Sep 1 13:33:49 2013 -0700 line_debug.t: Add diagnostics M t/comp/line_debug.t ----------------------------------------------------------------------- Summary of changes: ext/mro/mro.xs | 3 ++- mro.c | 3 ++- t/comp/line_debug.t | 6 +++++- t/comp/line_debug_0.aux | 3 +++ t/comp/parser.t | 22 ++++++++++++++-------- t/mro/basic.t | 8 +++++++- t/mro/isa_c3.t | 7 +++++++ toke.c | 15 ++++++++++----- 8 files changed, 50 insertions(+), 17 deletions(-) diff --git a/ext/mro/mro.xs b/ext/mro/mro.xs index 78fa8df..81539b0 100644 --- a/ext/mro/mro.xs +++ b/ext/mro/mro.xs @@ -80,8 +80,9 @@ S_mro_get_linear_isa_c3(pTHX_ HV* stash, U32 level) SSize_t items = AvFILLp(isa) + 1; SV** isa_ptr = AvARRAY(isa); while(items--) { - SV* const isa_item = *isa_ptr++; + SV* const isa_item = *isa_ptr ? *isa_ptr : &PL_sv_undef; HV* const isa_item_stash = gv_stashsv(isa_item, 0); + isa_ptr++; if(!isa_item_stash) { /* if no stash, make a temporary fake MRO containing just itself */ diff --git a/mro.c b/mro.c index 2ce9fa2..18dfa8c 100644 --- a/mro.c +++ b/mro.c @@ -269,10 +269,11 @@ S_mro_get_linear_isa_dfs(pTHX_ HV *stash, U32 level) /* foreach(@ISA) */ while (items--) { - SV* const sv = *svp++; + SV* const sv = *svp ? *svp : &PL_sv_undef; HV* const basestash = gv_stashsv(sv, 0); SV *const *subrv_p; I32 subrv_items; + svp++; if (!basestash) { /* if no stash exists for this @ISA member, diff --git a/t/comp/line_debug.t b/t/comp/line_debug.t index 175c71a..8361194 100644 --- a/t/comp/line_debug.t +++ b/t/comp/line_debug.t @@ -6,6 +6,7 @@ sub ok { my($test,$ok) = @_; print "not " unless $ok; print "ok $test\n"; + $ok; } # The auxiliary file contains a bunch of code that systematically exercises @@ -25,7 +26,10 @@ 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]; + if (!ok 2+$_, ${"_<comp/line_debug_0.aux"}[$_] eq $lines[$_-1]) { + print "# Got: ", ${"_<comp/line_debug_0.aux"}[$_]//"undef\n"; + print "# Expected: $lines[$_-1]"; + } } 1; diff --git a/t/comp/line_debug_0.aux b/t/comp/line_debug_0.aux index 2d31d74..c4193e2 100644 --- a/t/comp/line_debug_0.aux +++ b/t/comp/line_debug_0.aux @@ -18,3 +18,6 @@ format Z = $z . $z = 'line twenty'; +$z = time +=>; +$z++; diff --git a/t/comp/parser.t b/t/comp/parser.t index 44106cb..cca4966 100644 --- a/t/comp/parser.t +++ b/t/comp/parser.t @@ -8,7 +8,7 @@ BEGIN { chdir 't'; } -print "1..166\n"; +print "1..159\n"; sub failed { my ($got, $expected, $name) = @_; @@ -576,29 +576,35 @@ eval <<'EOSTANZA'; die $@ if $@; check(qr/^Great hail!.*no more\.$/, 61, "Overflow both small buffer checks"); EOSTANZA +sub check_line ($$) { + my ($line, $name) = @_; + my (undef, undef, $got_line) = caller; + is ($got_line, $line, $name); +} + #line 531 parser.t -<<EOU; check('parser\.t', 531, 'on same line as heredoc'); +<<EOU; check_line(531, 'on same line as heredoc'); EOU s//<<EOV/e if 0; EOV -check('parser\.t', 535, 'after here-doc in quotes'); +check_line(535, 'after here-doc in quotes'); <<EOW; -${check('parser\.t', 537, 'first line of interp in here-doc');; - check('parser\.t', 538, 'second line of interp in here-doc');} +${check_line(537, 'first line of interp in here-doc');; + check_line(538, 'second line of interp in here-doc');} EOW time #line 42 -;check('parser\.t', 42, 'line number after "nullary\n#line"'); +;check_line(42, 'line number after "nullary\n#line"'); "${ #line 53 _}"; -check('parser\.t', 54, 'line number after qq"${#line}"'); +check_line(54, 'line number after qq"${#line}"'); #line 24 " -${check('parser\.t', 25, 'line number inside qq/<newline>${...}/')}"; +${check_line(25, 'line number inside qq/<newline>${...}/')}"; __END__ # Don't add new tests HERE. See note above diff --git a/t/mro/basic.t b/t/mro/basic.t index 6509073..5625b51 100644 --- a/t/mro/basic.t +++ b/t/mro/basic.t @@ -8,7 +8,7 @@ BEGIN { @INC = '../lib'; require q(./test.pl); } -plan(tests => 60); +plan(tests => 61); require mro; @@ -389,3 +389,9 @@ undef $x; # should use the new DESTROY is $destroy_output, "new", 'Changes to UNIVERSAL::DESTROY invalidate DESTROY caches'; undef *UNIVERSAL::DESTROY; + +{ + no warnings 'uninitialized'; + $#_119433::ISA++; + pass "no crash when ISA contains nonexistent elements"; +} diff --git a/t/mro/isa_c3.t b/t/mro/isa_c3.t index dd129cf..20ae5f0 100644 --- a/t/mro/isa_c3.t +++ b/t/mro/isa_c3.t @@ -67,3 +67,10 @@ foreach my $package (qw(klonk urkkk kapow kayo thwacke zzzzzwap whamm)) { object_ok($ref, $class, $package); } } + +package _119433 { + use mro 'c3'; + no warnings 'uninitialized'; + $#_119433::ISA++; + ::pass "no crash when ISA contains nonexistent elements"; +} diff --git a/toke.c b/toke.c index 556f0e7..d6df9ed 100644 --- a/toke.c +++ b/toke.c @@ -1560,6 +1560,7 @@ Perl_lex_read_space(pTHX_ U32 flags) s++; } else if (c == 0 && s == bufend) { bool got_more; + line_t l; #ifdef PERL_MAD if (PL_madskills) sv_catpvn(PL_skipwhite, PL_parser->bufptr, s-PL_parser->bufptr); @@ -1567,9 +1568,10 @@ Perl_lex_read_space(pTHX_ U32 flags) if (flags & LEX_NO_NEXT_CHUNK) break; PL_parser->bufptr = s; - if (can_incline) COPLINE_INC_WITH_HERELINES; + l = CopLINE(PL_curcop); + CopLINE(PL_curcop) += PL_parser->lex_shared->herelines + 1; got_more = lex_next_chunk(flags); - if (can_incline) CopLINE_dec(PL_curcop); + CopLINE_set(PL_curcop, l); s = PL_parser->bufptr; bufend = PL_parser->bufend; if (!got_more) @@ -3853,8 +3855,8 @@ S_scan_const(pTHX_ char *start) } /* return the substring (via pl_yylval) only if we parsed anything */ - if (s > PL_bufptr) { - char *s2 = PL_bufptr; + if (s > start) { + char *s2 = start; for (; s2 < s; s2++) { if (*s2 == '\n') COPLINE_INC_WITH_HERELINES; @@ -7097,12 +7099,15 @@ Perl_yylex(pTHX) && (!anydelim || *s != '#')) { /* no override, and not s### either; skipspace is safe here * check for => on following line */ + bool arrow; STRLEN bufoff = PL_bufptr - SvPVX(PL_linestr); STRLEN soff = s - SvPVX(PL_linestr); s = skipspace_flags(s, LEX_NO_INCLINE); - if (*s == '=' && s[1] == '>') goto fat_arrow; + arrow = *s == '=' && s[1] == '>'; PL_bufptr = SvPVX(PL_linestr) + bufoff; s = SvPVX(PL_linestr) + soff; + if (arrow) + goto fat_arrow; } reserved_word: -- Perl5 Master Repository
