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] [perl5db] Add more tests + Revert back to C-style for loops #12378
Comments
From @shlomifHi all, This patch to lib/perl5db.pl and lib/perl5db.t adds more tests for the L and S commands Please look into applying it. It can also be found here: https://github.com/shlomif/perl/tree/shlomif-perl-d-add-tests-take-4 (But with merge commits/etc., so it's not recommended). Regards, Shlomi Fish Inline Patchdiff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 39c18e5..5b966e3 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -1756,7 +1756,7 @@ sub DB {
# If there's any call stack in place, turn off single
# stepping into subs throughout the stack.
for my $i (0 .. $stack_depth) {
- $stack[ $i++ ] &= ~1;
+ $stack[ $i ] &= ~1;
}
# And we are now no longer in single-step mode.
@@ -2002,9 +2002,7 @@ number information, and print that.
# Scan forward, stopping at either the end or the next
# unbreakable line.
- {
- my $i = $line + 1;
- while ( $i <= $max && $dbline[$i] == 0 )
+ for ( my $i = $line + 1 ; $i <= $max && $dbline[$i] == 0 ; ++$i )
{ #{ vi
# Drop out on null statements, block closers, and comments.
@@ -2029,12 +2027,7 @@ number information, and print that.
else {
depth_print_lineinfo($explicit_stop, $incr_pos);
}
- }
- continue
- {
- $i++;
- }## end while ($i = $line + 1 ; $i...
- }
+ } ## end for ($i = $line + 1 ; $i...
} ## end else [ if ($slave_editor)
} ## end if ($single || ($trace...
@@ -2965,15 +2958,10 @@ 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.
- $i = $#hist;
- while ($i) {
-
+ for ( $i = $#hist ; $i ; --$i ) {
# Stop if we find it.
last if $hist[$i] =~ /$pat/;
}
- continue {
- $i--;
- }
if ( !$i ) {
@@ -3045,16 +3033,12 @@ 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.
- $i = $#hist;
- while ( $i > $end ) {
+ for ( $i = $#hist ; $i > $end ; $i-- ) {
# Print the command unless it has no arguments.
print $OUT "$i: ", $hist[$i], "\n"
unless $hist[$i] =~ /^.?$/;
}
- continue {
- $i--;
- }
next CMD;
};
@@ -5067,7 +5051,7 @@ sub cmd_l {
# - whether a line has a break or not
# - whether a line has an action or not
else {
- while ($i <= $end) {
+ for ( ; $i <= $end ; $i++ ) {
# Check for breakpoints and actions.
my ( $stop, $action );
@@ -5090,10 +5074,7 @@ sub cmd_l {
# Move on to the next line. Drop out on an interrupt.
$i++, last if $signal;
- }
- continue {
- $i++;
- }## end while (; $i <= $end ; $i++)
+ } ## end for (; $i <= $end ; $i++)
# Line the prompt up; print a newline if the last line listed
# didn't have a newline.
@@ -5854,11 +5835,11 @@ 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.
- {
- my $i = $skip;
- while (
+ for (
+ my $i = $skip ;
$i < $count
- and ( $p, $file, $line, $sub, $h, $context, $e, $r ) = caller($i)
+ and ( $p, $file, $line, $sub, $h, $context, $e, $r ) = caller($i) ;
+ $i++
)
{
@@ -5945,11 +5926,7 @@ sub dump_trace {
# Stop processing frames if the user hit control-C.
last if $signal;
- } ## end while ($i)
- continue {
- $i++;
- }
- }
+ } ## end for ($i = $skip ; $i < ...
# Restore the trace value again.
$trace = $otrace;
diff --git a/lib/perl5db.t b/lib/perl5db.t
index 9276fad..f873a01 100644
--- a/lib/perl5db.t
+++ b/lib/perl5db.t
@@ -28,7 +28,7 @@ BEGIN {
}
}
-plan(40);
+plan(48);
my $rc_filename = '.perldb';
@@ -395,6 +395,13 @@ sub contents_like {
::like($self->_contents(), $re, $msg);
}
+sub contents_unlike {
+ my ($self, $re, $msg) = @_;
+
+ local $::Level = $::Level + 1;
+ ::unlike($self->_contents(), $re, $msg);
+}
+
package main;
# Testing that we can set a line in the middle of the file.
@@ -1097,6 +1104,179 @@ package main;
);
}
+# Test the L command.
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'b 6',
+ 'b 13 ($q == 5)',
+ 'L',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/eval-line-bug',
+ }
+ );
+
+ $wrapper->contents_like(
+ qr#
+ ^\S*?eval-line-bug:\n
+ \s*6:\s*my\ \$i\ =\ 5;\n
+ \s*break\ if\ \(1\)\n
+ \s*13:\s*\$i\ \+=\ \$q;\n
+ \s*break\ if\ \(\(\$q\ ==\ 5\)\)\n
+ #msx,
+ "L command is listing breakpoints",
+ );
+}
+
+# Test the L command for watch expressions.
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'w (5+6)',
+ 'L',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/eval-line-bug',
+ }
+ );
+
+ $wrapper->contents_like(
+ qr#
+ ^Watch-expressions:\n
+ \s*\(5\+6\)\n
+ #msx,
+ "L command is listing watch expressions",
+ );
+}
+
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'w (5+6)',
+ 'w (11*23)',
+ 'W (5+6)',
+ 'L',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/eval-line-bug',
+ }
+ );
+
+ $wrapper->contents_like(
+ qr#
+ ^Watch-expressions:\n
+ \s*\(11\*23\)\n
+ ^auto\(
+ #msx,
+ "L command is not listing deleted watch expressions",
+ );
+}
+
+# Test the L command.
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'b 6',
+ 'a 13 print $i',
+ 'L',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/eval-line-bug',
+ }
+ );
+
+ $wrapper->contents_like(
+ qr#
+ ^\S*?eval-line-bug:\n
+ \s*6:\s*my\ \$i\ =\ 5;\n
+ \s*break\ if\ \(1\)\n
+ \s*13:\s*\$i\ \+=\ \$q;\n
+ \s*action:\s+print\ \$i\n
+ #msx,
+ "L command is listing actions and breakpoints",
+ );
+}
+
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'S',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/rt-104168',
+ }
+ );
+
+ $wrapper->contents_like(
+ qr#
+ ^main::bar\n
+ main::baz\n
+ main::foo\n
+ #msx,
+ "S command - 1",
+ );
+}
+
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'S ^main::ba',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/rt-104168',
+ }
+ );
+
+ $wrapper->contents_like(
+ qr#
+ ^main::bar\n
+ main::baz\n
+ auto\(
+ #msx,
+ "S command with regex",
+ );
+}
+
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'S !^main::ba',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/rt-104168',
+ }
+ );
+
+ $wrapper->contents_unlike(
+ qr#
+ ^main::ba
+ #msx,
+ "S command with negative regex",
+ );
+
+ $wrapper->contents_like(
+ qr#
+ ^main::foo\n
+ #msx,
+ "S command with negative regex - what it still matches",
+ );
+}
+
END {
1 while unlink ($rc_filename, $out_fn);
}
-- Shlomi Fish http://www.shlomifish.org/ Learn Perl from “Learning Perl in 24 Minutes Unleashed, in a Nutshell for Please reply to list if it's a mailing list post - http://shlom.in/reply . |
From @shlomifThis is a more recent patcht hat can be applied instead of the previous Regards, -- Shlomi Fish |
From @shlomifperl-d-add-tests-and-convert-back-to-c-style-for-loops-v2.patchdiff --git a/MANIFEST b/MANIFEST
index c0bfe2d..e5d92e9 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4329,6 +4329,7 @@ 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/test-w-statement-1 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
lib/PerlIO.pm PerlIO support module
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 39c18e5..c8596df 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -1756,7 +1756,7 @@ sub DB {
# If there's any call stack in place, turn off single
# stepping into subs throughout the stack.
for my $i (0 .. $stack_depth) {
- $stack[ $i++ ] &= ~1;
+ $stack[ $i ] &= ~1;
}
# And we are now no longer in single-step mode.
@@ -1804,27 +1804,33 @@ sub DB {
$max = $#dbline;
# if we have something here, see if we should break.
- if ( $dbline{$line}
- && _is_breakpoint_enabled($filename, $line)
- && ( my ( $stop, $action ) = split( /\0/, $dbline{$line} ) ) )
{
+ # $stop is lexical and local to this block - $action on the other hand
+ # is global.
+ my $stop;
- # Stop if the stop criterion says to just stop.
- if ( $stop eq '1' ) {
- $signal |= 1;
- }
+ if ( $dbline{$line}
+ && _is_breakpoint_enabled($filename, $line)
+ && (( $stop, $action ) = split( /\0/, $dbline{$line} ) ) )
+ {
- # It's a conditional stop; eval it in the user's context and
- # see if we should stop. If so, remove the one-time sigil.
- elsif ($stop) {
- $evalarg = "\$DB::signal |= 1 if do {$stop}";
- &eval;
- # If the breakpoint is temporary, then delete its enabled status.
- if ($dbline{$line} =~ s/;9($|\0)/$1/) {
- _cancel_breakpoint_temp_enabled_status($filename, $line);
+ # Stop if the stop criterion says to just stop.
+ if ( $stop eq '1' ) {
+ $signal |= 1;
}
- }
- } ## end if ($dbline{$line} && ...
+
+ # It's a conditional stop; eval it in the user's context and
+ # see if we should stop. If so, remove the one-time sigil.
+ elsif ($stop) {
+ $evalarg = "\$DB::signal |= 1 if do {$stop}";
+ &eval;
+ # If the breakpoint is temporary, then delete its enabled status.
+ if ($dbline{$line} =~ s/;9($|\0)/$1/) {
+ _cancel_breakpoint_temp_enabled_status($filename, $line);
+ }
+ }
+ } ## end if ($dbline{$line} && ...
+ }
# Preserve the current stop-or-not, and see if any of the W
# (watch expressions) has changed.
@@ -2002,9 +2008,7 @@ number information, and print that.
# Scan forward, stopping at either the end or the next
# unbreakable line.
- {
- my $i = $line + 1;
- while ( $i <= $max && $dbline[$i] == 0 )
+ for ( my $i = $line + 1 ; $i <= $max && $dbline[$i] == 0 ; ++$i )
{ #{ vi
# Drop out on null statements, block closers, and comments.
@@ -2029,12 +2033,7 @@ number information, and print that.
else {
depth_print_lineinfo($explicit_stop, $incr_pos);
}
- }
- continue
- {
- $i++;
- }## end while ($i = $line + 1 ; $i...
- }
+ } ## end for ($i = $line + 1 ; $i...
} ## end else [ if ($slave_editor)
} ## end if ($single || ($trace...
@@ -2965,15 +2964,10 @@ 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.
- $i = $#hist;
- while ($i) {
-
+ for ( $i = $#hist ; $i ; --$i ) {
# Stop if we find it.
last if $hist[$i] =~ /$pat/;
}
- continue {
- $i--;
- }
if ( !$i ) {
@@ -3045,16 +3039,12 @@ 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.
- $i = $#hist;
- while ( $i > $end ) {
+ for ( $i = $#hist ; $i > $end ; $i-- ) {
# Print the command unless it has no arguments.
print $OUT "$i: ", $hist[$i], "\n"
unless $hist[$i] =~ /^.?$/;
}
- continue {
- $i--;
- }
next CMD;
};
@@ -4001,6 +3991,8 @@ sub cmd_a {
# Add the action to the line.
$dbline{$lineno} .= "\0" . action($expr);
+
+ _set_breakpoint_enabled_status($filename, $lineno, 1);
}
} ## end if (length $expr)
} ## end if ($line =~ /^\s*(\d*)\s*(\S.+)/)
@@ -5067,7 +5059,7 @@ sub cmd_l {
# - whether a line has a break or not
# - whether a line has an action or not
else {
- while ($i <= $end) {
+ for ( ; $i <= $end ; $i++ ) {
# Check for breakpoints and actions.
my ( $stop, $action );
@@ -5090,10 +5082,7 @@ sub cmd_l {
# Move on to the next line. Drop out on an interrupt.
$i++, last if $signal;
- }
- continue {
- $i++;
- }## end while (; $i <= $end ; $i++)
+ } ## end for (; $i <= $end ; $i++)
# Line the prompt up; print a newline if the last line listed
# didn't have a newline.
@@ -5854,11 +5843,11 @@ 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.
- {
- my $i = $skip;
- while (
+ for (
+ my $i = $skip ;
$i < $count
- and ( $p, $file, $line, $sub, $h, $context, $e, $r ) = caller($i)
+ and ( $p, $file, $line, $sub, $h, $context, $e, $r ) = caller($i) ;
+ $i++
)
{
@@ -5945,11 +5934,7 @@ sub dump_trace {
# Stop processing frames if the user hit control-C.
last if $signal;
- } ## end while ($i)
- continue {
- $i++;
- }
- }
+ } ## end for ($i = $skip ; $i < ...
# Restore the trace value again.
$trace = $otrace;
diff --git a/lib/perl5db.t b/lib/perl5db.t
index 9276fad..10b87ad 100644
--- a/lib/perl5db.t
+++ b/lib/perl5db.t
@@ -28,7 +28,7 @@ BEGIN {
}
}
-plan(40);
+plan(73);
my $rc_filename = '.perldb';
@@ -388,6 +388,13 @@ sub output_like {
::like($self->_output(), $re, $msg);
}
+sub output_unlike {
+ my ($self, $re, $msg) = @_;
+
+ local $::Level = $::Level + 1;
+ ::unlike($self->_output(), $re, $msg);
+}
+
sub contents_like {
my ($self, $re, $msg) = @_;
@@ -395,6 +402,13 @@ sub contents_like {
::like($self->_contents(), $re, $msg);
}
+sub contents_unlike {
+ my ($self, $re, $msg) = @_;
+
+ local $::Level = $::Level + 1;
+ ::unlike($self->_contents(), $re, $msg);
+}
+
package main;
# Testing that we can set a line in the middle of the file.
@@ -1097,6 +1111,539 @@ package main;
);
}
+# Test the L command.
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'b 6',
+ 'b 13 ($q == 5)',
+ 'L',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/eval-line-bug',
+ }
+ );
+
+ $wrapper->contents_like(
+ qr#
+ ^\S*?eval-line-bug:\n
+ \s*6:\s*my\ \$i\ =\ 5;\n
+ \s*break\ if\ \(1\)\n
+ \s*13:\s*\$i\ \+=\ \$q;\n
+ \s*break\ if\ \(\(\$q\ ==\ 5\)\)\n
+ #msx,
+ "L command is listing breakpoints",
+ );
+}
+
+# Test the L command for watch expressions.
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'w (5+6)',
+ 'L',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/eval-line-bug',
+ }
+ );
+
+ $wrapper->contents_like(
+ qr#
+ ^Watch-expressions:\n
+ \s*\(5\+6\)\n
+ #msx,
+ "L command is listing watch expressions",
+ );
+}
+
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'w (5+6)',
+ 'w (11*23)',
+ 'W (5+6)',
+ 'L',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/eval-line-bug',
+ }
+ );
+
+ $wrapper->contents_like(
+ qr#
+ ^Watch-expressions:\n
+ \s*\(11\*23\)\n
+ ^auto\(
+ #msx,
+ "L command is not listing deleted watch expressions",
+ );
+}
+
+# Test the L command.
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'b 6',
+ 'a 13 print $i',
+ 'L',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/eval-line-bug',
+ }
+ );
+
+ $wrapper->contents_like(
+ qr#
+ ^\S*?eval-line-bug:\n
+ \s*6:\s*my\ \$i\ =\ 5;\n
+ \s*break\ if\ \(1\)\n
+ \s*13:\s*\$i\ \+=\ \$q;\n
+ \s*action:\s+print\ \$i\n
+ #msx,
+ "L command is listing actions and breakpoints",
+ );
+}
+
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'S',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/rt-104168',
+ }
+ );
+
+ $wrapper->contents_like(
+ qr#
+ ^main::bar\n
+ main::baz\n
+ main::foo\n
+ #msx,
+ "S command - 1",
+ );
+}
+
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'S ^main::ba',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/rt-104168',
+ }
+ );
+
+ $wrapper->contents_like(
+ qr#
+ ^main::bar\n
+ main::baz\n
+ auto\(
+ #msx,
+ "S command with regex",
+ );
+}
+
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'S !^main::ba',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/rt-104168',
+ }
+ );
+
+ $wrapper->contents_unlike(
+ qr#
+ ^main::ba
+ #msx,
+ "S command with negative regex",
+ );
+
+ $wrapper->contents_like(
+ qr#
+ ^main::foo\n
+ #msx,
+ "S command with negative regex - what it still matches",
+ );
+}
+
+# Test the a command.
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'a 13 print "\nVar<Q>=$q\n"',
+ 'c',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/eval-line-bug',
+ }
+ );
+
+ $wrapper->output_like(qr#
+ \nVar<Q>=1\n
+ \nVar<Q>=2\n
+ \nVar<Q>=3\n
+ #msx,
+ "a command is working",
+ );
+}
+
+# Test the 'A' command
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'a 13 print "\nVar<Q>=$q\n"',
+ 'A 13',
+ 'c',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/eval-line-bug',
+ }
+ );
+
+ $wrapper->output_like(
+ qr#\A\z#msx, # The empty string.
+ "A command (for removing actions) is working",
+ );
+}
+
+# Test the 'A *' command
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'a 6 print "\nFail!\n"',
+ 'a 13 print "\nVar<Q>=$q\n"',
+ 'A *',
+ 'c',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/eval-line-bug',
+ }
+ );
+
+ $wrapper->output_like(
+ qr#\A\z#msx, # The empty string.
+ "'A *' command (for removing all actions) is working",
+ );
+}
+
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'n',
+ 'w $foo',
+ 'c',
+ 'print "\nIDX=<$idx>\n"',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-w-statement-1',
+ }
+ );
+
+
+ $wrapper->contents_like(qr#
+ \$foo\ changed:\n
+ \s+old\ value:\s+'1'\n
+ \s+new\ value:\s+'2'\n
+ #msx,
+ 'w command - watchpoint changed',
+ );
+ $wrapper->output_like(qr#
+ \nIDX=<20>\n
+ #msx,
+ "w command - correct output from IDX",
+ );
+}
+
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'n',
+ 'w $foo',
+ 'W $foo',
+ 'c',
+ 'print "\nIDX=<$idx>\n"',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-w-statement-1',
+ }
+ );
+
+ $wrapper->contents_unlike(qr#
+ \$foo\ changed:
+ #msx,
+ 'W command - watchpoint was deleted',
+ );
+
+ $wrapper->output_like(qr#
+ \nIDX=<>\n
+ #msx,
+ "W command - stopped at end.",
+ );
+}
+
+# Test the W * command.
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'n',
+ 'w $foo',
+ 'w ($foo*$foo)',
+ 'W *',
+ 'c',
+ 'print "\nIDX=<$idx>\n"',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-w-statement-1',
+ }
+ );
+
+ $wrapper->contents_unlike(qr#
+ \$foo\ changed:
+ #msx,
+ '"W *" command - watchpoint was deleted',
+ );
+
+ $wrapper->output_like(qr#
+ \nIDX=<>\n
+ #msx,
+ '"W *" command - stopped at end.',
+ );
+}
+
+# Test the 'o' command (without further arguments).
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'o',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-w-statement-1',
+ }
+ );
+
+ $wrapper->contents_like(qr#
+ ^\s*warnLevel\ =\ '1'\n
+ #msx,
+ q#"o" command (without arguments) displays warnLevel#,
+ );
+
+ $wrapper->contents_like(qr#
+ ^\s*signalLevel\ =\ '1'\n
+ #msx,
+ q#"o" command (without arguments) displays signalLevel#,
+ );
+
+ $wrapper->contents_like(qr#
+ ^\s*dieLevel\ =\ '1'\n
+ #msx,
+ q#"o" command (without arguments) displays dieLevel#,
+ );
+
+ $wrapper->contents_like(qr#
+ ^\s*hashDepth\ =\ 'N/A'\n
+ #msx,
+ q#"o" command (without arguments) displays hashDepth#,
+ );
+}
+
+# Test the 'o' query command.
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'o hashDepth? signalLevel?',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-w-statement-1',
+ }
+ );
+
+ $wrapper->contents_unlike(qr#warnLevel#,
+ q#"o" query command does not display warnLevel#,
+ );
+
+ $wrapper->contents_like(qr#
+ ^\s*signalLevel\ =\ '1'\n
+ #msx,
+ q#"o" query command displays signalLevel#,
+ );
+
+ $wrapper->contents_unlike(qr#dieLevel#,
+ q#"o" query command does not display dieLevel#,
+ );
+
+ $wrapper->contents_like(qr#
+ ^\s*hashDepth\ =\ 'N/A'\n
+ #msx,
+ q#"o" query command displays hashDepth#,
+ );
+}
+
+# Test the 'o' set command.
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'o signalLevel=0',
+ 'o',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-w-statement-1',
+ }
+ );
+
+ $wrapper->contents_like(qr/
+ ^\s*(signalLevel\ =\ '0'\n)
+ .*?
+ ^\s*\1
+ /msx,
+ q#o set command works#,
+ );
+
+ $wrapper->contents_like(qr#
+ ^\s*hashDepth\ =\ 'N/A'\n
+ #msx,
+ q#o set command - hashDepth#,
+ );
+}
+
+# Test the '<' and "< ?" commands.
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ q/< print "\nX=<$x>\n"/,
+ q/b 7/,
+ q/< ?/,
+ 'c',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/disable-breakpoints-1',
+ }
+ );
+
+ $wrapper->contents_like(qr/
+ ^pre-perl\ commands:\n
+ \s*<\ --\ print\ "\\nX=<\$x>\\n"\n
+ /msx,
+ q#Test < and < ? commands - contents.#,
+ );
+
+ $wrapper->output_like(qr#
+ ^X=<FirstVal>\n
+ #msx,
+ q#Test < and < ? commands - output.#,
+ );
+}
+
+# Test the '< *' command.
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ q/< print "\nX=<$x>\n"/,
+ q/b 7/,
+ q/< */,
+ 'c',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/disable-breakpoints-1',
+ }
+ );
+
+ $wrapper->output_unlike(qr/FirstVal/,
+ q#Test the '< *' command.#,
+ );
+}
+
+# Test the '>' and "> ?" commands.
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ q/$::foo = 500;/,
+ q/> print "\nFOO=<$::foo>\n"/,
+ q/b 7/,
+ q/> ?/,
+ 'c',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/disable-breakpoints-1',
+ }
+ );
+
+ $wrapper->contents_like(qr/
+ ^post-perl\ commands:\n
+ \s*>\ --\ print\ "\\nFOO=<\$::foo>\\n"\n
+ /msx,
+ q#Test > and > ? commands - contents.#,
+ );
+
+ $wrapper->output_like(qr#
+ ^FOO=<500>\n
+ #msx,
+ q#Test > and > ? commands - output.#,
+ );
+}
+
+# Test the '> *' command.
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ q/> print "\nFOO=<$::foo>\n"/,
+ q/b 7/,
+ q/> */,
+ 'c',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/disable-breakpoints-1',
+ }
+ );
+
+ $wrapper->output_unlike(qr/FOO=/,
+ q#Test the '> *' command.#,
+ );
+}
+
END {
1 while unlink ($rc_filename, $out_fn);
}
diff --git a/lib/perl5db/t/test-w-statement-1 b/lib/perl5db/t/test-w-statement-1
new file mode 100644
index 0000000..bfd5ccd
--- /dev/null
+++ b/lib/perl5db/t/test-w-statement-1
@@ -0,0 +1,20 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use vars qw($foo);
+
+$foo = 1;
+
+print "Hello\n";
+
+for my $idx (map { $_ * 10 } 1 .. 10)
+{
+ if ($idx > 17)
+ {
+ $foo = 2;
+ print "Baz\n";
+ }
+}
+
|
The RT System itself - Status changed from 'new' to 'open' |
From @rjbs* Shlomi Fish via RT <perlbug-followup@perl.org> [2012-09-09T12:15:43]
What are you using to generate your patches? It doesn't seem to be git-format-patch. Could you please use that in the If you would like some realtime help in sorting out your repo so that we can -- |
From [Unknown Contact. See original ticket]Thanks, applied as 72d7d80. |
@rjbs - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#114756 (status was 'resolved')
Searchable as RT114756$
The text was updated successfully, but these errors were encountered: