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