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