This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix for RT #118169
[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
e3d167f6 31plan(115);
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}
a7d38e67
KF
96# [ perl #116769] Frame=2
97{
98 local $ENV{PERLDB_OPTS} = "frame=2 nonstop";
99 my $output = runperl( switches => [ '-d' ], prog => 'print q{success}' );
100 is( $?, 0, '[perl #116769] frame=2 does not crash debugger, exit == 0' );
101 like( $output, 'success' , '[perl #116769] code is run' );
102}
ddd6e339
KF
103# [ perl #116771] autotrace
104{
105 local $ENV{PERLDB_OPTS} = "autotrace nonstop";
106 my $output = runperl( switches => [ '-d' ], prog => 'print q{success}' );
107 is( $?, 0, '[perl #116771] autotrace does not crash debugger, exit == 0' );
108 like( $output, 'success' , '[perl #116771] code is run' );
109}
b7bfa855 110
611272bb
PS
111{
112 rc(<<'EOF');
113&parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
114
115sub afterinit {
116 push (@DB::typeahead,
117 't 2',
118 'c',
119 'q',
120 );
121
122}
123EOF
611272bb
PS
124}
125
5e2fff4a
SF
126package DebugWrap;
127
128sub new {
129 my $class = shift;
130
131 my $self = bless {}, $class;
132
133 $self->_init(@_);
134
135 return $self;
136}
137
138sub _cmds {
139 my $self = shift;
140
141 if (@_) {
142 $self->{_cmds} = shift;
143 }
144
145 return $self->{_cmds};
146}
147
148sub _prog {
149 my $self = shift;
150
151 if (@_) {
152 $self->{_prog} = shift;
153 }
154
155 return $self->{_prog};
156}
157
158sub _output {
159 my $self = shift;
160
161 if (@_) {
162 $self->{_output} = shift;
163 }
164
165 return $self->{_output};
166}
167
168sub _include_t
2211a10b 169{
5e2fff4a 170 my $self = shift;
2211a10b 171
5e2fff4a
SF
172 if (@_)
173 {
174 $self->{_include_t} = shift;
175 }
2211a10b 176
5e2fff4a 177 return $self->{_include_t};
2211a10b 178}
2211a10b 179
e931e533
SF
180sub _stderr_val
181{
182 my $self = shift;
183
184 if (@_)
185 {
186 $self->{_stderr_val} = shift;
187 }
188
189 return $self->{_stderr_val};
190}
191
192sub field
193{
194 my $self = shift;
195
196 if (@_)
197 {
198 $self->{field} = shift;
199 }
200
201 return $self->{field};
202}
b16615d5
SF
203
204sub _switches
205{
206 my $self = shift;
207
208 if (@_)
209 {
210 $self->{_switches} = shift;
211 }
212
213 return $self->{_switches};
214}
215
5e2fff4a
SF
216sub _contents
217{
218 my $self = shift;
2211a10b 219
5e2fff4a
SF
220 if (@_)
221 {
222 $self->{_contents} = shift;
223 }
224
225 return $self->{_contents};
2211a10b
SF
226}
227
5e2fff4a
SF
228sub _init
229{
230 my ($self, $args) = @_;
4cfe45a1 231
5e2fff4a
SF
232 my $cmds = $args->{cmds};
233
234 if (ref($cmds) ne 'ARRAY') {
235 die "cmds must be an array of commands.";
236 }
237
238 $self->_cmds($cmds);
239
240 my $prog = $args->{prog};
241
242 if (ref($prog) ne '' or !defined($prog)) {
243 die "prog should be a path to a program file.";
244 }
245
246 $self->_prog($prog);
247
248 $self->_include_t($args->{include_t} ? 1 : 0);
249
e931e533
SF
250 $self->_stderr_val(exists($args->{stderr}) ? $args->{stderr} : 1);
251
b16615d5
SF
252 if (exists($args->{switches}))
253 {
254 $self->_switches($args->{switches});
255 }
256
5e2fff4a
SF
257 $self->_run();
258
259 return;
260}
261
262sub _quote
e09195af 263{
5e2fff4a 264 my ($self, $str) = @_;
e09195af 265
5e2fff4a
SF
266 $str =~ s/(["\@\$\\])/\\$1/g;
267 $str =~ s/\n/\\n/g;
268 $str =~ s/\r/\\r/g;
269
270 return qq{"$str"};
271}
272
273sub _run {
274 my $self = shift;
275
276 my $rc = qq{&parse_options("NonStop=0 TTY=db.out LineInfo=db.out");\n};
277
278 $rc .= join('',
279 map { "$_\n"}
280 (q#sub afterinit {#,
281 q#push (@DB::typeahead,#,
282 (map { $self->_quote($_) . "," } @{$self->_cmds()}),
283 q#);#,
284 q#}#,
285 )
e09195af
SF
286 );
287
5e2fff4a
SF
288 # I guess two objects like that cannot be used at the same time.
289 # Oh well.
290 ::rc($rc);
291
292 my $output =
293 ::runperl(
294 switches =>
295 [
b16615d5 296 ($self->_switches ? (@{$self->_switches()}) : ('-d')),
5e2fff4a
SF
297 ($self->_include_t ? ('-I', '../lib/perl5db/t') : ())
298 ],
e931e533
SF
299 (defined($self->_stderr_val())
300 ? (stderr => $self->_stderr_val())
301 : ()
302 ),
5e2fff4a
SF
303 progfile => $self->_prog()
304 );
305
306 $self->_output($output);
307
308 $self->_contents(::_out_contents());
309
310 return;
e09195af 311}
e09195af 312
20e060ce
SF
313sub get_output
314{
315 return shift->_output();
316}
317
5e2fff4a
SF
318sub output_like {
319 my ($self, $re, $msg) = @_;
320
321 local $::Level = $::Level + 1;
322 ::like($self->_output(), $re, $msg);
323}
324
72d7d80d
SF
325sub output_unlike {
326 my ($self, $re, $msg) = @_;
327
328 local $::Level = $::Level + 1;
329 ::unlike($self->_output(), $re, $msg);
330}
331
5e2fff4a
SF
332sub contents_like {
333 my ($self, $re, $msg) = @_;
334
335 local $::Level = $::Level + 1;
336 ::like($self->_contents(), $re, $msg);
337}
338
72d7d80d
SF
339sub contents_unlike {
340 my ($self, $re, $msg) = @_;
341
342 local $::Level = $::Level + 1;
343 ::unlike($self->_contents(), $re, $msg);
344}
345
5e2fff4a
SF
346package main;
347
708dd780
SF
348{
349 local $ENV{PERLDB_OPTS} = "ReadLine=0";
350 my $target = '../lib/perl5db/t/eval-line-bug';
351 my $wrapper = DebugWrap->new(
352 {
353 cmds =>
354 [
355 'b 23',
356 'n',
357 'n',
358 'n',
359 'c', # line 23
360 'n',
361 "p \@{'main::_<$target'}",
362 'q',
363 ],
364 prog => $target,
365 }
366 );
367 $wrapper->contents_like(
368 qr/sub factorial/,
369 'The ${main::_<filename} variable in the debugger was not destroyed',
370 );
371}
372
f0b5917d 373sub _calc_generic_wrapper
b2e270a3 374{
e931e533
SF
375 my $args = shift;
376
377 my $extra_opts = delete($args->{extra_opts});
5c976af9
SF
378 $extra_opts ||= '';
379 local $ENV{PERLDB_OPTS} = "ReadLine=0" . $extra_opts;
380 return DebugWrap->new(
b2e270a3 381 {
f0b5917d
SF
382 cmds => delete($args->{cmds}),
383 prog => delete($args->{prog}),
384 %$args,
385 }
386 );
387}
388
389sub _calc_new_var_wrapper
390{
391 my ($args) = @_;
392 return _calc_generic_wrapper(
393 {
b2e270a3
SF
394 cmds =>
395 [
396 'b 23',
e931e533 397 'c',
b2e270a3
SF
398 '$new_var = "Foo"',
399 'x "new_var = <$new_var>\\n"',
400 'q',
401 ],
e931e533 402 %$args,
b2e270a3
SF
403 }
404 );
5c976af9 405}
b2e270a3 406
12cb1cd2
SF
407sub _calc_threads_wrapper
408{
409 my $args = shift;
410
411 return _calc_new_var_wrapper(
412 {
413 switches => [ '-dt', ],
414 stderr => 1,
415 %$args
416 }
417 );
418}
419
5c976af9 420{
7cdb20ca 421 _calc_new_var_wrapper({ prog => '../lib/perl5db/t/eval-line-bug'})
5c976af9
SF
422 ->contents_like(
423 qr/new_var = <Foo>/,
424 "no strict 'vars' in evaluated lines.",
425 );
b2e270a3 426}
5c976af9 427
e931e533 428{
7cdb20ca 429 _calc_new_var_wrapper(
e931e533
SF
430 {
431 prog => '../lib/perl5db/t/lvalue-bug',
432 stderr => undef(),
433 },
434 )->output_like(
435 qr/foo is defined/,
436 'lvalue subs work in the debugger',
437 );
438}
439
8ebd940c 440{
7cdb20ca 441 _calc_new_var_wrapper(
8ebd940c
SF
442 {
443 prog => '../lib/perl5db/t/symbol-table-bug',
444 extra_opts => "NonStop=1",
445 stderr => undef(),
446 }
447 )->output_like(
448 qr/Undefined symbols 0/,
449 'there are no undefined values in the symbol table',
450 );
451}
452
b16615d5
SF
453SKIP:
454{
455 if ( $Config{usethreads} ) {
456 skip('This perl has threads, skipping non-threaded debugger tests');
457 }
458 else {
459 my $error = 'This Perl not built to support threads';
12cb1cd2 460 _calc_threads_wrapper(
b16615d5
SF
461 {
462 prog => '../lib/perl5db/t/eval-line-bug',
b16615d5
SF
463 }
464 )->output_like(
465 qr/\Q$error\E/,
466 'Perl debugger correctly complains that it was not built with threads',
467 );
468 }
469}
470
a9879eb8
SF
471SKIP:
472{
473 if ( $Config{usethreads} ) {
12cb1cd2 474 _calc_threads_wrapper(
a9879eb8
SF
475 {
476 prog => '../lib/perl5db/t/symbol-table-bug',
a9879eb8
SF
477 }
478 )->output_like(
479 qr/Undefined symbols 0/,
480 'there are no undefined values in the symbol table when running with thread support',
481 );
482 }
483 else {
484 skip("This perl is not threaded, skipping threaded debugger tests");
485 }
486}
487
31d5d77a
SF
488# Test [perl #61222]
489{
490 local $ENV{PERLDB_OPTS};
491 my $wrapper = DebugWrap->new(
492 {
493 cmds =>
494 [
495 'm Pie',
496 'q',
497 ],
498 prog => '../lib/perl5db/t/rt-61222',
499 }
500 );
501
502 $wrapper->contents_unlike(qr/INCORRECT/, "[perl #61222]");
503}
504
c698c518 505sub _calc_trace_wrapper
978684ed 506{
f0b5917d 507 my ($args) = @_;
978684ed 508
f0b5917d 509 return _calc_generic_wrapper(
978684ed
SF
510 {
511 cmds =>
512 [
513 't 2',
514 'c',
515 'q',
516 ],
978684ed
SF
517 %$args,
518 }
519 );
520}
521
522# [perl 104168] level option for tracing
523{
c698c518 524 my $wrapper = _calc_trace_wrapper({ prog => '../lib/perl5db/t/rt-104168' });
978684ed
SF
525 $wrapper->contents_like(qr/level 2/, "[perl #104168] - level 2 appears");
526 $wrapper->contents_unlike(qr/baz/, "[perl #104168] - no 'baz'");
527}
31d5d77a 528
20e060ce
SF
529# taint tests
530{
c698c518 531 my $wrapper = _calc_trace_wrapper(
20e060ce
SF
532 {
533 prog => '../lib/perl5db/t/taint',
534 extra_opts => ' NonStop=1',
535 switches => [ '-d', '-T', ],
536 }
537 );
538
539 my $output = $wrapper->get_output();
540 chomp $output if $^O eq 'VMS'; # newline guaranteed at EOF
541 is($output, '[$^X][done]', "taint");
542}
543
5e2fff4a
SF
544# Testing that we can set a line in the middle of the file.
545{
546 my $wrapper = DebugWrap->new(
547 {
548 cmds =>
549 [
550 'b ../lib/perl5db/t/MyModule.pm:12',
551 'c',
552 q/do { use IO::Handle; STDOUT->autoflush(1); print "Var=$var\n"; }/,
553 'c',
554 'q',
555 ],
556 include_t => 1,
557 prog => '../lib/perl5db/t/filename-line-breakpoint'
558 }
559 );
560
561 $wrapper->output_like(qr/
562 ^Var=Bar$
563 .*
564 ^In\ MyModule\.$
565 .*
566 ^In\ Main\ File\.$
567 .*
e09195af 568 /msx,
5e2fff4a 569 "Can set breakpoint in a line in the middle of the file.");
e09195af
SF
570}
571
5e2fff4a 572# Testing that we can set a breakpoint
e09195af 573{
5e2fff4a
SF
574 my $wrapper = DebugWrap->new(
575 {
576 prog => '../lib/perl5db/t/breakpoint-bug',
577 cmds =>
578 [
579 'b 6',
580 'c',
581 q/do { use IO::Handle; STDOUT->autoflush(1); print "X={$x}\n"; }/,
582 'c',
583 'q',
584 ],
585 },
586 );
e09195af 587
5e2fff4a
SF
588 $wrapper->output_like(
589 qr/X=\{Two\}/msx,
590 "Can set breakpoint in a line."
591 );
592}
593
594# Testing that we can disable a breakpoint at a numeric line.
595{
596 my $wrapper = DebugWrap->new(
597 {
598 prog => '../lib/perl5db/t/disable-breakpoints-1',
599 cmds =>
600 [
601 'b 7',
602 'b 11',
603 'disable 7',
604 'c',
605 q/print "X={$x}\n";/,
606 'c',
607 'q',
608 ],
609 }
e09195af 610 );
b7bfa855 611
5e2fff4a
SF
612 $wrapper->output_like(qr/X=\{SecondVal\}/ms,
613 "Can set breakpoint in a line.");
e09195af 614}
e09195af 615
5e2fff4a
SF
616# Testing that we can re-enable a breakpoint at a numeric line.
617{
618 my $wrapper = DebugWrap->new(
619 {
620 prog => '../lib/perl5db/t/disable-breakpoints-2',
621 cmds =>
622 [
623 'b 8',
624 'b 24',
625 'disable 24',
626 'c',
627 'enable 24',
628 'c',
629 q/print "X={$x}\n";/,
630 'c',
631 'q',
632 ],
633 },
634 );
635
636 $wrapper->output_like(
637 qr/
e09195af
SF
638 X=\{SecondValOneHundred\}
639 /msx,
5e2fff4a
SF
640 "Can set breakpoint in a line."
641 );
e09195af 642}
635f2c9e
RGS
643# clean up.
644
e09195af
SF
645# Disable and enable for breakpoints on outer files.
646{
5e2fff4a
SF
647 my $wrapper = DebugWrap->new(
648 {
649 cmds =>
650 [
651 'b 10',
652 'b ../lib/perl5db/t/EnableModule.pm:14',
653 'disable ../lib/perl5db/t/EnableModule.pm:14',
654 'c',
655 'enable ../lib/perl5db/t/EnableModule.pm:14',
656 'c',
657 q/print "X={$x}\n";/,
658 'c',
659 'q',
660 ],
661 prog => '../lib/perl5db/t/disable-breakpoints-3',
662 include_t => 1,
663 }
e09195af
SF
664 );
665
5e2fff4a 666 $wrapper->output_like(qr/
e09195af
SF
667 X=\{SecondValTwoHundred\}
668 /msx,
669 "Can set breakpoint in a line.");
670}
bdba49ad
SF
671
672# Testing that the prompt with the information appears.
673{
5e2fff4a
SF
674 my $wrapper = DebugWrap->new(
675 {
676 cmds => ['q'],
677 prog => '../lib/perl5db/t/disable-breakpoints-1',
678 }
bdba49ad
SF
679 );
680
5e2fff4a 681 $wrapper->contents_like(qr/
bdba49ad
SF
682 ^main::\([^\)]*\bdisable-breakpoints-1:2\):\n
683 2:\s+my\ \$x\ =\ "One";\n
684 /msx,
685 "Prompt should display the first line of code.");
686}
687
688# Testing that R (restart) and "B *" work.
689{
5e2fff4a
SF
690 my $wrapper = DebugWrap->new(
691 {
692 cmds =>
693 [
694 'b 13',
695 'c',
696 'B *',
697 'b 9',
698 'R',
699 'c',
700 q/print "X={$x};dummy={$dummy}\n";/,
701 'q',
702 ],
703 prog => '../lib/perl5db/t/disable-breakpoints-1',
704 }
bdba49ad
SF
705 );
706
5e2fff4a 707 $wrapper->output_like(qr/
bdba49ad
SF
708 X=\{FirstVal\};dummy=\{1\}
709 /msx,
710 "Restart and delete all breakpoints work properly.");
711}
712
5d5d9ea3 713{
5e2fff4a
SF
714 my $wrapper = DebugWrap->new(
715 {
716 cmds =>
717 [
718 'c 15',
719 q/print "X={$x}\n";/,
720 'c',
721 'q',
722 ],
723 prog => '../lib/perl5db/t/disable-breakpoints-1',
724 }
5d5d9ea3
SF
725 );
726
5e2fff4a 727 $wrapper->output_like(qr/
5d5d9ea3
SF
728 X=\{ThirdVal\}
729 /msx,
730 "'c line_num' is working properly.");
731}
732
5343a617 733{
5e2fff4a
SF
734 my $wrapper = DebugWrap->new(
735 {
736 cmds =>
737 [
738 'n',
739 'n',
740 'b . $exp > 200',
741 'c',
742 q/print "Exp={$exp}\n";/,
743 'q',
744 ],
745 prog => '../lib/perl5db/t/break-on-dot',
746 }
5343a617 747 );
5343a617 748
5e2fff4a 749 $wrapper->output_like(qr/
5343a617
SF
750 Exp=\{256\}
751 /msx,
752 "'b .' is working correctly.");
753}
754
8dc67a69
SF
755# Testing that the prompt with the information appears inside a subroutine call.
756# See https://rt.perl.org/rt3/Ticket/Display.html?id=104820
757{
5e2fff4a
SF
758 my $wrapper = DebugWrap->new(
759 {
760 cmds =>
761 [
762 'c back',
763 'q',
764 ],
765 prog => '../lib/perl5db/t/with-subroutine',
766 }
8dc67a69 767 );
8dc67a69 768
5e2fff4a 769 $wrapper->contents_like(
8dc67a69
SF
770 qr/
771 ^main::back\([^\)\n]*\bwith-subroutine:15\):[\ \t]*\n
772 ^15:\s*print\ "hello\ back\\n";
773 /msx,
774 "Prompt should display the line of code inside a subroutine.");
775}
776
984e0ec4
SF
777# Checking that the p command works.
778{
5e2fff4a
SF
779 my $wrapper = DebugWrap->new(
780 {
781 cmds =>
782 [
783 'p "<<<" . (4*6) . ">>>"',
784 'q',
785 ],
786 prog => '../lib/perl5db/t/with-subroutine',
787 }
984e0ec4
SF
788 );
789
5e2fff4a 790 $wrapper->contents_like(
984e0ec4
SF
791 qr/<<<24>>>/,
792 "p command works.");
793}
794
9f810cd7
SF
795# Tests for x.
796{
5e2fff4a
SF
797 my $wrapper = DebugWrap->new(
798 {
799 cmds =>
800 [
801 q/x {500 => 600}/,
802 'q',
803 ],
804 prog => '../lib/perl5db/t/with-subroutine',
805 }
9f810cd7
SF
806 );
807
5e2fff4a 808 $wrapper->contents_like(
9f810cd7
SF
809 # qr/^0\s+HASH\([^\)]+\)\n\s+500 => 600\n/,
810 qr/^0\s+HASH\([^\)]+\)\n\s+500 => 600\n/ms,
811 "x command test."
812 );
813}
814
e3d167f6
SF
815# Tests for x with @_
816{
817 my $wrapper = DebugWrap->new(
818 {
819 cmds =>
820 [
821 'b 10',
822 'c',
823 'x @_',
824 'q',
825 ],
826 prog => '../lib/perl5db/t/test-passing-at-underscore-to-x-etc',
827 }
828 );
829
830 $wrapper->contents_like(
831 # qr/^0\s+HASH\([^\)]+\)\n\s+500 => 600\n/,
832 qr/Arg1.*?Capsula.*GreekHumor.*Socrates/ms,
833 q/x command test with '@_'./,
834 );
835}
836
50acbf3b
SF
837# Tests for x with AutoTrace=1.
838{
839 my $wrapper = DebugWrap->new(
840 {
841 cmds =>
842 [
843 'n',
844 'o AutoTrace=1',
845 # So it may fail.
846 q/x "failure"/,
847 q/x \$x/,
848 'q',
849 ],
850 prog => '../lib/perl5db/t/with-subroutine',
851 }
852 );
853
854 $wrapper->contents_like(
855 # qr/^0\s+HASH\([^\)]+\)\n\s+500 => 600\n/,
517cdf98 856 qr/^0\s+SCALAR\([^\)]+\)\n\s+-> 'hello world'\n/ms,
50acbf3b
SF
857 "x after AutoTrace=1 command is working."
858 );
859}
860
5bc17875
SF
861# Tests for "T" (stack trace).
862{
5bc17875 863 my $prog_fn = '../lib/perl5db/t/rt-104168';
5e2fff4a
SF
864 my $wrapper = DebugWrap->new(
865 {
866 prog => $prog_fn,
867 cmds =>
868 [
869 'c baz',
870 'T',
871 'q',
872 ],
873 }
874 );
5bc17875
SF
875 my $re_text = join('',
876 map {
877 sprintf(
878 "%s = %s\\(\\) called from file " .
879 "'" . quotemeta($prog_fn) . "' line %s\\n",
880 (map { quotemeta($_) } @$_)
881 )
2c247e84 882 }
5bc17875
SF
883 (
884 ['.', 'main::baz', 14,],
885 ['.', 'main::bar', 9,],
2c247e84 886 ['.', 'main::foo', 6],
5bc17875
SF
887 )
888 );
5e2fff4a 889 $wrapper->contents_like(
5bc17875
SF
890 # qr/^0\s+HASH\([^\)]+\)\n\s+500 => 600\n/,
891 qr/^$re_text/ms,
892 "T command test."
893 );
894}
8fe891f1
SF
895
896# Test for s.
897{
5e2fff4a
SF
898 my $wrapper = DebugWrap->new(
899 {
900 cmds =>
901 [
902 'b 9',
903 'c',
904 's',
905 q/print "X={$x};dummy={$dummy}\n";/,
906 'q',
907 ],
908 prog => '../lib/perl5db/t/disable-breakpoints-1'
909 }
8fe891f1
SF
910 );
911
5e2fff4a 912 $wrapper->output_like(qr/
8fe891f1
SF
913 X=\{SecondVal\};dummy=\{1\}
914 /msx,
915 'test for s - single step',
916 );
917}
918
65ab0314 919{
5e2fff4a
SF
920 my $wrapper = DebugWrap->new(
921 {
922 cmds =>
923 [
924 'n',
925 'n',
926 'b . $exp > 200',
927 'c',
928 q/print "Exp={$exp}\n";/,
929 'q',
930 ],
931 prog => '../lib/perl5db/t/break-on-dot'
932 }
65ab0314
SF
933 );
934
5e2fff4a 935 $wrapper->output_like(qr/
65ab0314
SF
936 Exp=\{256\}
937 /msx,
938 "'b .' is working correctly.");
939}
940
941{
65ab0314 942 my $prog_fn = '../lib/perl5db/t/rt-104168';
5e2fff4a
SF
943 my $wrapper = DebugWrap->new(
944 {
945 cmds =>
946 [
947 's',
948 'q',
949 ],
950 prog => $prog_fn,
951 }
952 );
65ab0314 953
5e2fff4a 954 $wrapper->contents_like(
65ab0314
SF
955 qr/
956 ^main::foo\([^\)\n]*\brt-104168:9\):[\ \t]*\n
957 ^9:\s*bar\(\);
958 /msx,
959 'Test for the s command.',
960 );
961}
962
5d83cde2 963{
5e2fff4a
SF
964 my $wrapper = DebugWrap->new(
965 {
966 cmds =>
967 [
968 's uncalled_subroutine()',
969 'c',
970 'q',
971 ],
5d83cde2 972
5e2fff4a 973 prog => '../lib/perl5db/t/uncalled-subroutine'}
5d83cde2
SF
974 );
975
5e2fff4a 976 $wrapper->output_like(
5d83cde2
SF
977 qr/<1,2,3,4,5>\n/,
978 'uncalled_subroutine was called after s EXPR()',
979 );
5d83cde2
SF
980}
981
d7b8b95b 982{
5e2fff4a
SF
983 my $wrapper = DebugWrap->new(
984 {
985 cmds =>
986 [
987 'n uncalled_subroutine()',
988 'c',
989 'q',
990 ],
991 prog => '../lib/perl5db/t/uncalled-subroutine',
992 }
d7b8b95b
SF
993 );
994
5e2fff4a 995 $wrapper->output_like(
d7b8b95b
SF
996 qr/<1,2,3,4,5>\n/,
997 'uncalled_subroutine was called after n EXPR()',
998 );
d7b8b95b
SF
999}
1000
ea7bdd87
VP
1001{
1002 my $wrapper = DebugWrap->new(
1003 {
1004 cmds =>
1005 [
1006 'b fact',
1007 'c',
1008 'c',
1009 'c',
1010 'n',
1011 'print "<$n>"',
1012 'q',
1013 ],
1014 prog => '../lib/perl5db/t/fact',
1015 }
1016 );
1017
1018 $wrapper->output_like(
1019 qr/<3>/,
1020 'b subroutine works fine',
1021 );
1022}
1023
f311474d
VP
1024# Test for 'M' (module list).
1025{
1026 my $wrapper = DebugWrap->new(
1027 {
1028 cmds =>
1029 [
1030 'M',
1031 'q',
1032 ],
1033 prog => '../lib/perl5db/t/load-modules'
1034 }
1035 );
1036
1037 $wrapper->contents_like(
1038 qr[Scalar/Util\.pm],
1039 'M (module list) works fine',
1040 );
1041}
1042
55783941
SF
1043{
1044 my $wrapper = DebugWrap->new(
1045 {
1046 cmds =>
1047 [
1048 'b 14',
1049 'c',
1050 '$flag = 1;',
1051 'r',
1052 'print "Var=$var\n";',
1053 'q',
1054 ],
1055 prog => '../lib/perl5db/t/test-r-statement',
1056 }
1057 );
1058
1059 $wrapper->output_like(
1060 qr/
1061 ^Foo$
1062 .*?
1063 ^Bar$
1064 .*?
1065 ^Var=Test$
1066 /msx,
1067 'r statement is working properly.',
1068 );
1069}
1070
1071{
1072 my $wrapper = DebugWrap->new(
1073 {
1074 cmds =>
1075 [
1076 'l',
1077 'q',
1078 ],
1079 prog => '../lib/perl5db/t/test-l-statement-1',
1080 }
1081 );
1082
1083 $wrapper->contents_like(
1084 qr/
1085 ^1==>\s+\$x\ =\ 1;\n
1086 2:\s+print\ "1\\n";\n
1087 3\s*\n
1088 4:\s+\$x\ =\ 2;\n
1089 5:\s+print\ "2\\n";\n
1090 /msx,
1091 'l statement is working properly (test No. 1).',
1092 );
1093}
1094
2c247e84
SF
1095{
1096 my $wrapper = DebugWrap->new(
1097 {
1098 cmds =>
1099 [
1100 'l',
1101 q/# After l 1/,
1102 'l',
1103 q/# After l 2/,
1104 '-',
1105 q/# After -/,
1106 'q',
1107 ],
1108 prog => '../lib/perl5db/t/test-l-statement-1',
1109 }
1110 );
1111
1112 my $first_l_out = qr/
1113 1==>\s+\$x\ =\ 1;\n
1114 2:\s+print\ "1\\n";\n
1115 3\s*\n
1116 4:\s+\$x\ =\ 2;\n
1117 5:\s+print\ "2\\n";\n
1118 6\s*\n
1119 7:\s+\$x\ =\ 3;\n
1120 8:\s+print\ "3\\n";\n
1121 9\s*\n
1122 10:\s+\$x\ =\ 4;\n
1123 /msx;
1124
1125 my $second_l_out = qr/
1126 11:\s+print\ "4\\n";\n
1127 12\s*\n
1128 13:\s+\$x\ =\ 5;\n
1129 14:\s+print\ "5\\n";\n
1130 15\s*\n
1131 16:\s+\$x\ =\ 6;\n
1132 17:\s+print\ "6\\n";\n
1133 18\s*\n
1134 19:\s+\$x\ =\ 7;\n
1135 20:\s+print\ "7\\n";\n
1136 /msx;
1137 $wrapper->contents_like(
1138 qr/
1139 ^$first_l_out
1140 [^\n]*?DB<\d+>\ \#\ After\ l\ 1\n
1141 [\ \t]*\n
1142 [^\n]*?DB<\d+>\ l\s*\n
1143 $second_l_out
1144 [^\n]*?DB<\d+>\ \#\ After\ l\ 2\n
1145 [\ \t]*\n
1146 [^\n]*?DB<\d+>\ -\s*\n
1147 $first_l_out
1148 [^\n]*?DB<\d+>\ \#\ After\ -\n
1149 /msx,
1150 'l followed by l and then followed by -',
1151 );
1152}
1153
1154{
1155 my $wrapper = DebugWrap->new(
1156 {
1157 cmds =>
1158 [
1159 'l fact',
1160 'q',
1161 ],
1162 prog => '../lib/perl5db/t/test-l-statement-2',
1163 }
1164 );
1165
1166 my $first_l_out = qr/
1167 6\s+sub\ fact\ \{\n
1168 7:\s+my\ \$n\ =\ shift;\n
1169 8:\s+if\ \(\$n\ >\ 1\)\ \{\n
1170 9:\s+return\ \$n\ \*\ fact\(\$n\ -\ 1\);
1171 /msx;
1172
1173 $wrapper->contents_like(
1174 qr/
1175 DB<1>\s+l\ fact\n
1176 $first_l_out
1177 /msx,
1178 'l subroutine_name',
1179 );
1180}
1181
1182{
1183 my $wrapper = DebugWrap->new(
1184 {
1185 cmds =>
1186 [
1187 'b fact',
1188 'c',
1189 # Repeat several times to avoid @typeahead problems.
1190 '.',
1191 '.',
1192 '.',
1193 '.',
1194 'q',
1195 ],
1196 prog => '../lib/perl5db/t/test-l-statement-2',
1197 }
1198 );
1199
1200 my $line_out = qr /
1201 ^main::fact\([^\n]*?:7\):\n
1202 ^7:\s+my\ \$n\ =\ shift;\n
1203 /msx;
1204
1205 $wrapper->contents_like(
1206 qr/
1207 $line_out
1208 $line_out
1209 /msx,
1210 'Test the "." command',
1211 );
1212}
1213
1214# Testing that the f command works.
1215{
1216 my $wrapper = DebugWrap->new(
1217 {
1218 cmds =>
1219 [
1220 'f ../lib/perl5db/t/MyModule.pm',
1221 'b 12',
1222 'c',
1223 q/do { use IO::Handle; STDOUT->autoflush(1); print "Var=$var\n"; }/,
1224 'c',
1225 'q',
1226 ],
1227 include_t => 1,
1228 prog => '../lib/perl5db/t/filename-line-breakpoint'
1229 }
1230 );
1231
1232 $wrapper->output_like(qr/
1233 ^Var=Bar$
1234 .*
1235 ^In\ MyModule\.$
1236 .*
1237 ^In\ Main\ File\.$
1238 .*
1239 /msx,
1240 "f command is working.",
1241 );
1242}
1243
1244# We broke the /pattern/ command because apparently the CORE::eval-s inside
1245# lib/perl5db.pl cannot handle lexical variable properly. So we now fix this
1246# bug.
1247#
1248# TODO :
1249#
1250# 1. Go over the rest of the "eval"s in lib/perl5db.t and see if they cause
1251# problems.
1252{
1253 my $wrapper = DebugWrap->new(
1254 {
1255 cmds =>
1256 [
1257 '/for/',
1258 'q',
1259 ],
1260 prog => '../lib/perl5db/t/eval-line-bug',
1261 }
1262 );
1263
1264 $wrapper->contents_like(
1265 qr/12: \s* for\ my\ \$q\ \(1\ \.\.\ 10\)\ \{/msx,
1266 "/pat/ command is working and found a match.",
1267 );
1268}
1269
1270{
1271 my $wrapper = DebugWrap->new(
1272 {
1273 cmds =>
1274 [
1275 'b 22',
1276 'c',
1277 '?for?',
1278 'q',
1279 ],
1280 prog => '../lib/perl5db/t/eval-line-bug',
1281 }
1282 );
1283
1284 $wrapper->contents_like(
1285 qr/12: \s* for\ my\ \$q\ \(1\ \.\.\ 10\)\ \{/msx,
1286 "?pat? command is working and found a match.",
1287 );
1288}
1289
72d7d80d
SF
1290# Test the L command.
1291{
1292 my $wrapper = DebugWrap->new(
1293 {
1294 cmds =>
1295 [
1296 'b 6',
1297 'b 13 ($q == 5)',
1298 'L',
1299 'q',
1300 ],
1301 prog => '../lib/perl5db/t/eval-line-bug',
1302 }
1303 );
1304
1305 $wrapper->contents_like(
1306 qr#
1307 ^\S*?eval-line-bug:\n
1308 \s*6:\s*my\ \$i\ =\ 5;\n
1309 \s*break\ if\ \(1\)\n
1310 \s*13:\s*\$i\ \+=\ \$q;\n
1311 \s*break\ if\ \(\(\$q\ ==\ 5\)\)\n
1312 #msx,
1313 "L command is listing breakpoints",
1314 );
1315}
1316
1317# Test the L command for watch expressions.
1318{
1319 my $wrapper = DebugWrap->new(
1320 {
1321 cmds =>
1322 [
1323 'w (5+6)',
1324 'L',
1325 'q',
1326 ],
1327 prog => '../lib/perl5db/t/eval-line-bug',
1328 }
1329 );
1330
1331 $wrapper->contents_like(
1332 qr#
1333 ^Watch-expressions:\n
1334 \s*\(5\+6\)\n
1335 #msx,
1336 "L command is listing watch expressions",
1337 );
1338}
1339
1340{
1341 my $wrapper = DebugWrap->new(
1342 {
1343 cmds =>
1344 [
1345 'w (5+6)',
1346 'w (11*23)',
1347 'W (5+6)',
1348 'L',
1349 'q',
1350 ],
1351 prog => '../lib/perl5db/t/eval-line-bug',
1352 }
1353 );
1354
1355 $wrapper->contents_like(
1356 qr#
1357 ^Watch-expressions:\n
1358 \s*\(11\*23\)\n
1359 ^auto\(
1360 #msx,
1361 "L command is not listing deleted watch expressions",
1362 );
1363}
1364
1365# Test the L command.
1366{
1367 my $wrapper = DebugWrap->new(
1368 {
1369 cmds =>
1370 [
1371 'b 6',
1372 'a 13 print $i',
1373 'L',
1374 'q',
1375 ],
1376 prog => '../lib/perl5db/t/eval-line-bug',
1377 }
1378 );
1379
1380 $wrapper->contents_like(
1381 qr#
1382 ^\S*?eval-line-bug:\n
1383 \s*6:\s*my\ \$i\ =\ 5;\n
1384 \s*break\ if\ \(1\)\n
1385 \s*13:\s*\$i\ \+=\ \$q;\n
1386 \s*action:\s+print\ \$i\n
1387 #msx,
1388 "L command is listing actions and breakpoints",
1389 );
1390}
1391
1392{
1393 my $wrapper = DebugWrap->new(
1394 {
1395 cmds =>
1396 [
1397 'S',
1398 'q',
1399 ],
1400 prog => '../lib/perl5db/t/rt-104168',
1401 }
1402 );
1403
1404 $wrapper->contents_like(
1405 qr#
1406 ^main::bar\n
1407 main::baz\n
1408 main::foo\n
1409 #msx,
1410 "S command - 1",
1411 );
1412}
1413
1414{
1415 my $wrapper = DebugWrap->new(
1416 {
1417 cmds =>
1418 [
1419 'S ^main::ba',
1420 'q',
1421 ],
1422 prog => '../lib/perl5db/t/rt-104168',
1423 }
1424 );
1425
1426 $wrapper->contents_like(
1427 qr#
1428 ^main::bar\n
1429 main::baz\n
1430 auto\(
1431 #msx,
1432 "S command with regex",
1433 );
1434}
1435
1436{
1437 my $wrapper = DebugWrap->new(
1438 {
1439 cmds =>
1440 [
1441 'S !^main::ba',
1442 'q',
1443 ],
1444 prog => '../lib/perl5db/t/rt-104168',
1445 }
1446 );
1447
1448 $wrapper->contents_unlike(
1449 qr#
1450 ^main::ba
1451 #msx,
1452 "S command with negative regex",
1453 );
1454
1455 $wrapper->contents_like(
1456 qr#
1457 ^main::foo\n
1458 #msx,
1459 "S command with negative regex - what it still matches",
1460 );
1461}
1462
f4beae36 1463# Test the 'a' command.
72d7d80d
SF
1464{
1465 my $wrapper = DebugWrap->new(
1466 {
1467 cmds =>
1468 [
1469 'a 13 print "\nVar<Q>=$q\n"',
1470 'c',
1471 'q',
1472 ],
1473 prog => '../lib/perl5db/t/eval-line-bug',
1474 }
1475 );
1476
1477 $wrapper->output_like(qr#
1478 \nVar<Q>=1\n
1479 \nVar<Q>=2\n
1480 \nVar<Q>=3\n
1481 #msx,
1482 "a command is working",
1483 );
1484}
1485
f4beae36
SF
1486# Test the 'a' command with no line number.
1487{
1488 my $wrapper = DebugWrap->new(
1489 {
1490 cmds =>
1491 [
1492 'n',
1493 q/a print "Hello " . (3 * 4) . "\n";/,
1494 'c',
1495 'q',
1496 ],
1497 prog => '../lib/perl5db/t/test-a-statement-1',
1498 }
1499 );
1500
1501 $wrapper->output_like(qr#
1502 (?:^Hello\ 12\n.*?){4}
1503 #msx,
1504 "a command with no line number is working",
1505 );
1506}
1507
72d7d80d
SF
1508# Test the 'A' command
1509{
1510 my $wrapper = DebugWrap->new(
1511 {
1512 cmds =>
1513 [
1514 'a 13 print "\nVar<Q>=$q\n"',
1515 'A 13',
1516 'c',
1517 'q',
1518 ],
1519 prog => '../lib/perl5db/t/eval-line-bug',
1520 }
1521 );
1522
1523 $wrapper->output_like(
1524 qr#\A\z#msx, # The empty string.
1525 "A command (for removing actions) is working",
1526 );
1527}
1528
1529# Test the 'A *' command
1530{
1531 my $wrapper = DebugWrap->new(
1532 {
1533 cmds =>
1534 [
1535 'a 6 print "\nFail!\n"',
1536 'a 13 print "\nVar<Q>=$q\n"',
1537 'A *',
1538 'c',
1539 'q',
1540 ],
1541 prog => '../lib/perl5db/t/eval-line-bug',
1542 }
1543 );
1544
1545 $wrapper->output_like(
1546 qr#\A\z#msx, # The empty string.
1547 "'A *' command (for removing all actions) is working",
1548 );
1549}
1550
1551{
1552 my $wrapper = DebugWrap->new(
1553 {
1554 cmds =>
1555 [
1556 'n',
1557 'w $foo',
1558 'c',
1559 'print "\nIDX=<$idx>\n"',
1560 'q',
1561 ],
1562 prog => '../lib/perl5db/t/test-w-statement-1',
1563 }
1564 );
1565
1566
1567 $wrapper->contents_like(qr#
1568 \$foo\ changed:\n
1569 \s+old\ value:\s+'1'\n
1570 \s+new\ value:\s+'2'\n
1571 #msx,
1572 'w command - watchpoint changed',
1573 );
1574 $wrapper->output_like(qr#
1575 \nIDX=<20>\n
1576 #msx,
1577 "w command - correct output from IDX",
1578 );
1579}
1580
1581{
1582 my $wrapper = DebugWrap->new(
1583 {
1584 cmds =>
1585 [
1586 'n',
1587 'w $foo',
1588 'W $foo',
1589 'c',
1590 'print "\nIDX=<$idx>\n"',
1591 'q',
1592 ],
1593 prog => '../lib/perl5db/t/test-w-statement-1',
1594 }
1595 );
1596
1597 $wrapper->contents_unlike(qr#
1598 \$foo\ changed:
1599 #msx,
1600 'W command - watchpoint was deleted',
1601 );
1602
1603 $wrapper->output_like(qr#
1604 \nIDX=<>\n
1605 #msx,
1606 "W command - stopped at end.",
1607 );
1608}
1609
1610# Test the W * command.
1611{
1612 my $wrapper = DebugWrap->new(
1613 {
1614 cmds =>
1615 [
1616 'n',
1617 'w $foo',
1618 'w ($foo*$foo)',
1619 'W *',
1620 'c',
1621 'print "\nIDX=<$idx>\n"',
1622 'q',
1623 ],
1624 prog => '../lib/perl5db/t/test-w-statement-1',
1625 }
1626 );
1627
1628 $wrapper->contents_unlike(qr#
1629 \$foo\ changed:
1630 #msx,
1631 '"W *" command - watchpoint was deleted',
1632 );
1633
1634 $wrapper->output_like(qr#
1635 \nIDX=<>\n
1636 #msx,
1637 '"W *" command - stopped at end.',
1638 );
1639}
1640
1641# Test the 'o' command (without further arguments).
1642{
1643 my $wrapper = DebugWrap->new(
1644 {
1645 cmds =>
1646 [
1647 'o',
1648 'q',
1649 ],
1650 prog => '../lib/perl5db/t/test-w-statement-1',
1651 }
1652 );
1653
1654 $wrapper->contents_like(qr#
1655 ^\s*warnLevel\ =\ '1'\n
1656 #msx,
1657 q#"o" command (without arguments) displays warnLevel#,
1658 );
1659
1660 $wrapper->contents_like(qr#
1661 ^\s*signalLevel\ =\ '1'\n
1662 #msx,
1663 q#"o" command (without arguments) displays signalLevel#,
1664 );
1665
1666 $wrapper->contents_like(qr#
1667 ^\s*dieLevel\ =\ '1'\n
1668 #msx,
1669 q#"o" command (without arguments) displays dieLevel#,
1670 );
1671
1672 $wrapper->contents_like(qr#
1673 ^\s*hashDepth\ =\ 'N/A'\n
1674 #msx,
1675 q#"o" command (without arguments) displays hashDepth#,
1676 );
1677}
1678
1679# Test the 'o' query command.
1680{
1681 my $wrapper = DebugWrap->new(
1682 {
1683 cmds =>
1684 [
1685 'o hashDepth? signalLevel?',
1686 'q',
1687 ],
1688 prog => '../lib/perl5db/t/test-w-statement-1',
1689 }
1690 );
1691
1692 $wrapper->contents_unlike(qr#warnLevel#,
1693 q#"o" query command does not display warnLevel#,
1694 );
1695
1696 $wrapper->contents_like(qr#
1697 ^\s*signalLevel\ =\ '1'\n
1698 #msx,
1699 q#"o" query command displays signalLevel#,
1700 );
1701
1702 $wrapper->contents_unlike(qr#dieLevel#,
1703 q#"o" query command does not display dieLevel#,
1704 );
1705
1706 $wrapper->contents_like(qr#
1707 ^\s*hashDepth\ =\ 'N/A'\n
1708 #msx,
1709 q#"o" query command displays hashDepth#,
1710 );
1711}
1712
1713# Test the 'o' set command.
1714{
1715 my $wrapper = DebugWrap->new(
1716 {
1717 cmds =>
1718 [
1719 'o signalLevel=0',
1720 'o',
1721 'q',
1722 ],
1723 prog => '../lib/perl5db/t/test-w-statement-1',
1724 }
1725 );
1726
1727 $wrapper->contents_like(qr/
1728 ^\s*(signalLevel\ =\ '0'\n)
1729 .*?
1730 ^\s*\1
1731 /msx,
1732 q#o set command works#,
1733 );
1734
1735 $wrapper->contents_like(qr#
1736 ^\s*hashDepth\ =\ 'N/A'\n
1737 #msx,
1738 q#o set command - hashDepth#,
1739 );
1740}
1741
1742# Test the '<' and "< ?" commands.
1743{
1744 my $wrapper = DebugWrap->new(
1745 {
1746 cmds =>
1747 [
1748 q/< print "\nX=<$x>\n"/,
1749 q/b 7/,
1750 q/< ?/,
1751 'c',
1752 'q',
1753 ],
1754 prog => '../lib/perl5db/t/disable-breakpoints-1',
1755 }
1756 );
1757
1758 $wrapper->contents_like(qr/
1759 ^pre-perl\ commands:\n
1760 \s*<\ --\ print\ "\\nX=<\$x>\\n"\n
1761 /msx,
1762 q#Test < and < ? commands - contents.#,
1763 );
1764
1765 $wrapper->output_like(qr#
1766 ^X=<FirstVal>\n
1767 #msx,
1768 q#Test < and < ? commands - output.#,
1769 );
1770}
1771
1772# Test the '< *' command.
1773{
1774 my $wrapper = DebugWrap->new(
1775 {
1776 cmds =>
1777 [
1778 q/< print "\nX=<$x>\n"/,
1779 q/b 7/,
1780 q/< */,
1781 'c',
1782 'q',
1783 ],
1784 prog => '../lib/perl5db/t/disable-breakpoints-1',
1785 }
1786 );
1787
1788 $wrapper->output_unlike(qr/FirstVal/,
1789 q#Test the '< *' command.#,
1790 );
1791}
1792
1793# Test the '>' and "> ?" commands.
1794{
1795 my $wrapper = DebugWrap->new(
1796 {
1797 cmds =>
1798 [
1799 q/$::foo = 500;/,
1800 q/> print "\nFOO=<$::foo>\n"/,
1801 q/b 7/,
1802 q/> ?/,
1803 'c',
1804 'q',
1805 ],
1806 prog => '../lib/perl5db/t/disable-breakpoints-1',
1807 }
1808 );
1809
1810 $wrapper->contents_like(qr/
1811 ^post-perl\ commands:\n
1812 \s*>\ --\ print\ "\\nFOO=<\$::foo>\\n"\n
1813 /msx,
1814 q#Test > and > ? commands - contents.#,
1815 );
1816
1817 $wrapper->output_like(qr#
1818 ^FOO=<500>\n
1819 #msx,
1820 q#Test > and > ? commands - output.#,
1821 );
1822}
1823
1824# Test the '> *' command.
1825{
1826 my $wrapper = DebugWrap->new(
1827 {
1828 cmds =>
1829 [
1830 q/> print "\nFOO=<$::foo>\n"/,
1831 q/b 7/,
1832 q/> */,
1833 'c',
1834 'q',
1835 ],
1836 prog => '../lib/perl5db/t/disable-breakpoints-1',
1837 }
1838 );
1839
1840 $wrapper->output_unlike(qr/FOO=/,
1841 q#Test the '> *' command.#,
1842 );
1843}
1844
be1dfd82
SF
1845# Test the < and > commands together
1846{
1847 my $wrapper = DebugWrap->new(
1848 {
1849 cmds =>
1850 [
1851 q/$::lorem = 0;/,
1852 q/< $::lorem += 10;/,
1853 q/> print "\nLOREM=<$::lorem>\n"/,
1854 q/b 7/,
1855 q/b 5/,
1856 'c',
1857 'c',
1858 'q',
1859 ],
1860 prog => '../lib/perl5db/t/disable-breakpoints-1',
1861 }
1862 );
1863
1864 $wrapper->output_like(qr#
1865 ^LOREM=<10>\n
1866 #msx,
1867 q#Test < and > commands. #,
1868 );
1869}
1870
95418017
SF
1871# Test the { ? and { [command] commands.
1872{
1873 my $wrapper = DebugWrap->new(
1874 {
1875 cmds =>
1876 [
1e121f70
SF
1877 '{ ?',
1878 '{ l',
1879 '{ ?',
95418017
SF
1880 q/b 5/,
1881 q/c/,
1882 q/q/,
1883 ],
1884 prog => '../lib/perl5db/t/disable-breakpoints-1',
1885 }
1886 );
1887
1888 $wrapper->contents_like(qr#
1889 ^No\ pre-debugger\ actions\.\n
1890 .*?
1891 ^pre-debugger\ commands:\n
1892 \s+\{\ --\ l\n
1893 .*?
1894 ^5==>b\s+\$x\ =\ "FirstVal";\n
1895 6\s*\n
1896 7:\s+\$dummy\+\+;\n
1897 8\s*\n
1898 9:\s+\$x\ =\ "SecondVal";\n
1899
1900 #msx,
1901 'Test the pre-prompt debugger commands',
1902 );
1903}
1904
3743412c
SF
1905# Test the { * command.
1906{
1907 my $wrapper = DebugWrap->new(
1908 {
1909 cmds =>
1910 [
1911 '{ q',
1912 '{ *',
1913 q/b 5/,
1914 q/c/,
1915 q/print (("One" x 5), "\n");/,
1916 q/q/,
1917 ],
1918 prog => '../lib/perl5db/t/disable-breakpoints-1',
1919 }
1920 );
1921
1922 $wrapper->contents_like(qr#
1923 ^All\ \{\ actions\ cleared\.\n
1924 #msx,
1925 'Test the { * command',
1926 );
1927
1928 $wrapper->output_like(qr/OneOneOneOneOne/,
1929 '{ * test - output is OK.',
1930 );
1931}
1932
1896f514
SF
1933# Test the ! command.
1934{
1935 my $wrapper = DebugWrap->new(
1936 {
1937 cmds =>
1938 [
1939 'l 3-5',
1940 '!',
1941 'q',
1942 ],
1943 prog => '../lib/perl5db/t/disable-breakpoints-1',
1944 }
1945 );
1946
1947 $wrapper->contents_like(qr#
1948 (^3:\s+my\ \$dummy\ =\ 0;\n
1949 4\s*\n
1950 5:\s+\$x\ =\ "FirstVal";)\n
1951 .*?
1952 ^l\ 3-5\n
1953 \1
1954 #msx,
1955 'Test the ! command (along with l 3-5)',
1956 );
1957}
1958
ada05bfe
SF
1959# Test the ! -number command.
1960{
1961 my $wrapper = DebugWrap->new(
1962 {
1963 cmds =>
1964 [
1965 'l 3-5',
1966 'l 2',
1967 '! -1',
1968 'q',
1969 ],
1970 prog => '../lib/perl5db/t/disable-breakpoints-1',
1971 }
1972 );
1973
1974 $wrapper->contents_like(qr#
1975 (^3:\s+my\ \$dummy\ =\ 0;\n
1976 4\s*\n
1977 5:\s+\$x\ =\ "FirstVal";)\n
1978 .*?
1979 ^2==\>\s+my\ \$x\ =\ "One";\n
1980 .*?
1981 ^l\ 3-5\n
1982 \1
1983 #msx,
1984 'Test the ! -n command (along with l)',
1985 );
1986}
1987
5442f949
SF
1988# Test the 'source' command.
1989{
1990 my $wrapper = DebugWrap->new(
1991 {
1992 cmds =>
1993 [
1994 'source ../lib/perl5db/t/source-cmd-test.perldb',
1995 # If we have a 'q' here, then the typeahead will override the
1996 # input, and so it won't be reached - solution:
1997 # put a q inside the .perldb commands.
1998 # ( This may be a bug or a misfeature. )
1999 ],
2000 prog => '../lib/perl5db/t/disable-breakpoints-1',
2001 }
2002 );
2003
2004 $wrapper->contents_like(qr#
2005 ^3:\s+my\ \$dummy\ =\ 0;\n
2006 4\s*\n
2007 5:\s+\$x\ =\ "FirstVal";\n
2008 6\s*\n
2009 7:\s+\$dummy\+\+;\n
2010 8\s*\n
2011 9:\s+\$x\ =\ "SecondVal";\n
2012 10\s*\n
2013 #msx,
2014 'Test the source command (along with l)',
2015 );
35879b90
SF
2016}
2017
2018# Test the 'source' command being traversed from withing typeahead.
2019{
2020 my $wrapper = DebugWrap->new(
2021 {
2022 cmds =>
2023 [
2024 'source ../lib/perl5db/t/source-cmd-test-no-q.perldb',
2025 'q',
2026 ],
2027 prog => '../lib/perl5db/t/disable-breakpoints-1',
2028 }
2029 );
5442f949 2030
35879b90
SF
2031 $wrapper->contents_like(qr#
2032 ^3:\s+my\ \$dummy\ =\ 0;\n
2033 4\s*\n
2034 5:\s+\$x\ =\ "FirstVal";\n
2035 6\s*\n
2036 7:\s+\$dummy\+\+;\n
2037 8\s*\n
2038 9:\s+\$x\ =\ "SecondVal";\n
2039 10\s*\n
2040 #msx,
2041 'Test the source command inside a typeahead',
2042 );
5442f949
SF
2043}
2044
741f88f9
SF
2045# Test the 'H -number' command.
2046{
2047 my $wrapper = DebugWrap->new(
2048 {
2049 cmds =>
2050 [
2051 'l 1-10',
2052 'l 5-10',
2053 'x "Hello World"',
2054 'l 1-5',
2055 'b 3',
2056 'x (20+4)',
2057 'H -7',
2058 'q',
2059 ],
2060 prog => '../lib/perl5db/t/disable-breakpoints-1',
2061 }
2062 );
2063
2064 $wrapper->contents_like(qr#
2065 ^\d+:\s+H\ -7\n
2066 \d+:\s+x\ \(20\+4\)\n
2067 \d+:\s+b\ 3\n
2068 \d+:\s+l\ 1-5\n
2069 \d+:\s+x\ "Hello\ World"\n
2070 \d+:\s+l\ 5-10\n
2071 \d+:\s+l\ 1-10\n
2072 #msx,
6bf7e1ad 2073 'Test the H -num command',
741f88f9
SF
2074 );
2075}
2076
761ec47e
SF
2077# Add a test for H (without arguments)
2078{
2079 my $wrapper = DebugWrap->new(
2080 {
2081 cmds =>
2082 [
2083 'l 1-10',
2084 'l 5-10',
2085 'x "Hello World"',
2086 'l 1-5',
2087 'b 3',
2088 'x (20+4)',
2089 'H',
2090 'q',
2091 ],
2092 prog => '../lib/perl5db/t/disable-breakpoints-1',
2093 }
2094 );
2095
2096 $wrapper->contents_like(qr#
2097 ^\d+:\s+x\ \(20\+4\)\n
2098 \d+:\s+b\ 3\n
2099 \d+:\s+l\ 1-5\n
2100 \d+:\s+x\ "Hello\ World"\n
2101 \d+:\s+l\ 5-10\n
2102 \d+:\s+l\ 1-10\n
2103 #msx,
6bf7e1ad 2104 'Test the H command (without a number.)',
761ec47e
SF
2105 );
2106}
2107
088a867e
SF
2108{
2109 my $wrapper = DebugWrap->new(
2110 {
2111 cmds =>
2112 [
2113 '= quit q',
2114 '= foobar l',
2115 'foobar',
2116 'quit',
2117 ],
2118 prog => '../lib/perl5db/t/test-l-statement-1',
2119 }
2120 );
2121
2122 $wrapper->contents_like(
2123 qr/
2124 ^1==>\s+\$x\ =\ 1;\n
2125 2:\s+print\ "1\\n";\n
2126 3\s*\n
2127 4:\s+\$x\ =\ 2;\n
2128 5:\s+print\ "2\\n";\n
2129 /msx,
2130 'Test the = (command alias) command.',
2131 );
2132}
2133
fedbbdd5 2134# Test the m statement.
12f1669f
SF
2135{
2136 my $wrapper = DebugWrap->new(
2137 {
2138 cmds =>
2139 [
2140 'm main',
2141 'q',
2142 ],
2143 prog => '../lib/perl5db/t/disable-breakpoints-1',
2144 }
2145 );
2146
2147 $wrapper->contents_like(qr#
2148 ^via\ UNIVERSAL:\ DOES$
2149 #msx,
2150 "Test m for main - 1",
2151 );
2152
2153 $wrapper->contents_like(qr#
2154 ^via\ UNIVERSAL:\ can$
2155 #msx,
2156 "Test m for main - 2",
2157 );
2158}
2159
fedbbdd5
SF
2160# Test the m statement.
2161{
2162 my $wrapper = DebugWrap->new(
2163 {
2164 cmds =>
2165 [
2166 'b 41',
2167 'c',
2168 'm $obj',
2169 'q',
2170 ],
2171 prog => '../lib/perl5db/t/test-m-statement-1',
2172 }
2173 );
2174
2175 $wrapper->contents_like(qr#^greet$#ms,
2176 "Test m for obj - 1",
2177 );
2178
2179 $wrapper->contents_like(qr#^via UNIVERSAL: can$#ms,
2180 "Test m for obj - 1",
2181 );
2182}
2183
2bceee64
SF
2184# Test the M command.
2185{
2186 my $wrapper = DebugWrap->new(
2187 {
2188 cmds =>
2189 [
2190 'M',
2191 'q',
2192 ],
2193 prog => '../lib/perl5db/t/test-m-statement-1',
2194 }
2195 );
2196
2197 $wrapper->contents_like(qr#
2198 ^'strict\.pm'\ =>\ '\d+\.\d+\ from
2199 #msx,
2200 "Test M",
2201 );
2202
2203}
2204
8b842515
SF
2205# Test the recallCommand option.
2206{
2207 my $wrapper = DebugWrap->new(
2208 {
2209 cmds =>
2210 [
2211 'o recallCommand=%',
2212 'l 3-5',
2213 'l 2',
2214 '% -1',
2215 'q',
2216 ],
2217 prog => '../lib/perl5db/t/disable-breakpoints-1',
2218 }
2219 );
2220
2221 $wrapper->contents_like(qr#
2222 (^3:\s+my\ \$dummy\ =\ 0;\n
2223 4\s*\n
2224 5:\s+\$x\ =\ "FirstVal";)\n
2225 .*?
2226 ^2==\>\s+my\ \$x\ =\ "One";\n
2227 .*?
2228 ^l\ 3-5\n
2229 \1
2230 #msx,
2231 'Test the o recallCommand option',
2232 );
2233}
b705c774
SF
2234
2235# Test the dieLevel option
2236{
2237 my $wrapper = DebugWrap->new(
2238 {
2239 cmds =>
2240 [
2241 q/o dieLevel='1'/,
2242 q/c/,
2243 'q',
2244 ],
2245 prog => '../lib/perl5db/t/test-dieLevel-option-1',
2246 }
2247 );
2248
2249 $wrapper->output_like(qr#
2250 ^This\ program\ dies\.\ at\ \S+\ line\ 18\.\n
2251 .*?
2252 ^\s+main::baz\(\)\ called\ at\ \S+\ line\ 13\n
2253 \s+main::bar\(\)\ called\ at\ \S+\ line\ 7\n
2254 \s+main::foo\(\)\ called\ at\ \S+\ line\ 21\n
2255 #msx,
2256 'Test the o dieLevel option',
2257 );
2258}
2259
ca3d9398
SF
2260# Test the warnLevel option
2261{
2262 my $wrapper = DebugWrap->new(
2263 {
2264 cmds =>
2265 [
2266 q/o warnLevel='1'/,
2267 q/c/,
2268 'q',
2269 ],
2270 prog => '../lib/perl5db/t/test-warnLevel-option-1',
2271 }
2272 );
2273
2274 $wrapper->contents_like(qr#
2275 ^This\ is\ not\ a\ warning\.\ at\ \S+\ line\ 18\.\n
2276 .*?
2277 ^\s+main::baz\(\)\ called\ at\ \S+\ line\ 13\n
2278 \s+main::bar\(\)\ called\ at\ \S+\ line\ 25\n
2279 \s+main::myfunc\(\)\ called\ at\ \S+\ line\ 28\n
2280 #msx,
2281 'Test the o warnLevel option',
2282 );
2283}
2284
742c59c5
SF
2285# Test the t command
2286{
2287 my $wrapper = DebugWrap->new(
2288 {
2289 cmds =>
2290 [
2291 't',
2292 'c',
2293 'q',
2294 ],
2295 prog => '../lib/perl5db/t/disable-breakpoints-1',
2296 }
2297 );
2298
2299 $wrapper->contents_like(qr/
2300 ^main::\([^:]+:15\):\n
2301 15:\s+\$dummy\+\+;\n
2302 main::\([^:]+:17\):\n
2303 17:\s+\$x\ =\ "FourthVal";\n
2304 /msx,
2305 'Test the t command (without a number.)',
2306 );
2307}
2308
3d02bfa8
SF
2309# Test the o AutoTrace command
2310{
2311 my $wrapper = DebugWrap->new(
2312 {
2313 cmds =>
2314 [
2315 'o AutoTrace',
2316 'c',
2317 'q',
2318 ],
2319 prog => '../lib/perl5db/t/disable-breakpoints-1',
2320 }
2321 );
2322
2323 $wrapper->contents_like(qr/
2324 ^main::\([^:]+:15\):\n
2325 15:\s+\$dummy\+\+;\n
2326 main::\([^:]+:17\):\n
2327 17:\s+\$x\ =\ "FourthVal";\n
2328 /msx,
2329 'Test the o AutoTrace command',
2330 );
2331}
2332
f910787d
SF
2333# Test the t command with function calls
2334{
2335 my $wrapper = DebugWrap->new(
2336 {
2337 cmds =>
2338 [
2339 't',
2340 'b 18',
2341 'c',
2342 'x ["foo"]',
2343 'x ["bar"]',
2344 'q',
2345 ],
2346 prog => '../lib/perl5db/t/test-warnLevel-option-1',
2347 }
2348 );
2349
2350 $wrapper->contents_like(qr/
2351 ^main::\([^:]+:28\):\n
2352 28:\s+myfunc\(\);\n
2353 main::myfunc\([^:]+:25\):\n
2354 25:\s+bar\(\);\n
2355 /msx,
2356 'Test the t command with function calls.',
2357 );
2358}
2359
5e2b42dd
SF
2360# Test the o AutoTrace command with function calls
2361{
2362 my $wrapper = DebugWrap->new(
2363 {
2364 cmds =>
2365 [
2366 'o AutoTrace',
2367 'b 18',
2368 'c',
2369 'x ["foo"]',
2370 'x ["bar"]',
2371 'q',
2372 ],
2373 prog => '../lib/perl5db/t/test-warnLevel-option-1',
2374 }
2375 );
2376
2377 $wrapper->contents_like(qr/
2378 ^main::\([^:]+:28\):\n
2379 28:\s+myfunc\(\);\n
2380 main::myfunc\([^:]+:25\):\n
2381 25:\s+bar\(\);\n
2382 /msx,
2383 'Test the t command with function calls.',
2384 );
2385}
7d9a5afb 2386
ef6abee5
SF
2387# Test the final message.
2388{
2389 my $wrapper = DebugWrap->new(
2390 {
2391 cmds =>
2392 [
2393 'c',
2394 'q',
2395 ],
2396 prog => '../lib/perl5db/t/test-warnLevel-option-1',
2397 }
2398 );
2399
2400 $wrapper->contents_like(qr/
2401 ^Debugged\ program\ terminated\.
2402 /msx,
2403 'Test the final "Debugged program terminated" message.',
2404 );
2405}
2406
7d9a5afb
SF
2407# Test the o inhibit_exit=0 command
2408{
2409 my $wrapper = DebugWrap->new(
2410 {
2411 cmds =>
2412 [
2413 'o inhibit_exit=0',
2414 'n',
2415 'n',
2416 'n',
2417 'n',
2418 'q',
2419 ],
2420 prog => '../lib/perl5db/t/test-warnLevel-option-1',
2421 }
2422 );
2423
2424 $wrapper->contents_unlike(qr/
2425 ^Debugged\ program\ terminated\.
2426 /msx,
2427 'Test the o inhibit_exit=0 command.',
2428 );
2429}
2430
4f7c5654 2431# Test the o PrintRet=1 option
413b1248
SF
2432{
2433 my $wrapper = DebugWrap->new(
2434 {
2435 cmds =>
2436 [
2437 'o PrintRet=1',
2438 'b 29',
2439 'c',
2440 q/$x = 's';/,
2441 'b 10',
2442 'c',
2443 'r',
2444 'q',
2445 ],
2446 prog => '../lib/perl5db/t/test-PrintRet-option-1',
2447 }
2448 );
2449
2450 $wrapper->contents_like(
2451 qr/scalar context return from main::return_scalar: 20024/,
2452 "Test o PrintRet=1",
2453 );
2454}
2455
4f7c5654
SF
2456# Test the o PrintRet=0 option
2457{
2458 my $wrapper = DebugWrap->new(
2459 {
2460 cmds =>
2461 [
2462 'o PrintRet=0',
2463 'b 29',
2464 'c',
2465 q/$x = 's';/,
2466 'b 10',
2467 'c',
2468 'r',
2469 'q',
2470 ],
2471 prog => '../lib/perl5db/t/test-PrintRet-option-1',
2472 }
2473 );
2474
2475 $wrapper->contents_unlike(
2476 qr/scalar context/,
2477 "Test o PrintRet=0",
2478 );
2479}
2480
855abc47
SF
2481# Test the o PrintRet=1 option in list context
2482{
2483 my $wrapper = DebugWrap->new(
2484 {
2485 cmds =>
2486 [
2487 'o PrintRet=1',
2488 'b 29',
2489 'c',
2490 q/$x = 'l';/,
2491 'b 17',
2492 'c',
2493 'r',
2494 'q',
2495 ],
2496 prog => '../lib/perl5db/t/test-PrintRet-option-1',
2497 }
2498 );
2499
2500 $wrapper->contents_like(
2501 qr/list context return from main::return_list:\n0\s*'Foo'\n1\s*'Bar'\n2\s*'Baz'\n/,
2502 "Test o PrintRet=1 in list context",
2503 );
2504}
2505
d728fe0e
SF
2506# Test the o PrintRet=0 option in list context
2507{
2508 my $wrapper = DebugWrap->new(
2509 {
2510 cmds =>
2511 [
2512 'o PrintRet=0',
2513 'b 29',
2514 'c',
2515 q/$x = 'l';/,
2516 'b 17',
2517 'c',
2518 'r',
2519 'q',
2520 ],
2521 prog => '../lib/perl5db/t/test-PrintRet-option-1',
2522 }
2523 );
2524
2525 $wrapper->contents_unlike(
2526 qr/list context/,
2527 "Test o PrintRet=0 in list context",
2528 );
2529}
2530
c8dcbe9b
SF
2531# Test the o PrintRet=1 option in void context
2532{
2533 my $wrapper = DebugWrap->new(
2534 {
2535 cmds =>
2536 [
2537 'o PrintRet=1',
2538 'b 29',
2539 'c',
2540 q/$x = 'v';/,
2541 'b 24',
2542 'c',
2543 'r',
2544 'q',
2545 ],
2546 prog => '../lib/perl5db/t/test-PrintRet-option-1',
2547 }
2548 );
2549
2550 $wrapper->contents_like(
2551 qr/void context return from main::return_void/,
2552 "Test o PrintRet=1 in void context",
2553 );
2554}
2555
19957b55
SF
2556# Test the o PrintRet=1 option in void context
2557{
2558 my $wrapper = DebugWrap->new(
2559 {
2560 cmds =>
2561 [
2562 'o PrintRet=0',
2563 'b 29',
2564 'c',
2565 q/$x = 'v';/,
2566 'b 24',
2567 'c',
2568 'r',
2569 'q',
2570 ],
2571 prog => '../lib/perl5db/t/test-PrintRet-option-1',
2572 }
2573 );
2574
2575 $wrapper->contents_unlike(
2576 qr/void context/,
2577 "Test o PrintRet=0 in void context",
2578 );
2579}
2580
473c46a8
SF
2581# Test the o frame option.
2582{
2583 my $wrapper = DebugWrap->new(
2584 {
2585 cmds =>
2586 [
2587 # This is to avoid getting the "Debugger program terminated"
2588 # junk that interferes with the normal output.
2589 'o inhibit_exit=0',
2590 'b 10',
2591 'c',
2592 'o frame=255',
2593 'c',
2594 'q',
2595 ],
2596 prog => '../lib/perl5db/t/test-frame-option-1',
2597 }
2598 );
2599
2600 $wrapper->contents_like(
2601 qr/
2602 in\s*\.=main::my_other_func\(3,\ 1200\)\ from.*?
2603 out\s*\.=main::my_other_func\(3,\ 1200\)\ from
2604 /msx,
2605 "Test o PrintRet=0 in void context",
2606 );
2607}
2608
e42327f3 2609{ # test t expr
e42327f3
TC
2610 my $wrapper = DebugWrap->new(
2611 {
2612 cmds =>
2613 [
2614 # This is to avoid getting the "Debugger program terminated"
2615 # junk that interferes with the normal output.
2616 'o inhibit_exit=0',
2617 't fact(3)',
2618 'q',
2619 ],
2620 prog => '../lib/perl5db/t/fact',
2621 }
2622 );
2623
2624 $wrapper->contents_like(
2625 qr/
2626 (?:^main::fact.*return\ \$n\ \*\ fact\(\$n\ -\ 1\);.*)
2627 /msx,
2628 "Test t expr",
2629 );
2630}
2631
5f5eab52
SF
2632# Test the w for lexical variables expression.
2633{
2634 my $wrapper = DebugWrap->new(
2635 {
2636 cmds =>
2637 [
2638 # This is to avoid getting the "Debugger program terminated"
2639 # junk that interferes with the normal output.
2640 'w $exp',
2641 'n',
2642 'n',
2643 'n',
2644 'n',
2645 'q',
2646 ],
2647 prog => '../lib/perl5db/t/break-on-dot',
2648 }
2649 );
2650
2651 $wrapper->contents_like(
2652 qr/
2653\s+old\ value:\s+'1'\n
2654\s+new\ value:\s+'2'\n
2655 /msx,
2656 "Test w for lexical values.",
2657 );
2658}
2659
b019bbd2
NC
2660# Test the perldoc command
2661# We don't actually run the program, but we need to provide one to the wrapper.
08a004e4 2662SKIP:
b019bbd2 2663{
08a004e4
TC
2664 $^O eq "linux"
2665 or skip "man errors aren't especially portable", 1;
2666 local $ENV{LANG} = "C";
2667 local $ENV{LC_MESSAGE} = "C";
f81b1f8b 2668 local $ENV{LC_ALL} = "C";
b019bbd2
NC
2669 my $wrapper = DebugWrap->new(
2670 {
2671 cmds =>
2672 [
2673 'perldoc perlrules',
2674 'q',
2675 ],
2676 prog => '../lib/perl5db/t/fact',
2677 }
2678 );
2679
2680 $wrapper->output_like(
2681 qr/No manual entry for perlrules/,
2682 'perldoc command works fine',
2683 );
2684}
2685
635f2c9e 2686END {
4cfe45a1 2687 1 while unlink ($rc_filename, $out_fn);
635f2c9e 2688}