$stack_depth
@to_watch
$try
+ $end
);
sub DB {
my $position;
my ($prefix, $after, $infix);
my $pat;
- my $end;
if ($ENV{PERL5DB_THREADED}) {
$tid = eval { "[".threads->tid."]" };
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;
}
# 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
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()>
# 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.
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...
} ## 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;
};
$cmd =~ /^\/(.*)$/ && do {
# The pattern as a string.
- my $inpat = $1;
+ use vars qw($inpat);
+ $inpat = $1;
# Remove the final slash.
$inpat =~ s:([^\\])/$:$1:;
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 ) {
# 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;
};
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 '';
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
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} ) {
_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,
# - 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 );
# 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.
# 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} ) {
# 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)
# 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;
. " 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])
# 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.
# 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;
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} ) {
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,
}
}
-plan(34);
+plan(40);
my $rc_filename = '.perldb';
::runperl(
switches =>
[
- '-d',
+ '-d',
($self->_include_t ? ('-I', '../lib/perl5db/t') : ())
],
stderr => 1,
"'" . quotemeta($prog_fn) . "' line %s\\n",
(map { quotemeta($_) } @$_)
)
- }
+ }
(
['.', 'main::baz', 14,],
['.', 'main::bar', 9,],
- ['.', 'main::foo', 6]
+ ['.', 'main::foo', 6],
)
);
$wrapper->contents_like(
);
}
+{
+ 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);
}
projects / platform / upstream / perl.git / commitdiff