}
}
-plan(83);
+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(
\d+:\s+l\ 5-10\n
\d+:\s+l\ 1-10\n
#msx,
- 'Test the source command (along with l)',
+ 'Test the H -num command',
);
}
\d+:\s+l\ 5-10\n
\d+:\s+l\ 1-10\n
#msx,
- 'Test the source command (along with l)',
+ 'Test the H command (without a number.)',
+ );
+}
+
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ '= quit q',
+ '= foobar l',
+ 'foobar',
+ 'quit',
+ ],
+ prog => '../lib/perl5db/t/test-l-statement-1',
+ }
+ );
+
+ $wrapper->contents_like(
+ 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
+ /msx,
+ 'Test the = (command alias) command.',
+ );
+}
+
+# Test the m statement.
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'm main',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/disable-breakpoints-1',
+ }
+ );
+
+ $wrapper->contents_like(qr#
+ ^via\ UNIVERSAL:\ DOES$
+ #msx,
+ "Test m for main - 1",
+ );
+
+ $wrapper->contents_like(qr#
+ ^via\ UNIVERSAL:\ can$
+ #msx,
+ "Test m for main - 2",
+ );
+}
+
+# Test the m statement.
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'b 41',
+ 'c',
+ 'm $obj',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-m-statement-1',
+ }
+ );
+
+ $wrapper->contents_like(qr#^greet$#ms,
+ "Test m for obj - 1",
+ );
+
+ $wrapper->contents_like(qr#^via UNIVERSAL: can$#ms,
+ "Test m for obj - 1",
+ );
+}
+
+# Test the M command.
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'M',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-m-statement-1',
+ }
+ );
+
+ $wrapper->contents_like(qr#
+ ^'strict\.pm'\ =>\ '\d+\.\d+\ from
+ #msx,
+ "Test M",
+ );
+
+}
+
+# Test the recallCommand option.
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'o recallCommand=%',
+ 'l 3-5',
+ 'l 2',
+ '% -1',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/disable-breakpoints-1',
+ }
+ );
+
+ $wrapper->contents_like(qr#
+ (^3:\s+my\ \$dummy\ =\ 0;\n
+ 4\s*\n
+ 5:\s+\$x\ =\ "FirstVal";)\n
+ .*?
+ ^2==\>\s+my\ \$x\ =\ "One";\n
+ .*?
+ ^l\ 3-5\n
+ \1
+ #msx,
+ 'Test the o recallCommand option',
+ );
+}
+
+# Test the dieLevel option
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ q/o dieLevel='1'/,
+ q/c/,
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-dieLevel-option-1',
+ }
+ );
+
+ $wrapper->output_like(qr#
+ ^This\ program\ dies\.\ at\ \S+\ line\ 18\.\n
+ .*?
+ ^\s+main::baz\(\)\ called\ at\ \S+\ line\ 13\n
+ \s+main::bar\(\)\ called\ at\ \S+\ line\ 7\n
+ \s+main::foo\(\)\ called\ at\ \S+\ line\ 21\n
+ #msx,
+ 'Test the o dieLevel option',
+ );
+}
+
+# Test the warnLevel option
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ q/o warnLevel='1'/,
+ q/c/,
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-warnLevel-option-1',
+ }
+ );
+
+ $wrapper->contents_like(qr#
+ ^This\ is\ not\ a\ warning\.\ at\ \S+\ line\ 18\.\n
+ .*?
+ ^\s+main::baz\(\)\ called\ at\ \S+\ line\ 13\n
+ \s+main::bar\(\)\ called\ at\ \S+\ line\ 25\n
+ \s+main::myfunc\(\)\ called\ at\ \S+\ line\ 28\n
+ #msx,
+ 'Test the o warnLevel option',
+ );
+}
+
+# Test the t command
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 't',
+ 'c',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/disable-breakpoints-1',
+ }
+ );
+
+ $wrapper->contents_like(qr/
+ ^main::\([^:]+:15\):\n
+ 15:\s+\$dummy\+\+;\n
+ main::\([^:]+:17\):\n
+ 17:\s+\$x\ =\ "FourthVal";\n
+ /msx,
+ 'Test the t command (without a number.)',
+ );
+}
+
+# Test the o AutoTrace command
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'o AutoTrace',
+ 'c',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/disable-breakpoints-1',
+ }
+ );
+
+ $wrapper->contents_like(qr/
+ ^main::\([^:]+:15\):\n
+ 15:\s+\$dummy\+\+;\n
+ main::\([^:]+:17\):\n
+ 17:\s+\$x\ =\ "FourthVal";\n
+ /msx,
+ 'Test the o AutoTrace command',
+ );
+}
+
+# Test the t command with function calls
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 't',
+ 'b 18',
+ 'c',
+ 'x ["foo"]',
+ 'x ["bar"]',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-warnLevel-option-1',
+ }
+ );
+
+ $wrapper->contents_like(qr/
+ ^main::\([^:]+:28\):\n
+ 28:\s+myfunc\(\);\n
+ main::myfunc\([^:]+:25\):\n
+ 25:\s+bar\(\);\n
+ /msx,
+ 'Test the t command with function calls.',
+ );
+}
+
+# Test the o AutoTrace command with function calls
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'o AutoTrace',
+ 'b 18',
+ 'c',
+ 'x ["foo"]',
+ 'x ["bar"]',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-warnLevel-option-1',
+ }
+ );
+
+ $wrapper->contents_like(qr/
+ ^main::\([^:]+:28\):\n
+ 28:\s+myfunc\(\);\n
+ main::myfunc\([^:]+:25\):\n
+ 25:\s+bar\(\);\n
+ /msx,
+ 'Test the t command with function calls.',
+ );
+}
+
+# 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(
+ {
+ cmds =>
+ [
+ 'o inhibit_exit=0',
+ 'n',
+ 'n',
+ 'n',
+ 'n',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-warnLevel-option-1',
+ }
+ );
+
+ $wrapper->contents_unlike(qr/
+ ^Debugged\ program\ terminated\.
+ /msx,
+ 'Test the o inhibit_exit=0 command.',
+ );
+}
+
+# Test the o PrintRet=1 option
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'o PrintRet=1',
+ 'b 29',
+ 'c',
+ q/$x = 's';/,
+ 'b 10',
+ 'c',
+ 'r',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-PrintRet-option-1',
+ }
+ );
+
+ $wrapper->contents_like(
+ qr/scalar context return from main::return_scalar: 20024/,
+ "Test o PrintRet=1",
+ );
+}
+
+# Test the o PrintRet=0 option
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'o PrintRet=0',
+ 'b 29',
+ 'c',
+ q/$x = 's';/,
+ 'b 10',
+ 'c',
+ 'r',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-PrintRet-option-1',
+ }
+ );
+
+ $wrapper->contents_unlike(
+ qr/scalar context/,
+ "Test o PrintRet=0",
+ );
+}
+
+# Test the o PrintRet=1 option in list context
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'o PrintRet=1',
+ 'b 29',
+ 'c',
+ q/$x = 'l';/,
+ 'b 17',
+ 'c',
+ 'r',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/test-PrintRet-option-1',
+ }
+ );
+
+ $wrapper->contents_like(
+ qr/list context return from main::return_list:\n0\s*'Foo'\n1\s*'Bar'\n2\s*'Baz'\n/,
+ "Test o PrintRet=1 in list context",
+ );
+}
+
+# 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',
);
}
https://perl5.git.perl.org / perl5.git / blobdiff