New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
[PATCH] Add more tests to the default perl debugger ("perl -d" , lib/perl5db.pl). #12363
Comments
From @shlomifHi all, I hope that those of you who went to the recent YAPC have enjoyed it. This patch adds more tests for lib/perl5db.pl on lib/perl5db.t. One note is Regards, Shlomi Fish Inline Patchdiff --git a/MANIFEST b/MANIFEST
index 70b52d2..dad5191 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4327,6 +4327,7 @@ lib/perl5db/t/rt-66110 Tests for the Perl debugger
lib/perl5db/t/symbol-table-bug Tests for the Perl debugger
lib/perl5db/t/taint Tests for the Perl debugger
lib/perl5db/t/test-l-statement-1 Tests for the Perl debugger
+lib/perl5db/t/test-l-statement-2 Tests for the Perl debugger
lib/perl5db/t/test-r-statement Tests for the Perl debugger
lib/perl5db/t/uncalled-subroutine Tests for the Perl debugger
lib/perl5db/t/with-subroutine Tests for the Perl debugger
diff --git a/lib/perl5db.t b/lib/perl5db.t
index b6936b2..5128209 100644
--- a/lib/perl5db.t
+++ b/lib/perl5db.t
@@ -28,7 +28,7 @@ BEGIN {
}
}
-plan(34);
+plan(37);
my $rc_filename = '.perldb';
@@ -902,6 +902,125 @@ package main;
);
}
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'l',
+ q/# After l 1/,
+ 'l',
+ q/# After l 2/,
+ '-',
+ q/# After -/,
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-l-statement-1',
+ }
+ );
+
+ my $first_l_out = qr/
+ 1==>\s+\$x\ =\ 1;\n
+ 2:\s+print\ "1\\n";\n
+ 3\s*\n
+ 4:\s+\$x\ =\ 2;\n
+ 5:\s+print\ "2\\n";\n
+ 6\s*\n
+ 7:\s+\$x\ =\ 3;\n
+ 8:\s+print\ "3\\n";\n
+ 9\s*\n
+ 10:\s+\$x\ =\ 4;\n
+ /msx;
+
+ my $second_l_out = qr/
+ 11:\s+print\ "4\\n";\n
+ 12\s*\n
+ 13:\s+\$x\ =\ 5;\n
+ 14:\s+print\ "5\\n";\n
+ 15\s*\n
+ 16:\s+\$x\ =\ 6;\n
+ 17:\s+print\ "6\\n";\n
+ 18\s*\n
+ 19:\s+\$x\ =\ 7;\n
+ 20:\s+print\ "7\\n";\n
+ /msx;
+ $wrapper->contents_like(
+ qr/
+ ^$first_l_out
+ [^\n]*?DB<\d+>\ \#\ After\ l\ 1\n
+ [\ \t]*\n
+ [^\n]*?DB<\d+>\ l\s*\n
+ $second_l_out
+ [^\n]*?DB<\d+>\ \#\ After\ l\ 2\n
+ [\ \t]*\n
+ [^\n]*?DB<\d+>\ -\s*\n
+ $first_l_out
+ [^\n]*?DB<\d+>\ \#\ After\ -\n
+ /msx,
+ 'l followed by l and then followed by -',
+ );
+}
+
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'l fact',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-l-statement-2',
+ }
+ );
+
+ my $first_l_out = qr/
+ 6\s+sub\ fact\ \{\n
+ 7:\s+my\ \$n\ =\ shift;\n
+ 8:\s+if\ \(\$n\ >\ 1\)\ \{\n
+ 9:\s+return\ \$n\ \*\ fact\(\$n\ -\ 1\);
+ /msx;
+
+ $wrapper->contents_like(
+ qr/
+ DB<1>\s+l\ fact\n
+ $first_l_out
+ /msx,
+ 'l subroutine_name',
+ );
+}
+
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'b fact',
+ 'c',
+ # Repeat several times to avoid @typeahead problems.
+ '.',
+ '.',
+ '.',
+ '.',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-l-statement-2',
+ }
+ );
+
+ my $line_out = qr /
+ ^main::fact\([^\n]*?:7\):\n
+ ^7:\s+my\ \$n\ =\ shift;\n
+ /msx;
+
+ $wrapper->contents_like(
+ qr/
+ $line_out
+ $line_out
+ /msx,
+ 'Test the "." command',
+ );
+}
+
END {
1 while unlink ($rc_filename, $out_fn);
}
diff --git a/lib/perl5db/t/test-l-statement-1 b/lib/perl5db/t/test-l-statement-1
index c3cf5b0..990a169 100644
--- a/lib/perl5db/t/test-l-statement-1
+++ b/lib/perl5db/t/test-l-statement-1
@@ -6,3 +6,15 @@ print "2\n";
$x = 3;
print "3\n";
+
+$x = 4;
+print "4\n";
+
+$x = 5;
+print "5\n";
+
+$x = 6;
+print "6\n";
+
+$x = 7;
+print "7\n";
diff --git a/lib/perl5db/t/test-l-statement-2 b/lib/perl5db/t/test-l-statement-2
new file mode 100644
index 0000000..9e6a210
--- /dev/null
+++ b/lib/perl5db/t/test-l-statement-2
@@ -0,0 +1,24 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+sub fact {
+ my $n = shift;
+ if ($n > 1) {
+ return $n * fact($n - 1);
+ } else {
+ return 1;
+ }
+}
+
+sub bar {
+ print "One\n";
+ print "Two\n";
+ print "Three\n";
+
+ return;
+}
+
+fact(5);
+bar(); |
From @shlomifHere is a newer patch from the same branch, this time also fixing bugs This patch also fixes a bug where the /pattern/ command (and possibly The branch with all the commits is: https://github.com/shlomif/perl/tree/shlomif-perl-d-add-tests-take-3 Regards, -- Shlomi Fish |
From @shlomifperl5db-tests-bugs-and-cleanups.patchdiff --git a/MANIFEST b/MANIFEST
index 27f9a99..1890bd7 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4327,6 +4327,7 @@ lib/perl5db/t/rt-66110 Tests for the Perl debugger
lib/perl5db/t/symbol-table-bug Tests for the Perl debugger
lib/perl5db/t/taint Tests for the Perl debugger
lib/perl5db/t/test-l-statement-1 Tests for the Perl debugger
+lib/perl5db/t/test-l-statement-2 Tests for the Perl debugger
lib/perl5db/t/test-r-statement Tests for the Perl debugger
lib/perl5db/t/uncalled-subroutine Tests for the Perl debugger
lib/perl5db/t/with-subroutine Tests for the Perl debugger
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index f07467f..b77a35c 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -1731,6 +1731,7 @@ use vars qw(
$stack_depth
@to_watch
$try
+ $end
);
sub DB {
@@ -1741,7 +1742,6 @@ sub DB {
my $position;
my ($prefix, $after, $infix);
my $pat;
- my $end;
if ($ENV{PERL5DB_THREADED}) {
$tid = eval { "[".threads->tid."]" };
@@ -1755,7 +1755,7 @@ sub DB {
if ($runnonstop) { # Disable until signal
# If there's any call stack in place, turn off single
# stepping into subs throughout the stack.
- for ( my $i = 0 ; $i <= $stack_depth ; ) {
+ for my $i (0 .. $stack_depth) {
$stack[ $i++ ] &= ~1;
}
@@ -1832,7 +1832,7 @@ sub DB {
# If we have any watch expressions ...
if ( $trace & 2 ) {
- for ( my $n = 0 ; $n <= $#to_watch ; $n++ ) {
+ for my $n (0 .. $#to_watch) {
$evalarg = $to_watch[$n];
local $onetimeDump; # Tell DB::eval() to not output results
@@ -1853,7 +1853,7 @@ Watchpoint $n:\t$to_watch[$n] changed:
EOP
$old_watch[$n] = $val;
} ## end if ($val ne $old_watch...
- } ## end for (my $n = 0 ; $n <= ...
+ } ## end for my $n (0 ..
} ## end if ($trace & 2)
=head2 C<watchfunction()>
@@ -2002,7 +2002,9 @@ number information, and print that.
# Scan forward, stopping at either the end or the next
# unbreakable line.
- for ( my $i = $line + 1 ; $i <= $max && $dbline[$i] == 0 ; ++$i )
+ {
+ my $i = $line + 1;
+ while ( $i <= $max && $dbline[$i] == 0 )
{ #{ vi
# Drop out on null statements, block closers, and comments.
@@ -2027,7 +2029,12 @@ number information, and print that.
else {
depth_print_lineinfo($explicit_stop, $incr_pos);
}
- } ## end for ($i = $line + 1 ; $i...
+ }
+ continue
+ {
+ $i++;
+ }## end while ($i = $line + 1 ; $i...
+ }
} ## end else [ if ($slave_editor)
} ## end if ($single || ($trace...
@@ -2688,8 +2695,8 @@ in this and all call levels above this one.
} ## end if ($i)
# Turn off stack tracing from here up.
- for ( $i = 0 ; $i <= $stack_depth ; ) {
- $stack[ $i++ ] &= ~1;
+ for my $i (0 .. $stack_depth) {
+ $stack[ $i ] &= ~1;
}
last CMD;
};
@@ -2757,7 +2764,8 @@ mess us up.
$cmd =~ /^\/(.*)$/ && do {
# The pattern as a string.
- my $inpat = $1;
+ use vars qw($inpat);
+ $inpat = $1;
# Remove the final slash.
$inpat =~ s:([^\\])/$:$1:;
@@ -2957,11 +2965,15 @@ If a command is found, it is placed in C<$cmd> and executed via C<redo>.
pop(@hist) if length($cmd) > 1;
# Look backward through the history.
- for ( $i = $#hist ; $i ; --$i ) {
+ $i = $#hist;
+ while ($i) {
# Stop if we find it.
last if $hist[$i] =~ /$pat/;
}
+ continue {
+ $i--;
+ }
if ( !$i ) {
@@ -3033,12 +3045,16 @@ Prints the contents of C<@hist> (if any).
# Start at the end of the array.
# Stay in while we're still above the ending value.
# Tick back by one each time around the loop.
- for ( $i = $#hist ; $i > $end ; $i-- ) {
+ $i = $#hist;
+ while ( $i > $end ) {
# Print the command unless it has no arguments.
print $OUT "$i: ", $hist[$i], "\n"
unless $hist[$i] =~ /^.?$/;
}
+ continue {
+ $i--;
+ }
next CMD;
};
@@ -4059,7 +4075,7 @@ sub delete_action {
local *dbline = $main::{ '_<' . $file };
$max = $#dbline;
my $was;
- for ( $i = 1 ; $i <= $max ; $i++ ) {
+ for $i (1 .. $max) {
if ( defined $dbline{$i} ) {
$dbline{$i} =~ s/\0[^\0]*//;
delete $dbline{$i} if $dbline{$i} eq '';
@@ -4067,7 +4083,7 @@ sub delete_action {
unless ( $had_breakpoints{$file} &= ~2 ) {
delete $had_breakpoints{$file};
}
- } ## end for ($i = 1 ; $i <= $max...
+ } ## end for ($i = 1 .. $max)
} ## end for my $file (keys %had_breakpoints)
} ## end else [ if (defined($i))
} ## end sub delete_action
@@ -4692,7 +4708,7 @@ sub delete_breakpoint {
my $was;
# For all lines in this file ...
- for ( $i = 1 ; $i <= $max ; $i++ ) {
+ for $i (1 .. $max) {
# If there's a breakpoint or action on this line ...
if ( defined $dbline{$i} ) {
@@ -4706,7 +4722,7 @@ sub delete_breakpoint {
_delete_breakpoint_data_ref($file, $i);
}
} ## end if (defined $dbline{$i...
- } ## end for ($i = 1 ; $i <= $max...
+ } ## end for $i (1 .. $max)
# If, after we turn off the "there were breakpoints in this file"
# bit, the entry in %had_breakpoints for this file is zero,
@@ -5051,7 +5067,7 @@ sub cmd_l {
# - whether a line has a break or not
# - whether a line has an action or not
else {
- for ( ; $i <= $end ; $i++ ) {
+ while ($i <= $end) {
# Check for breakpoints and actions.
my ( $stop, $action );
@@ -5074,7 +5090,10 @@ sub cmd_l {
# Move on to the next line. Drop out on an interrupt.
$i++, last if $signal;
- } ## end for (; $i <= $end ; $i++)
+ }
+ continue {
+ $i++;
+ }## end while (; $i <= $end ; $i++)
# Line the prompt up; print a newline if the last line listed
# didn't have a newline.
@@ -5132,7 +5151,7 @@ sub cmd_L {
# in this file?
# For each line in the file ...
- for ( my $i = 1 ; $i <= $max ; $i++ ) {
+ for my $i (1 .. $max) {
# We've got something on this line.
if ( defined $dbline{$i} ) {
@@ -5159,7 +5178,7 @@ sub cmd_L {
# Quit if the user hit interrupt.
last if $signal;
} ## end if (defined $dbline{$i...
- } ## end for ($i = 1 ; $i <= $max...
+ } ## end for my $i (1 .. $max)
} ## end for my $file (keys %had_breakpoints)
} ## end if ($break_wanted or $action_wanted)
@@ -5727,7 +5746,7 @@ sub print_trace {
# Run through the traceback info, format it, and print it.
my $s;
- for ( my $i = 0 ; $i <= $#sub ; $i++ ) {
+ for my $i (0 .. $#sub) {
# Drop out if the user has lost interest and hit control-C.
last if $signal;
@@ -5767,7 +5786,7 @@ sub print_trace {
. " called from $file"
. " line $sub[$i]{line}\n";
}
- } ## end for ($i = 0 ; $i <= $#sub...
+ } ## end for my $i (0 .. $#sub)
} ## end sub print_trace
=head2 dump_trace(skip[,count])
@@ -5835,12 +5854,12 @@ sub dump_trace {
# number of stack frames, or we run out - caller() returns nothing - we
# quit.
# Up the stack frame index to go back one more level each time.
- for (
- my $i = $skip ;
+ {
+ my $i = $skip;
+ while (
$i < $count
- and ( $p, $file, $line, $sub, $h, $context, $e, $r ) = caller($i) ;
- $i++
- )
+ and ( $p, $file, $line, $sub, $h, $context, $e, $r ) = caller($i)
+ )
{
# Go through the arguments and save them for later.
@@ -5926,7 +5945,11 @@ sub dump_trace {
# Stop processing frames if the user hit control-C.
last if $signal;
- } ## end for ($i = $skip ; $i < ...
+ } ## end while ($i)
+ continue {
+ $i++;
+ }
+ }
# Restore the trace value again.
$trace = $otrace;
@@ -9377,7 +9400,7 @@ sub cmd_pre580_D {
my $was;
# For all lines in this file ...
- for ( my $i = 1 ; $i <= $max ; $i++ ) {
+ for my $i (1 .. $max) {
# If there's a breakpoint or action on this line ...
if ( defined $dbline{$i} ) {
@@ -9390,7 +9413,7 @@ sub cmd_pre580_D {
delete $dbline{$i};
}
} ## end if (defined $dbline{$i...
- } ## end for ($i = 1 ; $i <= $max...
+ } ## end for my $i (1 .. $max)
# If, after we turn off the "there were breakpoints in this file"
# bit, the entry in %had_breakpoints for this file is zero,
diff --git a/lib/perl5db.t b/lib/perl5db.t
index b6936b2..9276fad 100644
--- a/lib/perl5db.t
+++ b/lib/perl5db.t
@@ -28,7 +28,7 @@ BEGIN {
}
}
-plan(34);
+plan(40);
my $rc_filename = '.perldb';
@@ -367,7 +367,7 @@ sub _run {
::runperl(
switches =>
[
- '-d',
+ '-d',
($self->_include_t ? ('-I', '../lib/perl5db/t') : ())
],
stderr => 1,
@@ -689,11 +689,11 @@ package main;
"'" . quotemeta($prog_fn) . "' line %s\\n",
(map { quotemeta($_) } @$_)
)
- }
+ }
(
['.', 'main::baz', 14,],
['.', 'main::bar', 9,],
- ['.', 'main::foo', 6]
+ ['.', 'main::foo', 6],
)
);
$wrapper->contents_like(
@@ -902,6 +902,201 @@ package main;
);
}
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'l',
+ q/# After l 1/,
+ 'l',
+ q/# After l 2/,
+ '-',
+ q/# After -/,
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-l-statement-1',
+ }
+ );
+
+ my $first_l_out = qr/
+ 1==>\s+\$x\ =\ 1;\n
+ 2:\s+print\ "1\\n";\n
+ 3\s*\n
+ 4:\s+\$x\ =\ 2;\n
+ 5:\s+print\ "2\\n";\n
+ 6\s*\n
+ 7:\s+\$x\ =\ 3;\n
+ 8:\s+print\ "3\\n";\n
+ 9\s*\n
+ 10:\s+\$x\ =\ 4;\n
+ /msx;
+
+ my $second_l_out = qr/
+ 11:\s+print\ "4\\n";\n
+ 12\s*\n
+ 13:\s+\$x\ =\ 5;\n
+ 14:\s+print\ "5\\n";\n
+ 15\s*\n
+ 16:\s+\$x\ =\ 6;\n
+ 17:\s+print\ "6\\n";\n
+ 18\s*\n
+ 19:\s+\$x\ =\ 7;\n
+ 20:\s+print\ "7\\n";\n
+ /msx;
+ $wrapper->contents_like(
+ qr/
+ ^$first_l_out
+ [^\n]*?DB<\d+>\ \#\ After\ l\ 1\n
+ [\ \t]*\n
+ [^\n]*?DB<\d+>\ l\s*\n
+ $second_l_out
+ [^\n]*?DB<\d+>\ \#\ After\ l\ 2\n
+ [\ \t]*\n
+ [^\n]*?DB<\d+>\ -\s*\n
+ $first_l_out
+ [^\n]*?DB<\d+>\ \#\ After\ -\n
+ /msx,
+ 'l followed by l and then followed by -',
+ );
+}
+
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'l fact',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-l-statement-2',
+ }
+ );
+
+ my $first_l_out = qr/
+ 6\s+sub\ fact\ \{\n
+ 7:\s+my\ \$n\ =\ shift;\n
+ 8:\s+if\ \(\$n\ >\ 1\)\ \{\n
+ 9:\s+return\ \$n\ \*\ fact\(\$n\ -\ 1\);
+ /msx;
+
+ $wrapper->contents_like(
+ qr/
+ DB<1>\s+l\ fact\n
+ $first_l_out
+ /msx,
+ 'l subroutine_name',
+ );
+}
+
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'b fact',
+ 'c',
+ # Repeat several times to avoid @typeahead problems.
+ '.',
+ '.',
+ '.',
+ '.',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-l-statement-2',
+ }
+ );
+
+ my $line_out = qr /
+ ^main::fact\([^\n]*?:7\):\n
+ ^7:\s+my\ \$n\ =\ shift;\n
+ /msx;
+
+ $wrapper->contents_like(
+ qr/
+ $line_out
+ $line_out
+ /msx,
+ 'Test the "." command',
+ );
+}
+
+# Testing that the f command works.
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'f ../lib/perl5db/t/MyModule.pm',
+ 'b 12',
+ 'c',
+ q/do { use IO::Handle; STDOUT->autoflush(1); print "Var=$var\n"; }/,
+ 'c',
+ 'q',
+ ],
+ include_t => 1,
+ prog => '../lib/perl5db/t/filename-line-breakpoint'
+ }
+ );
+
+ $wrapper->output_like(qr/
+ ^Var=Bar$
+ .*
+ ^In\ MyModule\.$
+ .*
+ ^In\ Main\ File\.$
+ .*
+ /msx,
+ "f command is working.",
+ );
+}
+
+# We broke the /pattern/ command because apparently the CORE::eval-s inside
+# lib/perl5db.pl cannot handle lexical variable properly. So we now fix this
+# bug.
+#
+# TODO :
+#
+# 1. Go over the rest of the "eval"s in lib/perl5db.t and see if they cause
+# problems.
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ '/for/',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/eval-line-bug',
+ }
+ );
+
+ $wrapper->contents_like(
+ qr/12: \s* for\ my\ \$q\ \(1\ \.\.\ 10\)\ \{/msx,
+ "/pat/ command is working and found a match.",
+ );
+}
+
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'b 22',
+ 'c',
+ '?for?',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/eval-line-bug',
+ }
+ );
+
+ $wrapper->contents_like(
+ qr/12: \s* for\ my\ \$q\ \(1\ \.\.\ 10\)\ \{/msx,
+ "?pat? command is working and found a match.",
+ );
+}
+
END {
1 while unlink ($rc_filename, $out_fn);
}
diff --git a/lib/perl5db/t/test-l-statement-1 b/lib/perl5db/t/test-l-statement-1
index c3cf5b0..990a169 100644
--- a/lib/perl5db/t/test-l-statement-1
+++ b/lib/perl5db/t/test-l-statement-1
@@ -6,3 +6,15 @@ print "2\n";
$x = 3;
print "3\n";
+
+$x = 4;
+print "4\n";
+
+$x = 5;
+print "5\n";
+
+$x = 6;
+print "6\n";
+
+$x = 7;
+print "7\n";
diff --git a/lib/perl5db/t/test-l-statement-2 b/lib/perl5db/t/test-l-statement-2
new file mode 100644
index 0000000..9e6a210
--- /dev/null
+++ b/lib/perl5db/t/test-l-statement-2
@@ -0,0 +1,24 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+sub fact {
+ my $n = shift;
+ if ($n > 1) {
+ return $n * fact($n - 1);
+ } else {
+ return 1;
+ }
+}
+
+sub bar {
+ print "One\n";
+ print "Two\n";
+ print "Three\n";
+
+ return;
+}
+
+fact(5);
+bar();
|
The RT System itself - Status changed from 'new' to 'open' |
From @tamiasOn Thu, Aug 30, 2012 at 09:08:21AM -0700, Shlomi Fish via RT wrote:
The $i++ is no longer necessary there. I notice that several places in this patch, you've added enclosing blocks Ronald P.S. Personally, I like C-style for loops. |
From @ikegamiOn Thu, Aug 30, 2012 at 5:58 PM, Ronald J Kimball <rjk@tamias.net> wrote:
Personally, I like processing one very simple expression instead of 3 |
From vadim.konovalov@alcatel-lucent.com
once again these people are breaking the debugger, ok, /me silences..... |
From @tamiasOn Thu, Aug 30, 2012 at 07:08:44PM -0400, Eric Brine wrote:
When you can replace a C-style for loop with a foreach loop, that's fine. Before: for ( my $i = $line + 1 ; $i <= $max && $dbline[$i] == 0 ; ++$i ) After: { That's a lot of effort just to avoid a C-style for loop. Ronald |
From @rjbs* "Konovalov, Vadim (Vadim)** CTR **" <vadim.konovalov@alcatel-lucent.com> [2012-08-31T01:19:15]
You can: a) provide patches to dual-life the debugger so you can stick with the current Please do not: d) complain about people trying to help -- |
From Eirik-Berg.Hanssen@allverden.noOn Fri, Aug 31, 2012 at 3:49 PM, Ronald J Kimball <rjk@tamias.net> wrote:
It is. But isn't the foreach loop an option here? for my $i ($line+1 .. $max) Eirik |
From @shlomifHi all, since parts of the previous change with converting some C-style for(;;) So this is the latest version of the patch, which can be found on this https://github.com/shlomif/perl/tree/shlomif-perl-d-add-tests-take-3 Regards, -- Shlomi Fish |
From @shlomifadd-tests-to-perl5db.patchdiff --git a/MANIFEST b/MANIFEST
index 27f9a99..1890bd7 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4327,6 +4327,7 @@ lib/perl5db/t/rt-66110 Tests for the Perl debugger
lib/perl5db/t/symbol-table-bug Tests for the Perl debugger
lib/perl5db/t/taint Tests for the Perl debugger
lib/perl5db/t/test-l-statement-1 Tests for the Perl debugger
+lib/perl5db/t/test-l-statement-2 Tests for the Perl debugger
lib/perl5db/t/test-r-statement Tests for the Perl debugger
lib/perl5db/t/uncalled-subroutine Tests for the Perl debugger
lib/perl5db/t/with-subroutine Tests for the Perl debugger
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index f07467f..6777a19 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -1731,6 +1731,7 @@ use vars qw(
$stack_depth
@to_watch
$try
+ $end
);
sub DB {
@@ -1741,7 +1742,6 @@ sub DB {
my $position;
my ($prefix, $after, $infix);
my $pat;
- my $end;
if ($ENV{PERL5DB_THREADED}) {
$tid = eval { "[".threads->tid."]" };
@@ -1755,8 +1755,8 @@ sub DB {
if ($runnonstop) { # Disable until signal
# If there's any call stack in place, turn off single
# stepping into subs throughout the stack.
- for ( my $i = 0 ; $i <= $stack_depth ; ) {
- $stack[ $i++ ] &= ~1;
+ for my $i (0 .. $stack_depth) {
+ $stack[ $i ] &= ~1;
}
# And we are now no longer in single-step mode.
@@ -1832,7 +1832,7 @@ sub DB {
# If we have any watch expressions ...
if ( $trace & 2 ) {
- for ( my $n = 0 ; $n <= $#to_watch ; $n++ ) {
+ for my $n (0 .. $#to_watch) {
$evalarg = $to_watch[$n];
local $onetimeDump; # Tell DB::eval() to not output results
@@ -1853,7 +1853,7 @@ Watchpoint $n:\t$to_watch[$n] changed:
EOP
$old_watch[$n] = $val;
} ## end if ($val ne $old_watch...
- } ## end for (my $n = 0 ; $n <= ...
+ } ## end for my $n (0 ..
} ## end if ($trace & 2)
=head2 C<watchfunction()>
@@ -2688,8 +2688,8 @@ in this and all call levels above this one.
} ## end if ($i)
# Turn off stack tracing from here up.
- for ( $i = 0 ; $i <= $stack_depth ; ) {
- $stack[ $i++ ] &= ~1;
+ for my $i (0 .. $stack_depth) {
+ $stack[ $i ] &= ~1;
}
last CMD;
};
@@ -2757,7 +2757,8 @@ mess us up.
$cmd =~ /^\/(.*)$/ && do {
# The pattern as a string.
- my $inpat = $1;
+ use vars qw($inpat);
+ $inpat = $1;
# Remove the final slash.
$inpat =~ s:([^\\])/$:$1:;
@@ -2958,7 +2959,6 @@ If a command is found, it is placed in C<$cmd> and executed via C<redo>.
# Look backward through the history.
for ( $i = $#hist ; $i ; --$i ) {
-
# Stop if we find it.
last if $hist[$i] =~ /$pat/;
}
@@ -4059,7 +4059,7 @@ sub delete_action {
local *dbline = $main::{ '_<' . $file };
$max = $#dbline;
my $was;
- for ( $i = 1 ; $i <= $max ; $i++ ) {
+ for $i (1 .. $max) {
if ( defined $dbline{$i} ) {
$dbline{$i} =~ s/\0[^\0]*//;
delete $dbline{$i} if $dbline{$i} eq '';
@@ -4067,7 +4067,7 @@ sub delete_action {
unless ( $had_breakpoints{$file} &= ~2 ) {
delete $had_breakpoints{$file};
}
- } ## end for ($i = 1 ; $i <= $max...
+ } ## end for ($i = 1 .. $max)
} ## end for my $file (keys %had_breakpoints)
} ## end else [ if (defined($i))
} ## end sub delete_action
@@ -4692,7 +4692,7 @@ sub delete_breakpoint {
my $was;
# For all lines in this file ...
- for ( $i = 1 ; $i <= $max ; $i++ ) {
+ for $i (1 .. $max) {
# If there's a breakpoint or action on this line ...
if ( defined $dbline{$i} ) {
@@ -4706,7 +4706,7 @@ sub delete_breakpoint {
_delete_breakpoint_data_ref($file, $i);
}
} ## end if (defined $dbline{$i...
- } ## end for ($i = 1 ; $i <= $max...
+ } ## end for $i (1 .. $max)
# If, after we turn off the "there were breakpoints in this file"
# bit, the entry in %had_breakpoints for this file is zero,
@@ -5132,7 +5132,7 @@ sub cmd_L {
# in this file?
# For each line in the file ...
- for ( my $i = 1 ; $i <= $max ; $i++ ) {
+ for my $i (1 .. $max) {
# We've got something on this line.
if ( defined $dbline{$i} ) {
@@ -5159,7 +5159,7 @@ sub cmd_L {
# Quit if the user hit interrupt.
last if $signal;
} ## end if (defined $dbline{$i...
- } ## end for ($i = 1 ; $i <= $max...
+ } ## end for my $i (1 .. $max)
} ## end for my $file (keys %had_breakpoints)
} ## end if ($break_wanted or $action_wanted)
@@ -5727,7 +5727,7 @@ sub print_trace {
# Run through the traceback info, format it, and print it.
my $s;
- for ( my $i = 0 ; $i <= $#sub ; $i++ ) {
+ for my $i (0 .. $#sub) {
# Drop out if the user has lost interest and hit control-C.
last if $signal;
@@ -5767,7 +5767,7 @@ sub print_trace {
. " called from $file"
. " line $sub[$i]{line}\n";
}
- } ## end for ($i = 0 ; $i <= $#sub...
+ } ## end for my $i (0 .. $#sub)
} ## end sub print_trace
=head2 dump_trace(skip[,count])
@@ -5840,7 +5840,7 @@ sub dump_trace {
$i < $count
and ( $p, $file, $line, $sub, $h, $context, $e, $r ) = caller($i) ;
$i++
- )
+ )
{
# Go through the arguments and save them for later.
@@ -9377,7 +9377,7 @@ sub cmd_pre580_D {
my $was;
# For all lines in this file ...
- for ( my $i = 1 ; $i <= $max ; $i++ ) {
+ for my $i (1 .. $max) {
# If there's a breakpoint or action on this line ...
if ( defined $dbline{$i} ) {
@@ -9390,7 +9390,7 @@ sub cmd_pre580_D {
delete $dbline{$i};
}
} ## end if (defined $dbline{$i...
- } ## end for ($i = 1 ; $i <= $max...
+ } ## end for my $i (1 .. $max)
# If, after we turn off the "there were breakpoints in this file"
# bit, the entry in %had_breakpoints for this file is zero,
diff --git a/lib/perl5db.t b/lib/perl5db.t
index b6936b2..9276fad 100644
--- a/lib/perl5db.t
+++ b/lib/perl5db.t
@@ -28,7 +28,7 @@ BEGIN {
}
}
-plan(34);
+plan(40);
my $rc_filename = '.perldb';
@@ -367,7 +367,7 @@ sub _run {
::runperl(
switches =>
[
- '-d',
+ '-d',
($self->_include_t ? ('-I', '../lib/perl5db/t') : ())
],
stderr => 1,
@@ -689,11 +689,11 @@ package main;
"'" . quotemeta($prog_fn) . "' line %s\\n",
(map { quotemeta($_) } @$_)
)
- }
+ }
(
['.', 'main::baz', 14,],
['.', 'main::bar', 9,],
- ['.', 'main::foo', 6]
+ ['.', 'main::foo', 6],
)
);
$wrapper->contents_like(
@@ -902,6 +902,201 @@ package main;
);
}
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'l',
+ q/# After l 1/,
+ 'l',
+ q/# After l 2/,
+ '-',
+ q/# After -/,
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-l-statement-1',
+ }
+ );
+
+ my $first_l_out = qr/
+ 1==>\s+\$x\ =\ 1;\n
+ 2:\s+print\ "1\\n";\n
+ 3\s*\n
+ 4:\s+\$x\ =\ 2;\n
+ 5:\s+print\ "2\\n";\n
+ 6\s*\n
+ 7:\s+\$x\ =\ 3;\n
+ 8:\s+print\ "3\\n";\n
+ 9\s*\n
+ 10:\s+\$x\ =\ 4;\n
+ /msx;
+
+ my $second_l_out = qr/
+ 11:\s+print\ "4\\n";\n
+ 12\s*\n
+ 13:\s+\$x\ =\ 5;\n
+ 14:\s+print\ "5\\n";\n
+ 15\s*\n
+ 16:\s+\$x\ =\ 6;\n
+ 17:\s+print\ "6\\n";\n
+ 18\s*\n
+ 19:\s+\$x\ =\ 7;\n
+ 20:\s+print\ "7\\n";\n
+ /msx;
+ $wrapper->contents_like(
+ qr/
+ ^$first_l_out
+ [^\n]*?DB<\d+>\ \#\ After\ l\ 1\n
+ [\ \t]*\n
+ [^\n]*?DB<\d+>\ l\s*\n
+ $second_l_out
+ [^\n]*?DB<\d+>\ \#\ After\ l\ 2\n
+ [\ \t]*\n
+ [^\n]*?DB<\d+>\ -\s*\n
+ $first_l_out
+ [^\n]*?DB<\d+>\ \#\ After\ -\n
+ /msx,
+ 'l followed by l and then followed by -',
+ );
+}
+
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'l fact',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-l-statement-2',
+ }
+ );
+
+ my $first_l_out = qr/
+ 6\s+sub\ fact\ \{\n
+ 7:\s+my\ \$n\ =\ shift;\n
+ 8:\s+if\ \(\$n\ >\ 1\)\ \{\n
+ 9:\s+return\ \$n\ \*\ fact\(\$n\ -\ 1\);
+ /msx;
+
+ $wrapper->contents_like(
+ qr/
+ DB<1>\s+l\ fact\n
+ $first_l_out
+ /msx,
+ 'l subroutine_name',
+ );
+}
+
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'b fact',
+ 'c',
+ # Repeat several times to avoid @typeahead problems.
+ '.',
+ '.',
+ '.',
+ '.',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-l-statement-2',
+ }
+ );
+
+ my $line_out = qr /
+ ^main::fact\([^\n]*?:7\):\n
+ ^7:\s+my\ \$n\ =\ shift;\n
+ /msx;
+
+ $wrapper->contents_like(
+ qr/
+ $line_out
+ $line_out
+ /msx,
+ 'Test the "." command',
+ );
+}
+
+# Testing that the f command works.
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'f ../lib/perl5db/t/MyModule.pm',
+ 'b 12',
+ 'c',
+ q/do { use IO::Handle; STDOUT->autoflush(1); print "Var=$var\n"; }/,
+ 'c',
+ 'q',
+ ],
+ include_t => 1,
+ prog => '../lib/perl5db/t/filename-line-breakpoint'
+ }
+ );
+
+ $wrapper->output_like(qr/
+ ^Var=Bar$
+ .*
+ ^In\ MyModule\.$
+ .*
+ ^In\ Main\ File\.$
+ .*
+ /msx,
+ "f command is working.",
+ );
+}
+
+# We broke the /pattern/ command because apparently the CORE::eval-s inside
+# lib/perl5db.pl cannot handle lexical variable properly. So we now fix this
+# bug.
+#
+# TODO :
+#
+# 1. Go over the rest of the "eval"s in lib/perl5db.t and see if they cause
+# problems.
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ '/for/',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/eval-line-bug',
+ }
+ );
+
+ $wrapper->contents_like(
+ qr/12: \s* for\ my\ \$q\ \(1\ \.\.\ 10\)\ \{/msx,
+ "/pat/ command is working and found a match.",
+ );
+}
+
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'b 22',
+ 'c',
+ '?for?',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/eval-line-bug',
+ }
+ );
+
+ $wrapper->contents_like(
+ qr/12: \s* for\ my\ \$q\ \(1\ \.\.\ 10\)\ \{/msx,
+ "?pat? command is working and found a match.",
+ );
+}
+
END {
1 while unlink ($rc_filename, $out_fn);
}
diff --git a/lib/perl5db/t/test-l-statement-1 b/lib/perl5db/t/test-l-statement-1
index c3cf5b0..990a169 100644
--- a/lib/perl5db/t/test-l-statement-1
+++ b/lib/perl5db/t/test-l-statement-1
@@ -6,3 +6,15 @@ print "2\n";
$x = 3;
print "3\n";
+
+$x = 4;
+print "4\n";
+
+$x = 5;
+print "5\n";
+
+$x = 6;
+print "6\n";
+
+$x = 7;
+print "7\n";
diff --git a/lib/perl5db/t/test-l-statement-2 b/lib/perl5db/t/test-l-statement-2
new file mode 100644
index 0000000..9e6a210
--- /dev/null
+++ b/lib/perl5db/t/test-l-statement-2
@@ -0,0 +1,24 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+sub fact {
+ my $n = shift;
+ if ($n > 1) {
+ return $n * fact($n - 1);
+ } else {
+ return 1;
+ }
+}
+
+sub bar {
+ print "One\n";
+ print "Two\n";
+ print "Three\n";
+
+ return;
+}
+
+fact(5);
+bar();
|
From @nwc10On Fri, Aug 31, 2012 at 10:24:43AM -0400, Ricardo Signes wrote:
It's not going to *grow fat*. It *is* already fat. $ wc lib/perl5db.pl Most of that (I think) is at least 8 years old. At least 25% of it predates Contrast this with the Rakudo debugger that Jonathan has just written, which
This would actually be very interesting. I think it should work, but it $ cat cpan/perlfaq/lib/perlfaq.pm 0; # not is it supposed to be loaded to keep various bits of the build system sweet. Nicholas Clark |
From vadim.konovalov@alcatel-lucent.com
c') stick with another debugger,
yes, I am not complaining. and let me express my sincere gratitudes for your efforts on evolving perl! Regards, |
From @rjbs* Shlomi Fish via RT <perlbug-followup@perl.org> [2012-08-30T12:08:21]
I have applied the attached patch locally and am smoking it.
I really would appreciate it if you could spend a little time getting You should, instead, be rebasing your topic branch onto blead as needed. Then Nonetheless, thank you very much for the work. It has been tentatively applied -- |
From [Unknown Contact. See original ticket]Thanks, applied as 2c247e8. |
@rjbs - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#114644 (status was 'resolved')
Searchable as RT114644$
The text was updated successfully, but these errors were encountered: