}
}
-plan(100);
+plan(115);
my $rc_filename = '.perldb';
my $output = runperl(switches => [ '-d' ], stderr => 1, progfile => '../lib/perl5db/t/rt-66110');
like($output, "All tests successful.", "[perl #66110]");
}
+# [ perl #116769] Frame=2
+{
+ local $ENV{PERLDB_OPTS} = "frame=2 nonstop";
+ my $output = runperl( switches => [ '-d' ], prog => 'print q{success}' );
+ is( $?, 0, '[perl #116769] frame=2 does not crash debugger, exit == 0' );
+ like( $output, 'success' , '[perl #116769] code is run' );
+}
+# [ perl #116771] autotrace
+{
+ local $ENV{PERLDB_OPTS} = "autotrace nonstop";
+ my $output = runperl( switches => [ '-d' ], prog => 'print q{success}' );
+ is( $?, 0, '[perl #116771] autotrace does not crash debugger, exit == 0' );
+ like( $output, 'success' , '[perl #116771] code is run' );
+}
{
rc(<<'EOF');
);
}
+# Tests for x with @_
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'b 10',
+ 'c',
+ 'x @_',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-passing-at-underscore-to-x-etc',
+ }
+ );
+
+ $wrapper->contents_like(
+ # qr/^0\s+HASH\([^\)]+\)\n\s+500 => 600\n/,
+ qr/Arg1.*?Capsula.*GreekHumor.*Socrates/ms,
+ q/x command test with '@_'./,
+ );
+}
+
+# Tests for x with AutoTrace=1.
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'n',
+ 'o AutoTrace=1',
+ # So it may fail.
+ q/x "failure"/,
+ q/x \$x/,
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/with-subroutine',
+ }
+ );
+
+ $wrapper->contents_like(
+ # qr/^0\s+HASH\([^\)]+\)\n\s+500 => 600\n/,
+ qr/^0\s+SCALAR\([^\)]+\)\n\s+-> 'hello world'\n/ms,
+ "x after AutoTrace=1 command is working."
+ );
+}
+
# Tests for "T" (stack trace).
{
my $prog_fn = '../lib/perl5db/t/rt-104168';
);
}
-# Test the a command.
+# Test the 'a' command.
{
my $wrapper = DebugWrap->new(
{
);
}
+# Test the 'a' command with no line number.
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'n',
+ q/a print "Hello " . (3 * 4) . "\n";/,
+ 'c',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-a-statement-1',
+ }
+ );
+
+ $wrapper->output_like(qr#
+ (?:^Hello\ 12\n.*?){4}
+ #msx,
+ "a command with no line number is working",
+ );
+}
+
# Test the 'A' command
{
my $wrapper = DebugWrap->new(
);
}
+# Test the final message.
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'c',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-warnLevel-option-1',
+ }
+ );
+
+ $wrapper->contents_like(qr/
+ ^Debugged\ program\ terminated\.
+ /msx,
+ 'Test the final "Debugged program terminated" message.',
+ );
+}
+
# Test the o inhibit_exit=0 command
{
my $wrapper = DebugWrap->new(
);
}
+# Test the o PrintRet=0 option in list context
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'o PrintRet=0',
+ 'b 29',
+ 'c',
+ q/$x = 'l';/,
+ 'b 17',
+ 'c',
+ 'r',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-PrintRet-option-1',
+ }
+ );
+
+ $wrapper->contents_unlike(
+ qr/list context/,
+ "Test o PrintRet=0 in list context",
+ );
+}
+
+# Test the o PrintRet=1 option in void context
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'o PrintRet=1',
+ 'b 29',
+ 'c',
+ q/$x = 'v';/,
+ 'b 24',
+ 'c',
+ 'r',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-PrintRet-option-1',
+ }
+ );
+
+ $wrapper->contents_like(
+ qr/void context return from main::return_void/,
+ "Test o PrintRet=1 in void context",
+ );
+}
+
+# Test the o PrintRet=1 option in void context
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'o PrintRet=0',
+ 'b 29',
+ 'c',
+ q/$x = 'v';/,
+ 'b 24',
+ 'c',
+ 'r',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-PrintRet-option-1',
+ }
+ );
+
+ $wrapper->contents_unlike(
+ qr/void context/,
+ "Test o PrintRet=0 in void context",
+ );
+}
+
+# Test the o frame option.
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ # This is to avoid getting the "Debugger program terminated"
+ # junk that interferes with the normal output.
+ 'o inhibit_exit=0',
+ 'b 10',
+ 'c',
+ 'o frame=255',
+ 'c',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-frame-option-1',
+ }
+ );
+
+ $wrapper->contents_like(
+ qr/
+ in\s*\.=main::my_other_func\(3,\ 1200\)\ from.*?
+ out\s*\.=main::my_other_func\(3,\ 1200\)\ from
+ /msx,
+ "Test o PrintRet=0 in void context",
+ );
+}
+
+{ # test t expr
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ # This is to avoid getting the "Debugger program terminated"
+ # junk that interferes with the normal output.
+ 'o inhibit_exit=0',
+ 't fact(3)',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/fact',
+ }
+ );
+
+ $wrapper->contents_like(
+ qr/
+ (?:^main::fact.*return\ \$n\ \*\ fact\(\$n\ -\ 1\);.*)
+ /msx,
+ "Test t expr",
+ );
+}
+
+# Test the w for lexical variables expression.
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ # This is to avoid getting the "Debugger program terminated"
+ # junk that interferes with the normal output.
+ 'w $exp',
+ 'n',
+ 'n',
+ 'n',
+ 'n',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/break-on-dot',
+ }
+ );
+
+ $wrapper->contents_like(
+ qr/
+\s+old\ value:\s+'1'\n
+\s+new\ value:\s+'2'\n
+ /msx,
+ "Test w for lexical values.",
+ );
+}
+
+# Test the perldoc command
+# We don't actually run the program, but we need to provide one to the wrapper.
+SKIP:
+{
+ $^O eq "linux"
+ or skip "man errors aren't especially portable", 1;
+ local $ENV{LANG} = "C";
+ local $ENV{LC_MESSAGE} = "C";
+ local $ENV{LC_ALL} = "C";
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'perldoc perlrules',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/fact',
+ }
+ );
+
+ $wrapper->output_like(
+ qr/No manual entry for perlrules/,
+ 'perldoc command works fine',
+ );
+}
+
END {
1 while unlink ($rc_filename, $out_fn);
}
https://perl5.git.perl.org / perl5.git / blobdiff