In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/bdba49ad065980ae3ab85147a822d5b9098d33ca?hp=db12e2d38b3ae9d4035fb95151828de67a1429c1>
- Log ----------------------------------------------------------------- commit bdba49ad065980ae3ab85147a822d5b9098d33ca Author: Shlomi Fish <[email protected]> Date: Sat Dec 3 06:56:53 2011 -0800 perl -d bugfixes and tests This patch fixes some bugs in "perl -d" (see ticket #104820) and adds some regression tests (for the bugfixes and for better test coverage). M lib/perl5db.pl M lib/perl5db.t commit 58b643af94f2fff7b3765a746a475cb8183ccc4b Author: Peter Martini <[email protected]> Date: Sat Dec 3 07:01:44 2011 -0500 Stop calling sv_usepvn_flags from sv_sethek sv_usepvn_flags assumes that ptr is at the head of a block of memory allocated by malloc. If perl's malloc is in use, the data structures malloc uses and the data allocated for perl are intermixed, and accounting done by malloced_size in sv_usepvn_flags will overwrite valid memory if its called on an address that is not the start of a malloced block. The actual work being accomplished by sv_usepvn_flags, and not undone immediately after by sv_sethek, is limited to 3 calls on the SV. Inlining those calls removes the dependency on malloc. This fixes perl #104034. M sv.c ----------------------------------------------------------------------- Summary of changes: lib/perl5db.pl | 26 ++++++++++++++++-- lib/perl5db.t | 81 +++++++++++++++++++++++++++++++++++++++++++++++++++++++- sv.c | 8 +++++- 3 files changed, 110 insertions(+), 5 deletions(-) diff --git a/lib/perl5db.pl b/lib/perl5db.pl index 06b1153..d8b6894 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -1098,6 +1098,9 @@ $trace = $signal = $single = 0; # Uninitialized warning suppression # value when the 'r' command is used to return from a subroutine. $inhibit_exit = $option{PrintRet} = 1; +# Default to 1 so the prompt will display the first line. +$trace_to_depth = 1; + =head1 OPTION PROCESSING The debugger's options are actually spread out over the debugger itself and @@ -1567,9 +1570,19 @@ if ( exists $ENV{PERLDB_RESTART} ) { # restore breakpoints/actions my @had_breakpoints = get_list("PERLDB_VISITED"); - for ( 0 .. $#had_breakpoints ) { - my %pf = get_list("PERLDB_FILE_$_"); - $postponed_file{ $had_breakpoints[$_] } = \%pf if %pf; + for my $file_idx ( 0 .. $#had_breakpoints ) { + my $filename = $had_breakpoints[$file_idx]; + my %pf = get_list("PERLDB_FILE_$file_idx"); + $postponed_file{ $filename } = \%pf if %pf; + my @lines = sort {$a <=> $b} keys(%pf); + my @enabled_statuses = get_list("PERLDB_FILE_ENABLED_$file_idx"); + for my $line_idx (0 .. $#lines) { + _set_breakpoint_enabled_status( + $filename, + $lines[$line_idx], + ($enabled_statuses[$line_idx] ? 1 : ''), + ); + } } # restore options @@ -9144,6 +9157,13 @@ variable via C<DB::set_list>. # Save the list of all the breakpoints for this file. set_list( "PERLDB_FILE_$_", %dbline, @add ); + + # Serialize the extra data %breakpoints_data hash. + # That's a bug fix. + set_list( "PERLDB_FILE_ENABLED_$_", + map { _is_breakpoint_enabled($file, $_) ? 1 : 0 } + sort { $a <=> $b } keys(%dbline) + ) } ## end for (0 .. $#had_breakpoints) # The breakpoint was inside an eval. This is a little diff --git a/lib/perl5db.t b/lib/perl5db.t index 36dbcb8..0adae25 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -28,7 +28,7 @@ BEGIN { } } -plan(16); +plan(19); my $rc_filename = '.perldb'; @@ -98,6 +98,35 @@ like(_out_contents(), qr/sub factorial/, ); { + my $target = '../lib/perl5db/t/eval-line-bug'; + + rc( + <<"EOF", + &parse_options("NonStop=0 TTY=db.out LineInfo=db.out"); + + sub afterinit { + push(\@DB::typeahead, + 'b 23', + 'c', + '\$new_var = "Foo"', + 'x "new_var = <\$new_var>\\n";', + 'q', + ); + } +EOF + ); + + { + local $ENV{PERLDB_OPTS} = "ReadLine=0"; + runperl(switches => [ '-d' ], progfile => $target); + } +} + +like(_out_contents(), qr/new_var = <Foo>/, + "no strict 'vars' in evaluated lines.", +); + +{ local $ENV{PERLDB_OPTS} = "ReadLine=0"; my $output = runperl(switches => [ '-d' ], progfile => '../lib/perl5db/t/lvalue-bug'); like($output, qr/foo is defined/, 'lvalue subs work in the debugger'); @@ -355,6 +384,56 @@ EOF /msx, "Can set breakpoint in a line."); } + +# Testing that the prompt with the information appears. +{ + rc(<<'EOF'); +&parse_options("NonStop=0 TTY=db.out LineInfo=db.out"); + +sub afterinit { + push (@DB::typeahead, + 'q', + ); + +} +EOF + + my $output = runperl(switches => [ '-d', ], stderr => 1, progfile => '../lib/perl5db/t/disable-breakpoints-1'); + + like(_out_contents(), qr/ + ^main::\([^\)]*\bdisable-breakpoints-1:2\):\n + 2:\s+my\ \$x\ =\ "One";\n + /msx, + "Prompt should display the first line of code."); +} + +# Testing that R (restart) and "B *" work. +{ + rc(<<'EOF'); +&parse_options("NonStop=0 TTY=db.out LineInfo=db.out"); + +sub afterinit { + push (@DB::typeahead, + 'b 13', + 'c', + 'B *', + 'b 9', + 'R', + 'c', + q/print "X={$x};dummy={$dummy}\n";/, + 'q', + ); + +} +EOF + + my $output = runperl(switches => [ '-d', ], stderr => 1, progfile => '../lib/perl5db/t/disable-breakpoints-1'); + like($output, qr/ + X=\{FirstVal\};dummy=\{1\} + /msx, + "Restart and delete all breakpoints work properly."); +} + END { 1 while unlink ($rc_filename, $out_fn); } diff --git a/sv.c b/sv.c index ee64e1f..a2df6f5 100644 --- a/sv.c +++ b/sv.c @@ -4583,8 +4583,14 @@ Perl_sv_sethek(pTHX_ register SV *const sv, const HEK *const hek) return; } { + /* Emulate what sv_usepvn_flags does; it can't be called + directly, because it assumes that the data for the PV is at the + start of a malloced block */ + SV_CHECK_THINKFIRST_COW_DROP(sv); SvUPGRADE(sv, SVt_PV); - sv_usepvn_flags(sv, (char *)HEK_KEY(share_hek_hek(hek)), HEK_LEN(hek), SV_HAS_TRAILING_NUL); + SvPV_set(sv,(char *)HEK_KEY(share_hek_hek(hek))); + SvTAINT(sv); + SvCUR_set(sv, HEK_LEN(hek)); SvLEN_set(sv, 0); SvREADONLY_on(sv); SvFAKE_on(sv); -- Perl5 Master Repository
