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