Commit | Line | Data |
---|---|---|
af6d5e29 | 1 | #!./perl |
635f2c9e RGS |
2 | |
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
5 | @INC = '../lib'; | |
6 | require './test.pl'; | |
7 | } | |
8 | ||
9 | use strict; | |
10 | use warnings; | |
f63574b5 | 11 | use Config; |
635f2c9e RGS |
12 | |
13 | BEGIN { | |
4cfe45a1 SF |
14 | if (! -c "/dev/null") { |
15 | print "1..0 # Skip: no /dev/null\n"; | |
16 | exit 0; | |
635f2c9e | 17 | } |
4cfe45a1 SF |
18 | |
19 | my $dev_tty = '/dev/tty'; | |
20 | $dev_tty = 'TT:' if ($^O eq 'VMS'); | |
21 | if (! -c $dev_tty) { | |
22 | print "1..0 # Skip: no $dev_tty\n"; | |
23 | exit 0; | |
9366364f | 24 | } |
b091e0d1 | 25 | if ($ENV{PERL5DB}) { |
4cfe45a1 SF |
26 | print "1..0 # Skip: \$ENV{PERL5DB} is already set to '$ENV{PERL5DB}'\n"; |
27 | exit 0; | |
b091e0d1 | 28 | } |
635f2c9e RGS |
29 | } |
30 | ||
5d5d9ea3 | 31 | plan(20); |
635f2c9e | 32 | |
4cfe45a1 SF |
33 | my $rc_filename = '.perldb'; |
34 | ||
635f2c9e | 35 | sub rc { |
4cfe45a1 SF |
36 | open my $rc_fh, '>', $rc_filename |
37 | or die $!; | |
38 | print {$rc_fh} @_; | |
39 | close ($rc_fh); | |
40 | ||
3e5e55bd DM |
41 | # overly permissive perms gives "Must not source insecure rcfile" |
42 | # and hangs at the DB(1> prompt | |
4cfe45a1 | 43 | chmod 0644, $rc_filename; |
635f2c9e RGS |
44 | } |
45 | ||
4cfe45a1 SF |
46 | sub _slurp |
47 | { | |
48 | my $filename = shift; | |
cd4eab35 | 49 | |
4cfe45a1 SF |
50 | open my $in, '<', $filename |
51 | or die "Cannot open '$filename' for slurping - $!"; | |
635f2c9e | 52 | |
4cfe45a1 SF |
53 | local $/; |
54 | my $contents = <$in>; | |
55 | ||
56 | close($in); | |
57 | ||
58 | return $contents; | |
59 | } | |
60 | ||
61 | my $out_fn = 'db.out'; | |
635f2c9e | 62 | |
4cfe45a1 | 63 | sub _out_contents |
c18cf8ce | 64 | { |
4cfe45a1 | 65 | return _slurp($out_fn); |
c18cf8ce | 66 | } |
635f2c9e | 67 | |
635f2c9e | 68 | { |
4cfe45a1 SF |
69 | my $target = '../lib/perl5db/t/eval-line-bug'; |
70 | ||
71 | rc( | |
72 | <<"EOF", | |
73 | &parse_options("NonStop=0 TTY=db.out LineInfo=db.out"); | |
74 | ||
75 | sub afterinit { | |
76 | push(\@DB::typeahead, | |
77 | 'b 23', | |
78 | 'n', | |
79 | 'n', | |
80 | 'n', | |
81 | 'c', # line 23 | |
82 | 'n', | |
83 | "p \\\@{'main::_<$target'}", | |
84 | 'q', | |
85 | ); | |
86 | } | |
87 | EOF | |
88 | ); | |
89 | ||
90 | { | |
91 | local $ENV{PERLDB_OPTS} = "ReadLine=0"; | |
92 | runperl(switches => [ '-d' ], progfile => $target); | |
93 | } | |
635f2c9e RGS |
94 | } |
95 | ||
4cfe45a1 | 96 | like(_out_contents(), qr/sub factorial/, |
635f2c9e RGS |
97 | 'The ${main::_<filename} variable in the debugger was not destroyed' |
98 | ); | |
99 | ||
1ad62f64 | 100 | { |
bdba49ad SF |
101 | my $target = '../lib/perl5db/t/eval-line-bug'; |
102 | ||
103 | rc( | |
104 | <<"EOF", | |
105 | &parse_options("NonStop=0 TTY=db.out LineInfo=db.out"); | |
106 | ||
107 | sub afterinit { | |
108 | push(\@DB::typeahead, | |
109 | 'b 23', | |
110 | 'c', | |
111 | '\$new_var = "Foo"', | |
112 | 'x "new_var = <\$new_var>\\n";', | |
113 | 'q', | |
114 | ); | |
115 | } | |
116 | EOF | |
117 | ); | |
118 | ||
119 | { | |
120 | local $ENV{PERLDB_OPTS} = "ReadLine=0"; | |
121 | runperl(switches => [ '-d' ], progfile => $target); | |
122 | } | |
123 | } | |
124 | ||
125 | like(_out_contents(), qr/new_var = <Foo>/, | |
126 | "no strict 'vars' in evaluated lines.", | |
127 | ); | |
128 | ||
129 | { | |
6fd69bbe | 130 | local $ENV{PERLDB_OPTS} = "ReadLine=0"; |
6fd69bbe FR |
131 | my $output = runperl(switches => [ '-d' ], progfile => '../lib/perl5db/t/lvalue-bug'); |
132 | like($output, qr/foo is defined/, 'lvalue subs work in the debugger'); | |
133 | } | |
134 | ||
bc6438f2 DL |
135 | { |
136 | local $ENV{PERLDB_OPTS} = "ReadLine=0 NonStop=1"; | |
137 | my $output = runperl(switches => [ '-d' ], progfile => '../lib/perl5db/t/symbol-table-bug'); | |
138 | like($output, qr/Undefined symbols 0/, 'there are no undefined values in the symbol table'); | |
139 | } | |
140 | ||
9b76ae71 | 141 | SKIP: { |
f63574b5 | 142 | if ( $Config{usethreads} ) { |
9c955c4d DL |
143 | skip('This perl has threads, skipping non-threaded debugger tests'); |
144 | } else { | |
145 | my $error = 'This Perl not built to support threads'; | |
53409900 | 146 | my $output = runperl( switches => [ '-dt' ], stderr => 1 ); |
9c955c4d DL |
147 | like($output, qr/$error/, 'Perl debugger correctly complains that it was not built with threads'); |
148 | } | |
149 | ||
150 | } | |
9b76ae71 | 151 | SKIP: { |
9c955c4d | 152 | if ( $Config{usethreads} ) { |
f63574b5 DL |
153 | local $ENV{PERLDB_OPTS} = "ReadLine=0 NonStop=1"; |
154 | my $output = runperl(switches => [ '-dt' ], progfile => '../lib/perl5db/t/symbol-table-bug'); | |
155 | like($output, qr/Undefined symbols 0/, 'there are no undefined values in the symbol table when running with thread support'); | |
156 | } else { | |
157 | skip("This perl is not threaded, skipping threaded debugger tests"); | |
158 | } | |
7dcc656f DL |
159 | } |
160 | ||
7eedc5ec B |
161 | |
162 | # Test [perl #61222] | |
163 | { | |
164 | rc( | |
4cfe45a1 | 165 | <<'EOF', |
7eedc5ec | 166 | &parse_options("NonStop=0 TTY=db.out LineInfo=db.out"); |
7eedc5ec | 167 | |
7eedc5ec | 168 | sub afterinit { |
4cfe45a1 | 169 | push(@DB::typeahead, |
7eedc5ec B |
170 | 'm Pie', |
171 | 'q', | |
172 | ); | |
4cfe45a1 SF |
173 | } |
174 | EOF | |
7eedc5ec B |
175 | ); |
176 | ||
177 | my $output = runperl(switches => [ '-d' ], stderr => 1, progfile => '../lib/perl5db/t/rt-61222'); | |
4cfe45a1 | 178 | unlike(_out_contents(), qr/INCORRECT/, "[perl #61222]"); |
7eedc5ec B |
179 | } |
180 | ||
181 | ||
182 | ||
183 | # Test for Proxy constants | |
184 | { | |
185 | rc( | |
4cfe45a1 | 186 | <<'EOF', |
7eedc5ec | 187 | |
4cfe45a1 SF |
188 | &parse_options("NonStop=0 ReadLine=0 TTY=db.out LineInfo=db.out"); |
189 | ||
190 | sub afterinit { | |
191 | push(@DB::typeahead, | |
192 | 'm main->s1', | |
193 | 'q', | |
194 | ); | |
195 | } | |
196 | ||
197 | EOF | |
7eedc5ec B |
198 | ); |
199 | ||
200 | my $output = runperl(switches => [ '-d' ], stderr => 1, progfile => '../lib/perl5db/t/proxy-constants'); | |
201 | is($output, "", "proxy constant subroutines"); | |
202 | } | |
203 | ||
076b743f SF |
204 | # Testing that we can set a line in the middle of the file. |
205 | { | |
206 | rc(<<'EOF'); | |
207 | &parse_options("NonStop=0 TTY=db.out LineInfo=db.out"); | |
208 | ||
209 | sub afterinit { | |
210 | push (@DB::typeahead, | |
211 | 'b ../lib/perl5db/t/MyModule.pm:12', | |
212 | 'c', | |
213 | q/do { use IO::Handle; STDOUT->autoflush(1); print "Var=$var\n"; }/, | |
214 | 'c', | |
215 | 'q', | |
216 | ); | |
217 | ||
218 | } | |
219 | EOF | |
220 | ||
221 | my $output = runperl(switches => [ '-d', '-I', '../lib/perl5db/t', ], stderr => 1, progfile => '../lib/perl5db/t/filename-line-breakpoint'); | |
222 | ||
223 | like($output, qr/ | |
224 | ^Var=Bar$ | |
225 | .* | |
226 | ^In\ MyModule\.$ | |
227 | .* | |
228 | ^In\ Main\ File\.$ | |
229 | .* | |
4cfe45a1 | 230 | /msx, |
076b743f SF |
231 | "Can set breakpoint in a line in the middle of the file."); |
232 | } | |
233 | ||
7eedc5ec | 234 | |
b7bfa855 B |
235 | # [perl #66110] Call a subroutine inside a regex |
236 | { | |
237 | local $ENV{PERLDB_OPTS} = "ReadLine=0 NonStop=1"; | |
238 | my $output = runperl(switches => [ '-d' ], stderr => 1, progfile => '../lib/perl5db/t/rt-66110'); | |
239 | like($output, "All tests successful.", "[perl #66110]"); | |
240 | } | |
241 | ||
611272bb PS |
242 | # [perl 104168] level option for tracing |
243 | { | |
244 | rc(<<'EOF'); | |
245 | &parse_options("NonStop=0 TTY=db.out LineInfo=db.out"); | |
246 | ||
247 | sub afterinit { | |
248 | push (@DB::typeahead, | |
249 | 't 2', | |
250 | 'c', | |
251 | 'q', | |
252 | ); | |
253 | ||
254 | } | |
255 | EOF | |
256 | ||
257 | my $output = runperl(switches => [ '-d' ], stderr => 1, progfile => '../lib/perl5db/t/rt-104168'); | |
258 | my $contents; | |
259 | { | |
260 | local $/; | |
261 | open I, "<", 'db.out' or die $!; | |
262 | $contents = <I>; | |
263 | close(I); | |
264 | } | |
265 | like($contents, qr/level 2/, "[perl #104168]"); | |
266 | unlike($contents, qr/baz/, "[perl #104168]"); | |
267 | } | |
268 | ||
07004ebb DM |
269 | # taint tests |
270 | ||
271 | { | |
272 | local $ENV{PERLDB_OPTS} = "ReadLine=0 NonStop=1"; | |
273 | my $output = runperl(switches => [ '-d', '-T' ], stderr => 1, | |
4cfe45a1 | 274 | progfile => '../lib/perl5db/t/taint'); |
314655b3 | 275 | chomp $output if $^O eq 'VMS'; # newline guaranteed at EOF |
07004ebb DM |
276 | is($output, '[$^X][done]', "taint"); |
277 | } | |
278 | ||
2211a10b SF |
279 | # Testing that we can set a breakpoint |
280 | { | |
281 | rc(<<'EOF'); | |
282 | &parse_options("NonStop=0 TTY=db.out LineInfo=db.out"); | |
283 | ||
284 | sub afterinit { | |
285 | push (@DB::typeahead, | |
286 | 'b 6', | |
287 | 'c', | |
288 | q/do { use IO::Handle; STDOUT->autoflush(1); print "X={$x}\n"; }/, | |
289 | 'c', | |
290 | 'q', | |
291 | ); | |
292 | ||
293 | } | |
294 | EOF | |
295 | ||
296 | my $output = runperl(switches => [ '-d', ], stderr => 1, progfile => '../lib/perl5db/t/breakpoint-bug'); | |
297 | ||
298 | like($output, qr/ | |
299 | X=\{Two\} | |
300 | /msx, | |
301 | "Can set breakpoint in a line."); | |
302 | } | |
303 | ||
4cfe45a1 | 304 | |
e09195af SF |
305 | # Testing that we can disable a breakpoint at a numeric line. |
306 | { | |
307 | rc(<<'EOF'); | |
308 | &parse_options("NonStop=0 TTY=db.out LineInfo=db.out"); | |
309 | ||
310 | sub afterinit { | |
311 | push (@DB::typeahead, | |
312 | 'b 7', | |
313 | 'b 11', | |
314 | 'disable 7', | |
315 | 'c', | |
316 | q/print "X={$x}\n";/, | |
317 | 'c', | |
318 | 'q', | |
319 | ); | |
320 | ||
321 | } | |
322 | EOF | |
323 | ||
324 | my $output = runperl(switches => [ '-d', ], stderr => 1, progfile => '../lib/perl5db/t/disable-breakpoints-1'); + | |
325 | like($output, qr/ | |
326 | X=\{SecondVal\} | |
327 | /msx, | |
328 | "Can set breakpoint in a line."); | |
329 | } | |
330 | ||
331 | # Testing that we can re-enable a breakpoint at a numeric line. | |
332 | { | |
333 | rc(<<'EOF'); | |
334 | &parse_options("NonStop=0 TTY=db.out LineInfo=db.out"); | |
335 | ||
336 | sub afterinit { | |
337 | push (@DB::typeahead, | |
338 | 'b 8', | |
339 | 'b 24', | |
340 | 'disable 24', | |
341 | 'c', | |
342 | 'enable 24', | |
343 | 'c', | |
344 | q/print "X={$x}\n";/, | |
345 | 'c', | |
346 | 'q', | |
347 | ); | |
b7bfa855 | 348 | |
e09195af SF |
349 | } |
350 | EOF | |
351 | ||
352 | my $output = runperl(switches => [ '-d', ], stderr => 1, progfile => '../lib/perl5db/t/disable-breakpoints-2'); | |
353 | like($output, qr/ | |
354 | X=\{SecondValOneHundred\} | |
355 | /msx, | |
356 | "Can set breakpoint in a line."); | |
357 | } | |
635f2c9e RGS |
358 | # clean up. |
359 | ||
e09195af SF |
360 | # Disable and enable for breakpoints on outer files. |
361 | { | |
362 | rc(<<'EOF'); | |
363 | &parse_options("NonStop=0 TTY=db.out LineInfo=db.out"); | |
364 | ||
365 | sub afterinit { | |
366 | push (@DB::typeahead, | |
367 | 'b 10', | |
368 | 'b ../lib/perl5db/t/EnableModule.pm:14', | |
369 | 'disable ../lib/perl5db/t/EnableModule.pm:14', | |
370 | 'c', | |
371 | 'enable ../lib/perl5db/t/EnableModule.pm:14', | |
372 | 'c', | |
373 | q/print "X={$x}\n";/, | |
374 | 'c', | |
375 | 'q', | |
376 | ); | |
377 | ||
378 | } | |
379 | EOF | |
380 | ||
381 | my $output = runperl(switches => [ '-d', '-I', '../lib/perl5db/t', ], stderr => 1, progfile => '../lib/perl5db/t/disable-breakpoints-3'); + | |
382 | like($output, qr/ | |
383 | X=\{SecondValTwoHundred\} | |
384 | /msx, | |
385 | "Can set breakpoint in a line."); | |
386 | } | |
bdba49ad SF |
387 | |
388 | # Testing that the prompt with the information appears. | |
389 | { | |
390 | rc(<<'EOF'); | |
391 | &parse_options("NonStop=0 TTY=db.out LineInfo=db.out"); | |
392 | ||
393 | sub afterinit { | |
394 | push (@DB::typeahead, | |
395 | 'q', | |
396 | ); | |
397 | ||
398 | } | |
399 | EOF | |
400 | ||
401 | my $output = runperl(switches => [ '-d', ], stderr => 1, progfile => '../lib/perl5db/t/disable-breakpoints-1'); | |
402 | ||
403 | like(_out_contents(), qr/ | |
404 | ^main::\([^\)]*\bdisable-breakpoints-1:2\):\n | |
405 | 2:\s+my\ \$x\ =\ "One";\n | |
406 | /msx, | |
407 | "Prompt should display the first line of code."); | |
408 | } | |
409 | ||
410 | # Testing that R (restart) and "B *" work. | |
411 | { | |
412 | rc(<<'EOF'); | |
413 | &parse_options("NonStop=0 TTY=db.out LineInfo=db.out"); | |
414 | ||
415 | sub afterinit { | |
416 | push (@DB::typeahead, | |
417 | 'b 13', | |
418 | 'c', | |
419 | 'B *', | |
420 | 'b 9', | |
421 | 'R', | |
422 | 'c', | |
423 | q/print "X={$x};dummy={$dummy}\n";/, | |
424 | 'q', | |
425 | ); | |
426 | ||
427 | } | |
428 | EOF | |
429 | ||
430 | my $output = runperl(switches => [ '-d', ], stderr => 1, progfile => '../lib/perl5db/t/disable-breakpoints-1'); | |
431 | like($output, qr/ | |
432 | X=\{FirstVal\};dummy=\{1\} | |
433 | /msx, | |
434 | "Restart and delete all breakpoints work properly."); | |
435 | } | |
436 | ||
5d5d9ea3 SF |
437 | { |
438 | rc(<<'EOF'); | |
439 | &parse_options("NonStop=0 TTY=db.out LineInfo=db.out"); | |
440 | ||
441 | sub afterinit { | |
442 | push (@DB::typeahead, | |
443 | 'c 15', | |
444 | q/print "X={$x}\n";/, | |
445 | 'c', | |
446 | 'q', | |
447 | ); | |
448 | ||
449 | } | |
450 | EOF | |
451 | ||
452 | my $output = runperl(switches => [ '-d', ], stderr => 1, progfile => '../lib/perl5db/t/disable-breakpoints-1'); + | |
453 | like($output, qr/ | |
454 | X=\{ThirdVal\} | |
455 | /msx, | |
456 | "'c line_num' is working properly."); | |
457 | } | |
458 | ||
635f2c9e | 459 | END { |
4cfe45a1 | 460 | 1 while unlink ($rc_filename, $out_fn); |
635f2c9e | 461 | } |