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