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