Join GitHub today
GitHub is home to over 40 million developers working together to host and review code, manage projects, and build software together.
Sign up[PATCH] Add more tests to the default perl debugger ("perl -d" , lib/perl5db.pl). #12363
Comments
This comment has been minimized.
This comment has been minimized.
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(); |
This comment has been minimized.
This comment has been minimized.
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 |
This comment has been minimized.
This comment has been minimized.
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();
|
This comment has been minimized.
This comment has been minimized.
The RT System itself - Status changed from 'new' to 'open' |
This comment has been minimized.
This comment has been minimized.
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. |
This comment has been minimized.
This comment has been minimized.
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 |
This comment has been minimized.
This comment has been minimized.
From vadim.konovalov@alcatel-lucent.com
once again these people are breaking the debugger, ok, /me silences..... |
This comment has been minimized.
This comment has been minimized.
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 |
This comment has been minimized.
This comment has been minimized.
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 -- |
This comment has been minimized.
This comment has been minimized.
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 |
This comment has been minimized.
This comment has been minimized.
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 |
This comment has been minimized.
This comment has been minimized.
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();
|
This comment has been minimized.
This comment has been minimized.
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 |
This comment has been minimized.
This comment has been minimized.
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, |
This comment has been minimized.
This comment has been minimized.
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 -- |
This comment has been minimized.
This comment has been minimized.
This comment has been minimized.
This comment has been minimized.
From [Unknown Contact. See original ticket]Thanks, applied as 2c247e8. |
This comment has been minimized.
This comment has been minimized.
@rjbs - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#114644 (status was 'resolved')
Searchable as RT114644$