This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Extract a constructor.
[perl5.git] / lib / perl5db.t
CommitLineData
af6d5e29 1#!./perl
635f2c9e
RGS
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6 require './test.pl';
7}
8
9use strict;
10use warnings;
f63574b5 11use Config;
635f2c9e
RGS
12
13BEGIN {
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
ada05bfe 31plan(79);
635f2c9e 32
4cfe45a1
SF
33my $rc_filename = '.perldb';
34
635f2c9e 35sub 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
46sub _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
61my $out_fn = 'db.out';
635f2c9e 62
4cfe45a1 63sub _out_contents
c18cf8ce 64{
4cfe45a1 65 return _slurp($out_fn);
c18cf8ce 66}
635f2c9e 67
1ad62f64 68{
bdba49ad
SF
69 rc(
70 <<"EOF",
71 &parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
72
73 sub afterinit {
74 push(\@DB::typeahead,
75 'b 23',
76 'c',
77 '\$new_var = "Foo"',
78 'x "new_var = <\$new_var>\\n";',
79 'q',
80 );
81 }
82EOF
83 );
bdba49ad
SF
84}
85
bdba49ad 86{
6fd69bbe 87 local $ENV{PERLDB_OPTS} = "ReadLine=0";
6fd69bbe
FR
88 my $output = runperl(switches => [ '-d' ], progfile => '../lib/perl5db/t/lvalue-bug');
89 like($output, qr/foo is defined/, 'lvalue subs work in the debugger');
90}
91
bc6438f2
DL
92{
93 local $ENV{PERLDB_OPTS} = "ReadLine=0 NonStop=1";
94 my $output = runperl(switches => [ '-d' ], progfile => '../lib/perl5db/t/symbol-table-bug');
95 like($output, qr/Undefined symbols 0/, 'there are no undefined values in the symbol table');
96}
97
9b76ae71 98SKIP: {
f63574b5 99 if ( $Config{usethreads} ) {
9c955c4d
DL
100 skip('This perl has threads, skipping non-threaded debugger tests');
101 } else {
102 my $error = 'This Perl not built to support threads';
53409900 103 my $output = runperl( switches => [ '-dt' ], stderr => 1 );
9c955c4d
DL
104 like($output, qr/$error/, 'Perl debugger correctly complains that it was not built with threads');
105 }
106
107}
9b76ae71 108SKIP: {
9c955c4d 109 if ( $Config{usethreads} ) {
f63574b5
DL
110 local $ENV{PERLDB_OPTS} = "ReadLine=0 NonStop=1";
111 my $output = runperl(switches => [ '-dt' ], progfile => '../lib/perl5db/t/symbol-table-bug');
112 like($output, qr/Undefined symbols 0/, 'there are no undefined values in the symbol table when running with thread support');
113 } else {
114 skip("This perl is not threaded, skipping threaded debugger tests");
115 }
7dcc656f
DL
116}
117
7eedc5ec
B
118
119# Test [perl #61222]
120{
221d5972 121 local $ENV{PERLDB_OPTS};
7eedc5ec 122 rc(
4cfe45a1 123 <<'EOF',
7eedc5ec 124 &parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
7eedc5ec 125
7eedc5ec 126 sub afterinit {
4cfe45a1 127 push(@DB::typeahead,
7eedc5ec
B
128 'm Pie',
129 'q',
130 );
4cfe45a1
SF
131 }
132EOF
7eedc5ec
B
133 );
134
135 my $output = runperl(switches => [ '-d' ], stderr => 1, progfile => '../lib/perl5db/t/rt-61222');
4cfe45a1 136 unlike(_out_contents(), qr/INCORRECT/, "[perl #61222]");
7eedc5ec
B
137}
138
139
140
141# Test for Proxy constants
142{
143 rc(
4cfe45a1 144 <<'EOF',
7eedc5ec 145
4cfe45a1
SF
146&parse_options("NonStop=0 ReadLine=0 TTY=db.out LineInfo=db.out");
147
148sub afterinit {
149 push(@DB::typeahead,
150 'm main->s1',
151 'q',
152 );
153}
154
155EOF
7eedc5ec
B
156 );
157
158 my $output = runperl(switches => [ '-d' ], stderr => 1, progfile => '../lib/perl5db/t/proxy-constants');
159 is($output, "", "proxy constant subroutines");
160}
161
b7bfa855
B
162# [perl #66110] Call a subroutine inside a regex
163{
164 local $ENV{PERLDB_OPTS} = "ReadLine=0 NonStop=1";
165 my $output = runperl(switches => [ '-d' ], stderr => 1, progfile => '../lib/perl5db/t/rt-66110');
166 like($output, "All tests successful.", "[perl #66110]");
167}
168
611272bb
PS
169# [perl 104168] level option for tracing
170{
171 rc(<<'EOF');
172&parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
173
174sub afterinit {
175 push (@DB::typeahead,
176 't 2',
177 'c',
178 'q',
179 );
180
181}
182EOF
183
184 my $output = runperl(switches => [ '-d' ], stderr => 1, progfile => '../lib/perl5db/t/rt-104168');
5e2fff4a 185 my $contents = _out_contents();
611272bb
PS
186 like($contents, qr/level 2/, "[perl #104168]");
187 unlike($contents, qr/baz/, "[perl #104168]");
188}
189
07004ebb
DM
190# taint tests
191
192{
193 local $ENV{PERLDB_OPTS} = "ReadLine=0 NonStop=1";
194 my $output = runperl(switches => [ '-d', '-T' ], stderr => 1,
4cfe45a1 195 progfile => '../lib/perl5db/t/taint');
314655b3 196 chomp $output if $^O eq 'VMS'; # newline guaranteed at EOF
07004ebb
DM
197 is($output, '[$^X][done]', "taint");
198}
199
5e2fff4a
SF
200package DebugWrap;
201
202sub new {
203 my $class = shift;
204
205 my $self = bless {}, $class;
206
207 $self->_init(@_);
208
209 return $self;
210}
211
212sub _cmds {
213 my $self = shift;
214
215 if (@_) {
216 $self->{_cmds} = shift;
217 }
218
219 return $self->{_cmds};
220}
221
222sub _prog {
223 my $self = shift;
224
225 if (@_) {
226 $self->{_prog} = shift;
227 }
228
229 return $self->{_prog};
230}
231
232sub _output {
233 my $self = shift;
234
235 if (@_) {
236 $self->{_output} = shift;
237 }
238
239 return $self->{_output};
240}
241
242sub _include_t
2211a10b 243{
5e2fff4a 244 my $self = shift;
2211a10b 245
5e2fff4a
SF
246 if (@_)
247 {
248 $self->{_include_t} = shift;
249 }
2211a10b 250
5e2fff4a 251 return $self->{_include_t};
2211a10b 252}
2211a10b 253
5e2fff4a
SF
254sub _contents
255{
256 my $self = shift;
2211a10b 257
5e2fff4a
SF
258 if (@_)
259 {
260 $self->{_contents} = shift;
261 }
262
263 return $self->{_contents};
2211a10b
SF
264}
265
5e2fff4a
SF
266sub _init
267{
268 my ($self, $args) = @_;
4cfe45a1 269
5e2fff4a
SF
270 my $cmds = $args->{cmds};
271
272 if (ref($cmds) ne 'ARRAY') {
273 die "cmds must be an array of commands.";
274 }
275
276 $self->_cmds($cmds);
277
278 my $prog = $args->{prog};
279
280 if (ref($prog) ne '' or !defined($prog)) {
281 die "prog should be a path to a program file.";
282 }
283
284 $self->_prog($prog);
285
286 $self->_include_t($args->{include_t} ? 1 : 0);
287
288 $self->_run();
289
290 return;
291}
292
293sub _quote
e09195af 294{
5e2fff4a 295 my ($self, $str) = @_;
e09195af 296
5e2fff4a
SF
297 $str =~ s/(["\@\$\\])/\\$1/g;
298 $str =~ s/\n/\\n/g;
299 $str =~ s/\r/\\r/g;
300
301 return qq{"$str"};
302}
303
304sub _run {
305 my $self = shift;
306
307 my $rc = qq{&parse_options("NonStop=0 TTY=db.out LineInfo=db.out");\n};
308
309 $rc .= join('',
310 map { "$_\n"}
311 (q#sub afterinit {#,
312 q#push (@DB::typeahead,#,
313 (map { $self->_quote($_) . "," } @{$self->_cmds()}),
314 q#);#,
315 q#}#,
316 )
e09195af
SF
317 );
318
5e2fff4a
SF
319 # I guess two objects like that cannot be used at the same time.
320 # Oh well.
321 ::rc($rc);
322
323 my $output =
324 ::runperl(
325 switches =>
326 [
2c247e84 327 '-d',
5e2fff4a
SF
328 ($self->_include_t ? ('-I', '../lib/perl5db/t') : ())
329 ],
330 stderr => 1,
331 progfile => $self->_prog()
332 );
333
334 $self->_output($output);
335
336 $self->_contents(::_out_contents());
337
338 return;
e09195af 339}
e09195af 340
5e2fff4a
SF
341sub output_like {
342 my ($self, $re, $msg) = @_;
343
344 local $::Level = $::Level + 1;
345 ::like($self->_output(), $re, $msg);
346}
347
72d7d80d
SF
348sub output_unlike {
349 my ($self, $re, $msg) = @_;
350
351 local $::Level = $::Level + 1;
352 ::unlike($self->_output(), $re, $msg);
353}
354
5e2fff4a
SF
355sub contents_like {
356 my ($self, $re, $msg) = @_;
357
358 local $::Level = $::Level + 1;
359 ::like($self->_contents(), $re, $msg);
360}
361
72d7d80d
SF
362sub contents_unlike {
363 my ($self, $re, $msg) = @_;
364
365 local $::Level = $::Level + 1;
366 ::unlike($self->_contents(), $re, $msg);
367}
368
5e2fff4a
SF
369package main;
370
708dd780
SF
371{
372 local $ENV{PERLDB_OPTS} = "ReadLine=0";
373 my $target = '../lib/perl5db/t/eval-line-bug';
374 my $wrapper = DebugWrap->new(
375 {
376 cmds =>
377 [
378 'b 23',
379 'n',
380 'n',
381 'n',
382 'c', # line 23
383 'n',
384 "p \@{'main::_<$target'}",
385 'q',
386 ],
387 prog => $target,
388 }
389 );
390 $wrapper->contents_like(
391 qr/sub factorial/,
392 'The ${main::_<filename} variable in the debugger was not destroyed',
393 );
394}
395
5c976af9 396sub calc_new_var_wrapper
b2e270a3 397{
5c976af9
SF
398 my ($target, $extra_opts) = @_;
399 $extra_opts ||= '';
400 local $ENV{PERLDB_OPTS} = "ReadLine=0" . $extra_opts;
401 return DebugWrap->new(
b2e270a3
SF
402 {
403 cmds =>
404 [
405 'b 23',
406 'n',
407 '$new_var = "Foo"',
408 'x "new_var = <$new_var>\\n"',
409 'q',
410 ],
411 prog => $target,
412 }
413 );
5c976af9 414}
b2e270a3 415
5c976af9
SF
416{
417 calc_new_var_wrapper('../lib/perl5db/t/eval-line-bug')
418 ->contents_like(
419 qr/new_var = <Foo>/,
420 "no strict 'vars' in evaluated lines.",
421 );
b2e270a3 422}
5c976af9 423
5e2fff4a
SF
424# Testing that we can set a line in the middle of the file.
425{
426 my $wrapper = DebugWrap->new(
427 {
428 cmds =>
429 [
430 'b ../lib/perl5db/t/MyModule.pm:12',
431 'c',
432 q/do { use IO::Handle; STDOUT->autoflush(1); print "Var=$var\n"; }/,
433 'c',
434 'q',
435 ],
436 include_t => 1,
437 prog => '../lib/perl5db/t/filename-line-breakpoint'
438 }
439 );
440
441 $wrapper->output_like(qr/
442 ^Var=Bar$
443 .*
444 ^In\ MyModule\.$
445 .*
446 ^In\ Main\ File\.$
447 .*
e09195af 448 /msx,
5e2fff4a 449 "Can set breakpoint in a line in the middle of the file.");
e09195af
SF
450}
451
5e2fff4a 452# Testing that we can set a breakpoint
e09195af 453{
5e2fff4a
SF
454 my $wrapper = DebugWrap->new(
455 {
456 prog => '../lib/perl5db/t/breakpoint-bug',
457 cmds =>
458 [
459 'b 6',
460 'c',
461 q/do { use IO::Handle; STDOUT->autoflush(1); print "X={$x}\n"; }/,
462 'c',
463 'q',
464 ],
465 },
466 );
e09195af 467
5e2fff4a
SF
468 $wrapper->output_like(
469 qr/X=\{Two\}/msx,
470 "Can set breakpoint in a line."
471 );
472}
473
474# Testing that we can disable a breakpoint at a numeric line.
475{
476 my $wrapper = DebugWrap->new(
477 {
478 prog => '../lib/perl5db/t/disable-breakpoints-1',
479 cmds =>
480 [
481 'b 7',
482 'b 11',
483 'disable 7',
484 'c',
485 q/print "X={$x}\n";/,
486 'c',
487 'q',
488 ],
489 }
e09195af 490 );
b7bfa855 491
5e2fff4a
SF
492 $wrapper->output_like(qr/X=\{SecondVal\}/ms,
493 "Can set breakpoint in a line.");
e09195af 494}
e09195af 495
5e2fff4a
SF
496# Testing that we can re-enable a breakpoint at a numeric line.
497{
498 my $wrapper = DebugWrap->new(
499 {
500 prog => '../lib/perl5db/t/disable-breakpoints-2',
501 cmds =>
502 [
503 'b 8',
504 'b 24',
505 'disable 24',
506 'c',
507 'enable 24',
508 'c',
509 q/print "X={$x}\n";/,
510 'c',
511 'q',
512 ],
513 },
514 );
515
516 $wrapper->output_like(
517 qr/
e09195af
SF
518 X=\{SecondValOneHundred\}
519 /msx,
5e2fff4a
SF
520 "Can set breakpoint in a line."
521 );
e09195af 522}
635f2c9e
RGS
523# clean up.
524
e09195af
SF
525# Disable and enable for breakpoints on outer files.
526{
5e2fff4a
SF
527 my $wrapper = DebugWrap->new(
528 {
529 cmds =>
530 [
531 'b 10',
532 'b ../lib/perl5db/t/EnableModule.pm:14',
533 'disable ../lib/perl5db/t/EnableModule.pm:14',
534 'c',
535 'enable ../lib/perl5db/t/EnableModule.pm:14',
536 'c',
537 q/print "X={$x}\n";/,
538 'c',
539 'q',
540 ],
541 prog => '../lib/perl5db/t/disable-breakpoints-3',
542 include_t => 1,
543 }
e09195af
SF
544 );
545
5e2fff4a 546 $wrapper->output_like(qr/
e09195af
SF
547 X=\{SecondValTwoHundred\}
548 /msx,
549 "Can set breakpoint in a line.");
550}
bdba49ad
SF
551
552# Testing that the prompt with the information appears.
553{
5e2fff4a
SF
554 my $wrapper = DebugWrap->new(
555 {
556 cmds => ['q'],
557 prog => '../lib/perl5db/t/disable-breakpoints-1',
558 }
bdba49ad
SF
559 );
560
5e2fff4a 561 $wrapper->contents_like(qr/
bdba49ad
SF
562 ^main::\([^\)]*\bdisable-breakpoints-1:2\):\n
563 2:\s+my\ \$x\ =\ "One";\n
564 /msx,
565 "Prompt should display the first line of code.");
566}
567
568# Testing that R (restart) and "B *" work.
569{
5e2fff4a
SF
570 my $wrapper = DebugWrap->new(
571 {
572 cmds =>
573 [
574 'b 13',
575 'c',
576 'B *',
577 'b 9',
578 'R',
579 'c',
580 q/print "X={$x};dummy={$dummy}\n";/,
581 'q',
582 ],
583 prog => '../lib/perl5db/t/disable-breakpoints-1',
584 }
bdba49ad
SF
585 );
586
5e2fff4a 587 $wrapper->output_like(qr/
bdba49ad
SF
588 X=\{FirstVal\};dummy=\{1\}
589 /msx,
590 "Restart and delete all breakpoints work properly.");
591}
592
5d5d9ea3 593{
5e2fff4a
SF
594 my $wrapper = DebugWrap->new(
595 {
596 cmds =>
597 [
598 'c 15',
599 q/print "X={$x}\n";/,
600 'c',
601 'q',
602 ],
603 prog => '../lib/perl5db/t/disable-breakpoints-1',
604 }
5d5d9ea3
SF
605 );
606
5e2fff4a 607 $wrapper->output_like(qr/
5d5d9ea3
SF
608 X=\{ThirdVal\}
609 /msx,
610 "'c line_num' is working properly.");
611}
612
5343a617 613{
5e2fff4a
SF
614 my $wrapper = DebugWrap->new(
615 {
616 cmds =>
617 [
618 'n',
619 'n',
620 'b . $exp > 200',
621 'c',
622 q/print "Exp={$exp}\n";/,
623 'q',
624 ],
625 prog => '../lib/perl5db/t/break-on-dot',
626 }
5343a617 627 );
5343a617 628
5e2fff4a 629 $wrapper->output_like(qr/
5343a617
SF
630 Exp=\{256\}
631 /msx,
632 "'b .' is working correctly.");
633}
634
8dc67a69
SF
635# Testing that the prompt with the information appears inside a subroutine call.
636# See https://rt.perl.org/rt3/Ticket/Display.html?id=104820
637{
5e2fff4a
SF
638 my $wrapper = DebugWrap->new(
639 {
640 cmds =>
641 [
642 'c back',
643 'q',
644 ],
645 prog => '../lib/perl5db/t/with-subroutine',
646 }
8dc67a69 647 );
8dc67a69 648
5e2fff4a 649 $wrapper->contents_like(
8dc67a69
SF
650 qr/
651 ^main::back\([^\)\n]*\bwith-subroutine:15\):[\ \t]*\n
652 ^15:\s*print\ "hello\ back\\n";
653 /msx,
654 "Prompt should display the line of code inside a subroutine.");
655}
656
984e0ec4
SF
657# Checking that the p command works.
658{
5e2fff4a
SF
659 my $wrapper = DebugWrap->new(
660 {
661 cmds =>
662 [
663 'p "<<<" . (4*6) . ">>>"',
664 'q',
665 ],
666 prog => '../lib/perl5db/t/with-subroutine',
667 }
984e0ec4
SF
668 );
669
5e2fff4a 670 $wrapper->contents_like(
984e0ec4
SF
671 qr/<<<24>>>/,
672 "p command works.");
673}
674
9f810cd7
SF
675# Tests for x.
676{
5e2fff4a
SF
677 my $wrapper = DebugWrap->new(
678 {
679 cmds =>
680 [
681 q/x {500 => 600}/,
682 'q',
683 ],
684 prog => '../lib/perl5db/t/with-subroutine',
685 }
9f810cd7
SF
686 );
687
5e2fff4a 688 $wrapper->contents_like(
9f810cd7
SF
689 # qr/^0\s+HASH\([^\)]+\)\n\s+500 => 600\n/,
690 qr/^0\s+HASH\([^\)]+\)\n\s+500 => 600\n/ms,
691 "x command test."
692 );
693}
694
5bc17875
SF
695# Tests for "T" (stack trace).
696{
5bc17875 697 my $prog_fn = '../lib/perl5db/t/rt-104168';
5e2fff4a
SF
698 my $wrapper = DebugWrap->new(
699 {
700 prog => $prog_fn,
701 cmds =>
702 [
703 'c baz',
704 'T',
705 'q',
706 ],
707 }
708 );
5bc17875
SF
709 my $re_text = join('',
710 map {
711 sprintf(
712 "%s = %s\\(\\) called from file " .
713 "'" . quotemeta($prog_fn) . "' line %s\\n",
714 (map { quotemeta($_) } @$_)
715 )
2c247e84 716 }
5bc17875
SF
717 (
718 ['.', 'main::baz', 14,],
719 ['.', 'main::bar', 9,],
2c247e84 720 ['.', 'main::foo', 6],
5bc17875
SF
721 )
722 );
5e2fff4a 723 $wrapper->contents_like(
5bc17875
SF
724 # qr/^0\s+HASH\([^\)]+\)\n\s+500 => 600\n/,
725 qr/^$re_text/ms,
726 "T command test."
727 );
728}
8fe891f1
SF
729
730# Test for s.
731{
5e2fff4a
SF
732 my $wrapper = DebugWrap->new(
733 {
734 cmds =>
735 [
736 'b 9',
737 'c',
738 's',
739 q/print "X={$x};dummy={$dummy}\n";/,
740 'q',
741 ],
742 prog => '../lib/perl5db/t/disable-breakpoints-1'
743 }
8fe891f1
SF
744 );
745
5e2fff4a 746 $wrapper->output_like(qr/
8fe891f1
SF
747 X=\{SecondVal\};dummy=\{1\}
748 /msx,
749 'test for s - single step',
750 );
751}
752
65ab0314 753{
5e2fff4a
SF
754 my $wrapper = DebugWrap->new(
755 {
756 cmds =>
757 [
758 'n',
759 'n',
760 'b . $exp > 200',
761 'c',
762 q/print "Exp={$exp}\n";/,
763 'q',
764 ],
765 prog => '../lib/perl5db/t/break-on-dot'
766 }
65ab0314
SF
767 );
768
5e2fff4a 769 $wrapper->output_like(qr/
65ab0314
SF
770 Exp=\{256\}
771 /msx,
772 "'b .' is working correctly.");
773}
774
775{
65ab0314 776 my $prog_fn = '../lib/perl5db/t/rt-104168';
5e2fff4a
SF
777 my $wrapper = DebugWrap->new(
778 {
779 cmds =>
780 [
781 's',
782 'q',
783 ],
784 prog => $prog_fn,
785 }
786 );
65ab0314 787
5e2fff4a 788 $wrapper->contents_like(
65ab0314
SF
789 qr/
790 ^main::foo\([^\)\n]*\brt-104168:9\):[\ \t]*\n
791 ^9:\s*bar\(\);
792 /msx,
793 'Test for the s command.',
794 );
795}
796
5d83cde2 797{
5e2fff4a
SF
798 my $wrapper = DebugWrap->new(
799 {
800 cmds =>
801 [
802 's uncalled_subroutine()',
803 'c',
804 'q',
805 ],
5d83cde2 806
5e2fff4a 807 prog => '../lib/perl5db/t/uncalled-subroutine'}
5d83cde2
SF
808 );
809
5e2fff4a 810 $wrapper->output_like(
5d83cde2
SF
811 qr/<1,2,3,4,5>\n/,
812 'uncalled_subroutine was called after s EXPR()',
813 );
5d83cde2
SF
814}
815
d7b8b95b 816{
5e2fff4a
SF
817 my $wrapper = DebugWrap->new(
818 {
819 cmds =>
820 [
821 'n uncalled_subroutine()',
822 'c',
823 'q',
824 ],
825 prog => '../lib/perl5db/t/uncalled-subroutine',
826 }
d7b8b95b
SF
827 );
828
5e2fff4a 829 $wrapper->output_like(
d7b8b95b
SF
830 qr/<1,2,3,4,5>\n/,
831 'uncalled_subroutine was called after n EXPR()',
832 );
d7b8b95b
SF
833}
834
ea7bdd87
VP
835{
836 my $wrapper = DebugWrap->new(
837 {
838 cmds =>
839 [
840 'b fact',
841 'c',
842 'c',
843 'c',
844 'n',
845 'print "<$n>"',
846 'q',
847 ],
848 prog => '../lib/perl5db/t/fact',
849 }
850 );
851
852 $wrapper->output_like(
853 qr/<3>/,
854 'b subroutine works fine',
855 );
856}
857
f311474d
VP
858# Test for 'M' (module list).
859{
860 my $wrapper = DebugWrap->new(
861 {
862 cmds =>
863 [
864 'M',
865 'q',
866 ],
867 prog => '../lib/perl5db/t/load-modules'
868 }
869 );
870
871 $wrapper->contents_like(
872 qr[Scalar/Util\.pm],
873 'M (module list) works fine',
874 );
875}
876
55783941
SF
877{
878 my $wrapper = DebugWrap->new(
879 {
880 cmds =>
881 [
882 'b 14',
883 'c',
884 '$flag = 1;',
885 'r',
886 'print "Var=$var\n";',
887 'q',
888 ],
889 prog => '../lib/perl5db/t/test-r-statement',
890 }
891 );
892
893 $wrapper->output_like(
894 qr/
895 ^Foo$
896 .*?
897 ^Bar$
898 .*?
899 ^Var=Test$
900 /msx,
901 'r statement is working properly.',
902 );
903}
904
905{
906 my $wrapper = DebugWrap->new(
907 {
908 cmds =>
909 [
910 'l',
911 'q',
912 ],
913 prog => '../lib/perl5db/t/test-l-statement-1',
914 }
915 );
916
917 $wrapper->contents_like(
918 qr/
919 ^1==>\s+\$x\ =\ 1;\n
920 2:\s+print\ "1\\n";\n
921 3\s*\n
922 4:\s+\$x\ =\ 2;\n
923 5:\s+print\ "2\\n";\n
924 /msx,
925 'l statement is working properly (test No. 1).',
926 );
927}
928
2c247e84
SF
929{
930 my $wrapper = DebugWrap->new(
931 {
932 cmds =>
933 [
934 'l',
935 q/# After l 1/,
936 'l',
937 q/# After l 2/,
938 '-',
939 q/# After -/,
940 'q',
941 ],
942 prog => '../lib/perl5db/t/test-l-statement-1',
943 }
944 );
945
946 my $first_l_out = qr/
947 1==>\s+\$x\ =\ 1;\n
948 2:\s+print\ "1\\n";\n
949 3\s*\n
950 4:\s+\$x\ =\ 2;\n
951 5:\s+print\ "2\\n";\n
952 6\s*\n
953 7:\s+\$x\ =\ 3;\n
954 8:\s+print\ "3\\n";\n
955 9\s*\n
956 10:\s+\$x\ =\ 4;\n
957 /msx;
958
959 my $second_l_out = qr/
960 11:\s+print\ "4\\n";\n
961 12\s*\n
962 13:\s+\$x\ =\ 5;\n
963 14:\s+print\ "5\\n";\n
964 15\s*\n
965 16:\s+\$x\ =\ 6;\n
966 17:\s+print\ "6\\n";\n
967 18\s*\n
968 19:\s+\$x\ =\ 7;\n
969 20:\s+print\ "7\\n";\n
970 /msx;
971 $wrapper->contents_like(
972 qr/
973 ^$first_l_out
974 [^\n]*?DB<\d+>\ \#\ After\ l\ 1\n
975 [\ \t]*\n
976 [^\n]*?DB<\d+>\ l\s*\n
977 $second_l_out
978 [^\n]*?DB<\d+>\ \#\ After\ l\ 2\n
979 [\ \t]*\n
980 [^\n]*?DB<\d+>\ -\s*\n
981 $first_l_out
982 [^\n]*?DB<\d+>\ \#\ After\ -\n
983 /msx,
984 'l followed by l and then followed by -',
985 );
986}
987
988{
989 my $wrapper = DebugWrap->new(
990 {
991 cmds =>
992 [
993 'l fact',
994 'q',
995 ],
996 prog => '../lib/perl5db/t/test-l-statement-2',
997 }
998 );
999
1000 my $first_l_out = qr/
1001 6\s+sub\ fact\ \{\n
1002 7:\s+my\ \$n\ =\ shift;\n
1003 8:\s+if\ \(\$n\ >\ 1\)\ \{\n
1004 9:\s+return\ \$n\ \*\ fact\(\$n\ -\ 1\);
1005 /msx;
1006
1007 $wrapper->contents_like(
1008 qr/
1009 DB<1>\s+l\ fact\n
1010 $first_l_out
1011 /msx,
1012 'l subroutine_name',
1013 );
1014}
1015
1016{
1017 my $wrapper = DebugWrap->new(
1018 {
1019 cmds =>
1020 [
1021 'b fact',
1022 'c',
1023 # Repeat several times to avoid @typeahead problems.
1024 '.',
1025 '.',
1026 '.',
1027 '.',
1028 'q',
1029 ],
1030 prog => '../lib/perl5db/t/test-l-statement-2',
1031 }
1032 );
1033
1034 my $line_out = qr /
1035 ^main::fact\([^\n]*?:7\):\n
1036 ^7:\s+my\ \$n\ =\ shift;\n
1037 /msx;
1038
1039 $wrapper->contents_like(
1040 qr/
1041 $line_out
1042 $line_out
1043 /msx,
1044 'Test the "." command',
1045 );
1046}
1047
1048# Testing that the f command works.
1049{
1050 my $wrapper = DebugWrap->new(
1051 {
1052 cmds =>
1053 [
1054 'f ../lib/perl5db/t/MyModule.pm',
1055 'b 12',
1056 'c',
1057 q/do { use IO::Handle; STDOUT->autoflush(1); print "Var=$var\n"; }/,
1058 'c',
1059 'q',
1060 ],
1061 include_t => 1,
1062 prog => '../lib/perl5db/t/filename-line-breakpoint'
1063 }
1064 );
1065
1066 $wrapper->output_like(qr/
1067 ^Var=Bar$
1068 .*
1069 ^In\ MyModule\.$
1070 .*
1071 ^In\ Main\ File\.$
1072 .*
1073 /msx,
1074 "f command is working.",
1075 );
1076}
1077
1078# We broke the /pattern/ command because apparently the CORE::eval-s inside
1079# lib/perl5db.pl cannot handle lexical variable properly. So we now fix this
1080# bug.
1081#
1082# TODO :
1083#
1084# 1. Go over the rest of the "eval"s in lib/perl5db.t and see if they cause
1085# problems.
1086{
1087 my $wrapper = DebugWrap->new(
1088 {
1089 cmds =>
1090 [
1091 '/for/',
1092 'q',
1093 ],
1094 prog => '../lib/perl5db/t/eval-line-bug',
1095 }
1096 );
1097
1098 $wrapper->contents_like(
1099 qr/12: \s* for\ my\ \$q\ \(1\ \.\.\ 10\)\ \{/msx,
1100 "/pat/ command is working and found a match.",
1101 );
1102}
1103
1104{
1105 my $wrapper = DebugWrap->new(
1106 {
1107 cmds =>
1108 [
1109 'b 22',
1110 'c',
1111 '?for?',
1112 'q',
1113 ],
1114 prog => '../lib/perl5db/t/eval-line-bug',
1115 }
1116 );
1117
1118 $wrapper->contents_like(
1119 qr/12: \s* for\ my\ \$q\ \(1\ \.\.\ 10\)\ \{/msx,
1120 "?pat? command is working and found a match.",
1121 );
1122}
1123
72d7d80d
SF
1124# Test the L command.
1125{
1126 my $wrapper = DebugWrap->new(
1127 {
1128 cmds =>
1129 [
1130 'b 6',
1131 'b 13 ($q == 5)',
1132 'L',
1133 'q',
1134 ],
1135 prog => '../lib/perl5db/t/eval-line-bug',
1136 }
1137 );
1138
1139 $wrapper->contents_like(
1140 qr#
1141 ^\S*?eval-line-bug:\n
1142 \s*6:\s*my\ \$i\ =\ 5;\n
1143 \s*break\ if\ \(1\)\n
1144 \s*13:\s*\$i\ \+=\ \$q;\n
1145 \s*break\ if\ \(\(\$q\ ==\ 5\)\)\n
1146 #msx,
1147 "L command is listing breakpoints",
1148 );
1149}
1150
1151# Test the L command for watch expressions.
1152{
1153 my $wrapper = DebugWrap->new(
1154 {
1155 cmds =>
1156 [
1157 'w (5+6)',
1158 'L',
1159 'q',
1160 ],
1161 prog => '../lib/perl5db/t/eval-line-bug',
1162 }
1163 );
1164
1165 $wrapper->contents_like(
1166 qr#
1167 ^Watch-expressions:\n
1168 \s*\(5\+6\)\n
1169 #msx,
1170 "L command is listing watch expressions",
1171 );
1172}
1173
1174{
1175 my $wrapper = DebugWrap->new(
1176 {
1177 cmds =>
1178 [
1179 'w (5+6)',
1180 'w (11*23)',
1181 'W (5+6)',
1182 'L',
1183 'q',
1184 ],
1185 prog => '../lib/perl5db/t/eval-line-bug',
1186 }
1187 );
1188
1189 $wrapper->contents_like(
1190 qr#
1191 ^Watch-expressions:\n
1192 \s*\(11\*23\)\n
1193 ^auto\(
1194 #msx,
1195 "L command is not listing deleted watch expressions",
1196 );
1197}
1198
1199# Test the L command.
1200{
1201 my $wrapper = DebugWrap->new(
1202 {
1203 cmds =>
1204 [
1205 'b 6',
1206 'a 13 print $i',
1207 'L',
1208 'q',
1209 ],
1210 prog => '../lib/perl5db/t/eval-line-bug',
1211 }
1212 );
1213
1214 $wrapper->contents_like(
1215 qr#
1216 ^\S*?eval-line-bug:\n
1217 \s*6:\s*my\ \$i\ =\ 5;\n
1218 \s*break\ if\ \(1\)\n
1219 \s*13:\s*\$i\ \+=\ \$q;\n
1220 \s*action:\s+print\ \$i\n
1221 #msx,
1222 "L command is listing actions and breakpoints",
1223 );
1224}
1225
1226{
1227 my $wrapper = DebugWrap->new(
1228 {
1229 cmds =>
1230 [
1231 'S',
1232 'q',
1233 ],
1234 prog => '../lib/perl5db/t/rt-104168',
1235 }
1236 );
1237
1238 $wrapper->contents_like(
1239 qr#
1240 ^main::bar\n
1241 main::baz\n
1242 main::foo\n
1243 #msx,
1244 "S command - 1",
1245 );
1246}
1247
1248{
1249 my $wrapper = DebugWrap->new(
1250 {
1251 cmds =>
1252 [
1253 'S ^main::ba',
1254 'q',
1255 ],
1256 prog => '../lib/perl5db/t/rt-104168',
1257 }
1258 );
1259
1260 $wrapper->contents_like(
1261 qr#
1262 ^main::bar\n
1263 main::baz\n
1264 auto\(
1265 #msx,
1266 "S command with regex",
1267 );
1268}
1269
1270{
1271 my $wrapper = DebugWrap->new(
1272 {
1273 cmds =>
1274 [
1275 'S !^main::ba',
1276 'q',
1277 ],
1278 prog => '../lib/perl5db/t/rt-104168',
1279 }
1280 );
1281
1282 $wrapper->contents_unlike(
1283 qr#
1284 ^main::ba
1285 #msx,
1286 "S command with negative regex",
1287 );
1288
1289 $wrapper->contents_like(
1290 qr#
1291 ^main::foo\n
1292 #msx,
1293 "S command with negative regex - what it still matches",
1294 );
1295}
1296
1297# Test the a command.
1298{
1299 my $wrapper = DebugWrap->new(
1300 {
1301 cmds =>
1302 [
1303 'a 13 print "\nVar<Q>=$q\n"',
1304 'c',
1305 'q',
1306 ],
1307 prog => '../lib/perl5db/t/eval-line-bug',
1308 }
1309 );
1310
1311 $wrapper->output_like(qr#
1312 \nVar<Q>=1\n
1313 \nVar<Q>=2\n
1314 \nVar<Q>=3\n
1315 #msx,
1316 "a command is working",
1317 );
1318}
1319
1320# Test the 'A' command
1321{
1322 my $wrapper = DebugWrap->new(
1323 {
1324 cmds =>
1325 [
1326 'a 13 print "\nVar<Q>=$q\n"',
1327 'A 13',
1328 'c',
1329 'q',
1330 ],
1331 prog => '../lib/perl5db/t/eval-line-bug',
1332 }
1333 );
1334
1335 $wrapper->output_like(
1336 qr#\A\z#msx, # The empty string.
1337 "A command (for removing actions) is working",
1338 );
1339}
1340
1341# Test the 'A *' command
1342{
1343 my $wrapper = DebugWrap->new(
1344 {
1345 cmds =>
1346 [
1347 'a 6 print "\nFail!\n"',
1348 'a 13 print "\nVar<Q>=$q\n"',
1349 'A *',
1350 'c',
1351 'q',
1352 ],
1353 prog => '../lib/perl5db/t/eval-line-bug',
1354 }
1355 );
1356
1357 $wrapper->output_like(
1358 qr#\A\z#msx, # The empty string.
1359 "'A *' command (for removing all actions) is working",
1360 );
1361}
1362
1363{
1364 my $wrapper = DebugWrap->new(
1365 {
1366 cmds =>
1367 [
1368 'n',
1369 'w $foo',
1370 'c',
1371 'print "\nIDX=<$idx>\n"',
1372 'q',
1373 ],
1374 prog => '../lib/perl5db/t/test-w-statement-1',
1375 }
1376 );
1377
1378
1379 $wrapper->contents_like(qr#
1380 \$foo\ changed:\n
1381 \s+old\ value:\s+'1'\n
1382 \s+new\ value:\s+'2'\n
1383 #msx,
1384 'w command - watchpoint changed',
1385 );
1386 $wrapper->output_like(qr#
1387 \nIDX=<20>\n
1388 #msx,
1389 "w command - correct output from IDX",
1390 );
1391}
1392
1393{
1394 my $wrapper = DebugWrap->new(
1395 {
1396 cmds =>
1397 [
1398 'n',
1399 'w $foo',
1400 'W $foo',
1401 'c',
1402 'print "\nIDX=<$idx>\n"',
1403 'q',
1404 ],
1405 prog => '../lib/perl5db/t/test-w-statement-1',
1406 }
1407 );
1408
1409 $wrapper->contents_unlike(qr#
1410 \$foo\ changed:
1411 #msx,
1412 'W command - watchpoint was deleted',
1413 );
1414
1415 $wrapper->output_like(qr#
1416 \nIDX=<>\n
1417 #msx,
1418 "W command - stopped at end.",
1419 );
1420}
1421
1422# Test the W * command.
1423{
1424 my $wrapper = DebugWrap->new(
1425 {
1426 cmds =>
1427 [
1428 'n',
1429 'w $foo',
1430 'w ($foo*$foo)',
1431 'W *',
1432 'c',
1433 'print "\nIDX=<$idx>\n"',
1434 'q',
1435 ],
1436 prog => '../lib/perl5db/t/test-w-statement-1',
1437 }
1438 );
1439
1440 $wrapper->contents_unlike(qr#
1441 \$foo\ changed:
1442 #msx,
1443 '"W *" command - watchpoint was deleted',
1444 );
1445
1446 $wrapper->output_like(qr#
1447 \nIDX=<>\n
1448 #msx,
1449 '"W *" command - stopped at end.',
1450 );
1451}
1452
1453# Test the 'o' command (without further arguments).
1454{
1455 my $wrapper = DebugWrap->new(
1456 {
1457 cmds =>
1458 [
1459 'o',
1460 'q',
1461 ],
1462 prog => '../lib/perl5db/t/test-w-statement-1',
1463 }
1464 );
1465
1466 $wrapper->contents_like(qr#
1467 ^\s*warnLevel\ =\ '1'\n
1468 #msx,
1469 q#"o" command (without arguments) displays warnLevel#,
1470 );
1471
1472 $wrapper->contents_like(qr#
1473 ^\s*signalLevel\ =\ '1'\n
1474 #msx,
1475 q#"o" command (without arguments) displays signalLevel#,
1476 );
1477
1478 $wrapper->contents_like(qr#
1479 ^\s*dieLevel\ =\ '1'\n
1480 #msx,
1481 q#"o" command (without arguments) displays dieLevel#,
1482 );
1483
1484 $wrapper->contents_like(qr#
1485 ^\s*hashDepth\ =\ 'N/A'\n
1486 #msx,
1487 q#"o" command (without arguments) displays hashDepth#,
1488 );
1489}
1490
1491# Test the 'o' query command.
1492{
1493 my $wrapper = DebugWrap->new(
1494 {
1495 cmds =>
1496 [
1497 'o hashDepth? signalLevel?',
1498 'q',
1499 ],
1500 prog => '../lib/perl5db/t/test-w-statement-1',
1501 }
1502 );
1503
1504 $wrapper->contents_unlike(qr#warnLevel#,
1505 q#"o" query command does not display warnLevel#,
1506 );
1507
1508 $wrapper->contents_like(qr#
1509 ^\s*signalLevel\ =\ '1'\n
1510 #msx,
1511 q#"o" query command displays signalLevel#,
1512 );
1513
1514 $wrapper->contents_unlike(qr#dieLevel#,
1515 q#"o" query command does not display dieLevel#,
1516 );
1517
1518 $wrapper->contents_like(qr#
1519 ^\s*hashDepth\ =\ 'N/A'\n
1520 #msx,
1521 q#"o" query command displays hashDepth#,
1522 );
1523}
1524
1525# Test the 'o' set command.
1526{
1527 my $wrapper = DebugWrap->new(
1528 {
1529 cmds =>
1530 [
1531 'o signalLevel=0',
1532 'o',
1533 'q',
1534 ],
1535 prog => '../lib/perl5db/t/test-w-statement-1',
1536 }
1537 );
1538
1539 $wrapper->contents_like(qr/
1540 ^\s*(signalLevel\ =\ '0'\n)
1541 .*?
1542 ^\s*\1
1543 /msx,
1544 q#o set command works#,
1545 );
1546
1547 $wrapper->contents_like(qr#
1548 ^\s*hashDepth\ =\ 'N/A'\n
1549 #msx,
1550 q#o set command - hashDepth#,
1551 );
1552}
1553
1554# Test the '<' and "< ?" commands.
1555{
1556 my $wrapper = DebugWrap->new(
1557 {
1558 cmds =>
1559 [
1560 q/< print "\nX=<$x>\n"/,
1561 q/b 7/,
1562 q/< ?/,
1563 'c',
1564 'q',
1565 ],
1566 prog => '../lib/perl5db/t/disable-breakpoints-1',
1567 }
1568 );
1569
1570 $wrapper->contents_like(qr/
1571 ^pre-perl\ commands:\n
1572 \s*<\ --\ print\ "\\nX=<\$x>\\n"\n
1573 /msx,
1574 q#Test < and < ? commands - contents.#,
1575 );
1576
1577 $wrapper->output_like(qr#
1578 ^X=<FirstVal>\n
1579 #msx,
1580 q#Test < and < ? commands - output.#,
1581 );
1582}
1583
1584# Test the '< *' command.
1585{
1586 my $wrapper = DebugWrap->new(
1587 {
1588 cmds =>
1589 [
1590 q/< print "\nX=<$x>\n"/,
1591 q/b 7/,
1592 q/< */,
1593 'c',
1594 'q',
1595 ],
1596 prog => '../lib/perl5db/t/disable-breakpoints-1',
1597 }
1598 );
1599
1600 $wrapper->output_unlike(qr/FirstVal/,
1601 q#Test the '< *' command.#,
1602 );
1603}
1604
1605# Test the '>' and "> ?" commands.
1606{
1607 my $wrapper = DebugWrap->new(
1608 {
1609 cmds =>
1610 [
1611 q/$::foo = 500;/,
1612 q/> print "\nFOO=<$::foo>\n"/,
1613 q/b 7/,
1614 q/> ?/,
1615 'c',
1616 'q',
1617 ],
1618 prog => '../lib/perl5db/t/disable-breakpoints-1',
1619 }
1620 );
1621
1622 $wrapper->contents_like(qr/
1623 ^post-perl\ commands:\n
1624 \s*>\ --\ print\ "\\nFOO=<\$::foo>\\n"\n
1625 /msx,
1626 q#Test > and > ? commands - contents.#,
1627 );
1628
1629 $wrapper->output_like(qr#
1630 ^FOO=<500>\n
1631 #msx,
1632 q#Test > and > ? commands - output.#,
1633 );
1634}
1635
1636# Test the '> *' command.
1637{
1638 my $wrapper = DebugWrap->new(
1639 {
1640 cmds =>
1641 [
1642 q/> print "\nFOO=<$::foo>\n"/,
1643 q/b 7/,
1644 q/> */,
1645 'c',
1646 'q',
1647 ],
1648 prog => '../lib/perl5db/t/disable-breakpoints-1',
1649 }
1650 );
1651
1652 $wrapper->output_unlike(qr/FOO=/,
1653 q#Test the '> *' command.#,
1654 );
1655}
1656
be1dfd82
SF
1657# Test the < and > commands together
1658{
1659 my $wrapper = DebugWrap->new(
1660 {
1661 cmds =>
1662 [
1663 q/$::lorem = 0;/,
1664 q/< $::lorem += 10;/,
1665 q/> print "\nLOREM=<$::lorem>\n"/,
1666 q/b 7/,
1667 q/b 5/,
1668 'c',
1669 'c',
1670 'q',
1671 ],
1672 prog => '../lib/perl5db/t/disable-breakpoints-1',
1673 }
1674 );
1675
1676 $wrapper->output_like(qr#
1677 ^LOREM=<10>\n
1678 #msx,
1679 q#Test < and > commands. #,
1680 );
1681}
1682
95418017
SF
1683# Test the { ? and { [command] commands.
1684{
1685 my $wrapper = DebugWrap->new(
1686 {
1687 cmds =>
1688 [
1e121f70
SF
1689 '{ ?',
1690 '{ l',
1691 '{ ?',
95418017
SF
1692 q/b 5/,
1693 q/c/,
1694 q/q/,
1695 ],
1696 prog => '../lib/perl5db/t/disable-breakpoints-1',
1697 }
1698 );
1699
1700 $wrapper->contents_like(qr#
1701 ^No\ pre-debugger\ actions\.\n
1702 .*?
1703 ^pre-debugger\ commands:\n
1704 \s+\{\ --\ l\n
1705 .*?
1706 ^5==>b\s+\$x\ =\ "FirstVal";\n
1707 6\s*\n
1708 7:\s+\$dummy\+\+;\n
1709 8\s*\n
1710 9:\s+\$x\ =\ "SecondVal";\n
1711
1712 #msx,
1713 'Test the pre-prompt debugger commands',
1714 );
1715}
1716
3743412c
SF
1717# Test the { * command.
1718{
1719 my $wrapper = DebugWrap->new(
1720 {
1721 cmds =>
1722 [
1723 '{ q',
1724 '{ *',
1725 q/b 5/,
1726 q/c/,
1727 q/print (("One" x 5), "\n");/,
1728 q/q/,
1729 ],
1730 prog => '../lib/perl5db/t/disable-breakpoints-1',
1731 }
1732 );
1733
1734 $wrapper->contents_like(qr#
1735 ^All\ \{\ actions\ cleared\.\n
1736 #msx,
1737 'Test the { * command',
1738 );
1739
1740 $wrapper->output_like(qr/OneOneOneOneOne/,
1741 '{ * test - output is OK.',
1742 );
1743}
1744
1896f514
SF
1745# Test the ! command.
1746{
1747 my $wrapper = DebugWrap->new(
1748 {
1749 cmds =>
1750 [
1751 'l 3-5',
1752 '!',
1753 'q',
1754 ],
1755 prog => '../lib/perl5db/t/disable-breakpoints-1',
1756 }
1757 );
1758
1759 $wrapper->contents_like(qr#
1760 (^3:\s+my\ \$dummy\ =\ 0;\n
1761 4\s*\n
1762 5:\s+\$x\ =\ "FirstVal";)\n
1763 .*?
1764 ^l\ 3-5\n
1765 \1
1766 #msx,
1767 'Test the ! command (along with l 3-5)',
1768 );
1769}
1770
ada05bfe
SF
1771# Test the ! -number command.
1772{
1773 my $wrapper = DebugWrap->new(
1774 {
1775 cmds =>
1776 [
1777 'l 3-5',
1778 'l 2',
1779 '! -1',
1780 'q',
1781 ],
1782 prog => '../lib/perl5db/t/disable-breakpoints-1',
1783 }
1784 );
1785
1786 $wrapper->contents_like(qr#
1787 (^3:\s+my\ \$dummy\ =\ 0;\n
1788 4\s*\n
1789 5:\s+\$x\ =\ "FirstVal";)\n
1790 .*?
1791 ^2==\>\s+my\ \$x\ =\ "One";\n
1792 .*?
1793 ^l\ 3-5\n
1794 \1
1795 #msx,
1796 'Test the ! -n command (along with l)',
1797 );
1798}
1799
635f2c9e 1800END {
4cfe45a1 1801 1 while unlink ($rc_filename, $out_fn);
635f2c9e 1802}