14 if (! -c "/dev/null") {
15 print "1..0 # Skip: no /dev/null\n";
19 my $dev_tty = '/dev/tty';
20 $dev_tty = 'TT:' if ($^O eq 'VMS');
22 print "1..0 # Skip: no $dev_tty\n";
26 print "1..0 # Skip: \$ENV{PERL5DB} is already set to '$ENV{PERL5DB}'\n";
33 my $rc_filename = '.perldb';
36 open my $rc_fh, '>', $rc_filename
41 # overly permissive perms gives "Must not source insecure rcfile"
42 # and hangs at the DB(1> prompt
43 chmod 0644, $rc_filename;
50 open my $in, '<', $filename
51 or die "Cannot open '$filename' for slurping - $!";
61 my $out_fn = 'db.out';
65 return _slurp($out_fn);
69 my $target = '../lib/perl5db/t/eval-line-bug';
73 &parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
83 "p \\\@{'main::_<$target'}",
91 local $ENV{PERLDB_OPTS} = "ReadLine=0";
92 runperl(switches => [ '-d' ], progfile => $target);
96 like(_out_contents(), qr/sub factorial/,
97 'The ${main::_<filename} variable in the debugger was not destroyed'
101 local $ENV{PERLDB_OPTS} = "ReadLine=0";
102 my $output = runperl(switches => [ '-d' ], progfile => '../lib/perl5db/t/lvalue-bug');
103 like($output, qr/foo is defined/, 'lvalue subs work in the debugger');
107 local $ENV{PERLDB_OPTS} = "ReadLine=0 NonStop=1";
108 my $output = runperl(switches => [ '-d' ], progfile => '../lib/perl5db/t/symbol-table-bug');
109 like($output, qr/Undefined symbols 0/, 'there are no undefined values in the symbol table');
113 if ( $Config{usethreads} ) {
114 skip('This perl has threads, skipping non-threaded debugger tests');
116 my $error = 'This Perl not built to support threads';
117 my $output = runperl( switches => [ '-dt' ], stderr => 1 );
118 like($output, qr/$error/, 'Perl debugger correctly complains that it was not built with threads');
123 if ( $Config{usethreads} ) {
124 local $ENV{PERLDB_OPTS} = "ReadLine=0 NonStop=1";
125 my $output = runperl(switches => [ '-dt' ], progfile => '../lib/perl5db/t/symbol-table-bug');
126 like($output, qr/Undefined symbols 0/, 'there are no undefined values in the symbol table when running with thread support');
128 skip("This perl is not threaded, skipping threaded debugger tests");
137 &parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
148 my $output = runperl(switches => [ '-d' ], stderr => 1, progfile => '../lib/perl5db/t/rt-61222');
149 unlike(_out_contents(), qr/INCORRECT/, "[perl #61222]");
154 # Test for Proxy constants
159 &parse_options("NonStop=0 ReadLine=0 TTY=db.out LineInfo=db.out");
171 my $output = runperl(switches => [ '-d' ], stderr => 1, progfile => '../lib/perl5db/t/proxy-constants');
172 is($output, "", "proxy constant subroutines");
175 # Testing that we can set a line in the middle of the file.
178 &parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
181 push (@DB::typeahead,
182 'b ../lib/perl5db/t/MyModule.pm:12',
184 q/do { use IO::Handle; STDOUT->autoflush(1); print "Var=$var\n"; }/,
192 my $output = runperl(switches => [ '-d', '-I', '../lib/perl5db/t', ], stderr => 1, progfile => '../lib/perl5db/t/filename-line-breakpoint');
202 "Can set breakpoint in a line in the middle of the file.");
206 # [perl #66110] Call a subroutine inside a regex
208 local $ENV{PERLDB_OPTS} = "ReadLine=0 NonStop=1";
209 my $output = runperl(switches => [ '-d' ], stderr => 1, progfile => '../lib/perl5db/t/rt-66110');
210 like($output, "All tests successful.", "[perl #66110]");
216 local $ENV{PERLDB_OPTS} = "ReadLine=0 NonStop=1";
217 my $output = runperl(switches => [ '-d', '-T' ], stderr => 1,
218 progfile => '../lib/perl5db/t/taint');
219 chomp $output if $^O eq 'VMS'; # newline guaranteed at EOF
220 is($output, '[$^X][done]', "taint");
223 # Testing that we can set a breakpoint
226 &parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
229 push (@DB::typeahead,
232 q/do { use IO::Handle; STDOUT->autoflush(1); print "X={$x}\n"; }/,
240 my $output = runperl(switches => [ '-d', ], stderr => 1, progfile => '../lib/perl5db/t/breakpoint-bug');
245 "Can set breakpoint in a line.");
249 # Testing that we can disable a breakpoint at a numeric line.
252 &parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
255 push (@DB::typeahead,
260 q/print "X={$x}\n";/,
268 my $output = runperl(switches => [ '-d', ], stderr => 1, progfile => '../lib/perl5db/t/disable-breakpoints-1'); +
272 "Can set breakpoint in a line.");
275 # Testing that we can re-enable a breakpoint at a numeric line.
278 &parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
281 push (@DB::typeahead,
288 q/print "X={$x}\n";/,
296 my $output = runperl(switches => [ '-d', ], stderr => 1, progfile => '../lib/perl5db/t/disable-breakpoints-2');
298 X=\{SecondValOneHundred\}
300 "Can set breakpoint in a line.");
304 # Disable and enable for breakpoints on outer files.
307 &parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
310 push (@DB::typeahead,
312 'b ../lib/perl5db/t/EnableModule.pm:14',
313 'disable ../lib/perl5db/t/EnableModule.pm:14',
315 'enable ../lib/perl5db/t/EnableModule.pm:14',
317 q/print "X={$x}\n";/,
325 my $output = runperl(switches => [ '-d', '-I', '../lib/perl5db/t', ], stderr => 1, progfile => '../lib/perl5db/t/disable-breakpoints-3'); +
327 X=\{SecondValTwoHundred\}
329 "Can set breakpoint in a line.");
332 1 while unlink ($rc_filename, $out_fn);