In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/ecb73272e6394b45dd79d2330a67e279ab136980?hp=eb883b9286505f2ba163b6a72b9978e9a3645b4d>
- Log ----------------------------------------------------------------- commit ecb73272e6394b45dd79d2330a67e279ab136980 Author: Father Chrysostomos <[email protected]> Date: Wed Jun 15 21:52:57 2011 -0700 perldelta for breakpoints by file name M pod/perldelta.pod commit 076b743fc5f369c78306040642d57f05f84f6dba Author: Shlomi Fish <[email protected]> Date: Wed Jun 15 21:46:16 2011 -0700 Break upon <filename>:<line> M MANIFEST M lib/perl5db.pl M lib/perl5db.t A lib/perl5db/t/MyModule.pm A lib/perl5db/t/filename-line-breakpoint M pod/perldebug.pod commit 2211a10b908f0f844bed2deea3745c72b54d2f2f Author: Shlomi Fish <[email protected]> Date: Wed Jun 15 21:38:06 2011 -0700 Tests for #92906: perl -d has non-functional b command In bleadperl (NOT perl-5.12.3) perl -d's "b" command does not appear to do anything as verified on my x86-64 Mandriva Linux Cooker machine. This patch adds a regression test to test for it. See: http://www.nntp.perl.org/group/perl.perl5.porters/2011/06/msg173568.html M MANIFEST M lib/perl5db.t A lib/perl5db/t/breakpoint-bug commit f34d15629da26eee6e2b4b28c96865dc4921c52b Author: Father Chrysostomos <[email protected]> Date: Wed Jun 15 21:35:56 2011 -0700 [perl #92906] perl -d has non-functional b command This fixes a regression introduced after 5.14.0. Commit 6f83ef0e5a4 got dbfile and dbline magic mixed up and ended up apply set-magic to the hash (dbfile), not to the element (dbline). The result was that debugger breakpoints simply did not work at all. M mg_raw.h M regen/mg_vtable.pl ----------------------------------------------------------------------- Summary of changes: MANIFEST | 3 ++ lib/perl5db.pl | 27 +++++++++++++-- lib/perl5db.t | 58 +++++++++++++++++++++++++++++++- lib/perl5db/t/MyModule.pm | 15 ++++++++ lib/perl5db/t/breakpoint-bug | 8 ++++ lib/perl5db/t/filename-line-breakpoint | 14 ++++++++ mg_raw.h | 4 +- pod/perldebug.pod | 12 ++++++ pod/perldelta.pod | 6 +++ regen/mg_vtable.pl | 5 ++- 10 files changed, 144 insertions(+), 8 deletions(-) create mode 100644 lib/perl5db/t/MyModule.pm create mode 100644 lib/perl5db/t/breakpoint-bug create mode 100644 lib/perl5db/t/filename-line-breakpoint diff --git a/MANIFEST b/MANIFEST index 772e403..33d9bbf 100644 --- a/MANIFEST +++ b/MANIFEST @@ -3940,8 +3940,11 @@ lib/overload.pm Module for overloading perl operators lib/overload.t See if operator overloading works lib/perl5db.pl Perl debugging routines lib/perl5db.t Tests for the Perl debugger +lib/perl5db/t/breakpoint-bug Test script used by perl5db.t lib/perl5db/t/eval-line-bug Tests for the Perl debugger +lib/perl5db/t/filename-line-breakpoint Tests for the Perl debugger lib/perl5db/t/lvalue-bug Tests for the Perl debugger +lib/perl5db/t/MyModule.pm Tests for the Perl debugger lib/perl5db/t/proxy-constants Tests for the Perl debugger lib/perl5db/t/rt-61222 Tests for the Perl debugger lib/perl5db/t/rt-66110 Tests for the Perl debugger diff --git a/lib/perl5db.pl b/lib/perl5db.pl index fcc111e..89118f6 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -4077,7 +4077,7 @@ sub cmd_b { my $dbline = shift; # Make . the current line number if it's there.. - $line =~ s/^\./$dbline/; + $line =~ s/^\.\b/$dbline/; # No line number, no condition. Simple break on current line. if ( $line =~ /^\s*$/ ) { @@ -4115,7 +4115,15 @@ sub cmd_b { # Save the break type for this sub. $postponed{$subname} = $break ? "break +0 if $cond" : "compile"; } ## end elsif ($line =~ ... - + # b <filename>:<line> [<condition>] + elsif ($line =~ /\A(\S+[^:]):(\d+)\s*(.*)/ms) { + my ($filename, $line_num, $cond) = ($1, $2, $3); + cmd_b_filename_line( + $filename, + $line_num, + (length($cond) ? $cond : '1'), + ); + } # b <sub name> [<condition>] elsif ( $line =~ /^([':A-Za-z_][':\w]*(?:\[.*\])?)\s*(.*)/ ) { @@ -4409,6 +4417,20 @@ sub cmd_b_line { }; } ## end sub cmd_b_line +=head3 cmd_b_filename_line(line, [condition]) (command) + +Wrapper for C<break_on_filename_line>. Prints the failure message if it +doesn't work. + +=cut + +sub cmd_b_filename_line { + eval { break_on_filename_line(@_); 1 } or do { + local $\ = ''; + print $OUT $@ and return; + }; +} + =head3 break_on_filename_line(file, line, [condition]) (API) Switches to the file specified and then calls C<break_on_line> to set @@ -9266,7 +9288,6 @@ sub cmd_pre580_b { my $cond = length $2 ? $2 : '1'; &cmd_b_sub( $subname, $cond ); } - # b <line> [<condition>]. elsif ( $cmd =~ /^(\d*)\s*(.*)/ ) { my $i = $1 || $dbline; diff --git a/lib/perl5db.t b/lib/perl5db.t index 4419136..2cc1ead 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -27,7 +27,7 @@ my $dev_tty = '/dev/tty'; } } -plan(9); +plan(11); sub rc { open RC, ">", ".perldb" or die $!; @@ -159,6 +159,36 @@ SKIP: { is($output, "", "proxy constant subroutines"); } +# Testing that we can set a line in the middle of the file. +{ + rc(<<'EOF'); +&parse_options("NonStop=0 TTY=db.out LineInfo=db.out"); + +sub afterinit { + push (@DB::typeahead, + 'b ../lib/perl5db/t/MyModule.pm:12', + 'c', + q/do { use IO::Handle; STDOUT->autoflush(1); print "Var=$var\n"; }/, + 'c', + 'q', + ); + +} +EOF + + my $output = runperl(switches => [ '-d', '-I', '../lib/perl5db/t', ], stderr => 1, progfile => '../lib/perl5db/t/filename-line-breakpoint'); + + like($output, qr/ + ^Var=Bar$ + .* + ^In\ MyModule\.$ + .* + ^In\ Main\ File\.$ + .* + /msx, + "Can set breakpoint in a line in the middle of the file."); +} + # [perl #66110] Call a subroutine inside a regex { @@ -177,6 +207,32 @@ SKIP: { is($output, '[$^X][done]', "taint"); } +# Testing that we can set a breakpoint +{ + rc(<<'EOF'); +&parse_options("NonStop=0 TTY=db.out LineInfo=db.out"); + +sub afterinit { + push (@DB::typeahead, + 'b 6', + 'c', + q/do { use IO::Handle; STDOUT->autoflush(1); print "X={$x}\n"; }/, + 'c', + 'q', + ); + +} +EOF + + my $output = runperl(switches => [ '-d', ], stderr => 1, progfile => '../lib/perl5db/t/breakpoint-bug'); + + like($output, qr/ + X=\{Two\} + /msx, + "Can set breakpoint in a line."); +} + + # clean up. diff --git a/lib/perl5db/t/MyModule.pm b/lib/perl5db/t/MyModule.pm new file mode 100644 index 0000000..6a72fac --- /dev/null +++ b/lib/perl5db/t/MyModule.pm @@ -0,0 +1,15 @@ +package MyModule; + +use strict; +use warnings; + +use vars qw($var); + +$var = "Bar"; + +sub function +{ + print "In MyModule.\n"; +} + +1; diff --git a/lib/perl5db/t/breakpoint-bug b/lib/perl5db/t/breakpoint-bug new file mode 100644 index 0000000..5ac9874 --- /dev/null +++ b/lib/perl5db/t/breakpoint-bug @@ -0,0 +1,8 @@ +#!/usr/bin/perl +my $x = "One"; + +$x = "Two"; + +my $y = "Lambda"; + +$x = "Four"; diff --git a/lib/perl5db/t/filename-line-breakpoint b/lib/perl5db/t/filename-line-breakpoint new file mode 100644 index 0000000..8331175 --- /dev/null +++ b/lib/perl5db/t/filename-line-breakpoint @@ -0,0 +1,14 @@ +#!/perl + +use strict; +use warnings; + +use MyModule; + +my $x = "Foo"; + +MyModule::function(); + +print "In Main File.\n"; + +1; diff --git a/mg_raw.h b/mg_raw.h index d733260..e698dcd 100644 --- a/mg_raw.h +++ b/mg_raw.h @@ -50,9 +50,9 @@ "/* isaelem 'i' @ISA array element */" }, { 'k', "want_vtbl_nkeys | PERL_MAGIC_VALUE_MAGIC", "/* nkeys 'k' scalar(keys()) lvalue */" }, - { 'L', "want_vtbl_dbline", + { 'L', "magic_vtable_max", "/* dbfile 'L' Debugger %_<filename */" }, - { 'l', "magic_vtable_max", + { 'l', "want_vtbl_dbline", "/* dbline 'l' Debugger %_<filename element */" }, { 'o', "want_vtbl_collxfrm | PERL_MAGIC_VALUE_MAGIC", "/* collxfrm 'o' Locale transformation */" }, diff --git a/pod/perldebug.pod b/pod/perldebug.pod index 59b0ab7..d44ca14 100644 --- a/pod/perldebug.pod +++ b/pod/perldebug.pod @@ -301,6 +301,18 @@ don't use C<if>: b 237 ++$count237 < 11 b 33 /pattern/i +=item b [file]:[line] [condition] +X<breakpoint> +X<debugger command, b> + +Set a breakpoint before the given line in a (possibly different) file. If a +condition is specified, it's evaluated each time the statement is reached: a +breakpoint is taken only if the condition is true. Breakpoints may only be set +on lines that begin an executable statement. Conditions don't use C<if>: + + b lib/MyModule.pm:237 $x > 30 + b /usr/lib/perl5/site_perl/CGI.pm:100 ++$count100 < 11 + =item b subname [condition] X<breakpoint> X<debugger command, b> diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 1790da6..8133f35 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -68,6 +68,12 @@ the interactive debugger. This is described in the C<charnames> item in L</Updated Modules and Pragmata> below. +=head2 Breakpoints with file names + +The debugger's "b" command for setting breakpoints now allows a line number +to be prefixed with a file name. See +L<perldebug/"b [file]:[line] [condition]">. + =head1 Security XXX Any security-related notices go here. In particular, any security diff --git a/regen/mg_vtable.pl b/regen/mg_vtable.pl index 65412dc..af0041d 100644 --- a/regen/mg_vtable.pl +++ b/regen/mg_vtable.pl @@ -53,9 +53,10 @@ my %mg = desc => '@ISA array element' }, nkeys => { char => 'k', vtable => 'nkeys', value_magic => 1, desc => 'scalar(keys()) lvalue' }, - dbfile => { char => 'L', vtable => 'dbline', + dbfile => { char => 'L', desc => 'Debugger %_<filename' }, - dbline => { char => 'l', desc => 'Debugger %_<filename element' }, + dbline => { char => 'l', vtable => 'dbline', + desc => 'Debugger %_<filename element' }, shared => { char => 'N', desc => 'Shared between threads', unknown_to_sv_magic => 1 }, shared_scalar => { char => 'n', desc => 'Shared between threads', -- Perl5 Master Repository
