Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
App	[ DIR ]	drwxr-xr-x	2016-10-10 17:37
Archive	[ DIR ]	drwxr-xr-x	2016-10-10 17:36
Attribute	[ DIR ]	drwxr-xr-x	2016-10-10 17:36
B	[ DIR ]	drwxr-xr-x	2016-10-10 17:38
CGI	[ DIR ]	drwxr-xr-x	2016-10-10 17:36
CPAN	[ DIR ]	drwxr-xr-x	2016-10-10 17:36
Carp	[ DIR ]	drwxr-xr-x	2016-10-10 17:36
Class	[ DIR ]	drwxr-xr-x	2015-02-14 16:56
Compress	[ DIR ]	drwxr-xr-x	2016-10-10 17:38
Config	[ DIR ]	drwxr-xr-x	2016-10-10 17:36
DBM_Filter	[ DIR ]	drwxr-xr-x	2015-02-14 16:56
Data	[ DIR ]	drwxr-xr-x	2016-10-10 17:38
Devel	[ DIR ]	drwxr-xr-x	2016-10-10 17:39
Digest	[ DIR ]	drwxr-xr-x	2016-10-10 17:39
Encode	[ DIR ]	drwxr-xr-x	2016-10-10 17:39
Exporter	[ DIR ]	drwxr-xr-x	2016-10-10 17:36
ExtUtils	[ DIR ]	drwxr-xr-x	2016-10-10 17:36
File	[ DIR ]	drwxr-xr-x	2016-10-10 17:39
Filter	[ DIR ]	drwxr-xr-x	2016-10-10 17:39
Getopt	[ DIR ]	drwxr-xr-x	2016-10-10 17:36
HTTP	[ DIR ]	drwxr-xr-x	2016-10-10 17:36
Hash	[ DIR ]	drwxr-xr-x	2016-10-10 17:39
I18N	[ DIR ]	drwxr-xr-x	2016-10-10 17:39
IO	[ DIR ]	drwxr-xr-x	2016-10-10 17:39
IPC	[ DIR ]	drwxr-xr-x	2016-10-10 17:39
JSON	[ DIR ]	drwxr-xr-x	2016-10-10 17:37
List	[ DIR ]	drwxr-xr-x	2016-10-10 17:39
Locale	[ DIR ]	drwxr-xr-x	2016-10-10 17:37
MIME	[ DIR ]	drwxr-xr-x	2016-10-10 17:40
Math	[ DIR ]	drwxr-xr-x	2016-10-10 17:37
Memoize	[ DIR ]	drwxr-xr-x	2016-10-10 17:37
Module	[ DIR ]	drwxr-xr-x	2016-10-10 17:37
Net	[ DIR ]	drwxr-xr-x	2016-10-10 17:37
Package	[ DIR ]	drwxr-xr-x	2016-10-10 17:37
Params	[ DIR ]	drwxr-xr-x	2016-10-10 17:37
Parse	[ DIR ]	drwxr-xr-x	2016-10-10 17:37
Perl	[ DIR ]	drwxr-xr-x	2016-10-10 17:37
PerlIO	[ DIR ]	drwxr-xr-x	2016-10-10 17:40
Pod	[ DIR ]	drwxr-xr-x	2016-10-10 17:37
Scalar	[ DIR ]	drwxr-xr-x	2016-10-10 17:39
Search	[ DIR ]	drwxr-xr-x	2016-10-10 17:37
Sys	[ DIR ]	drwxr-xr-x	2016-10-10 17:40
TAP	[ DIR ]	drwxr-xr-x	2016-10-10 17:37
Term	[ DIR ]	drwxr-xr-x	2016-10-10 17:37
Test	[ DIR ]	drwxr-xr-x	2016-10-10 17:37
Text	[ DIR ]	drwxr-xr-x	2016-10-10 17:37
Thread	[ DIR ]	drwxr-xr-x	2016-10-10 17:37
Tie	[ DIR ]	drwxr-xr-x	2016-10-10 17:40
Time	[ DIR ]	drwxr-xr-x	2016-10-10 17:40
Unicode	[ DIR ]	drwxr-xr-x	2016-10-10 17:40
User	[ DIR ]	drwxr-xr-x	2015-02-14 16:56
XS	[ DIR ]	drwxr-xr-x	2016-10-10 17:41
auto	[ DIR ]	drwxr-xr-x	2016-10-10 18:16
autodie	[ DIR ]	drwxr-xr-x	2016-10-10 17:36
encoding	[ DIR ]	drwxr-xr-x	2016-10-10 17:36
feature	[ DIR ]	drwxr-xr-x	2015-02-14 16:56
inc	[ DIR ]	drwxr-xr-x	2016-10-10 17:37
overload	[ DIR ]	drwxr-xr-x	2016-10-10 18:13
perl5db	[ DIR ]	drwxr-xr-x	2015-02-14 16:56
threads	[ DIR ]	drwxr-xr-x	2016-10-10 17:40
unicore	[ DIR ]	drwxr-xr-x	2016-10-10 18:53
version	[ DIR ]	drwxr-xr-x	2016-10-10 17:38
warnings	[ DIR ]	drwxr-xr-x	2015-02-14 16:56
.exists	0 B	-rw-r--r--	2016-10-10 18:16
AnyDBM_File.pm	2.56 KB	-r--r--r--	2014-12-27 11:48
AnyDBM_File.t	3.36 KB	-r--r--r--	2014-12-27 11:48
AutoLoader.pm	15.43 KB	-r--r--r--	2014-12-27 11:48
AutoSplit.pm	19.18 KB	-r--r--r--	2014-12-27 11:48
B.pm	28.07 KB	-r--r--r--	2014-12-27 11:49
Benchmark.pm	29.22 KB	-r--r--r--	2014-12-27 11:49
Benchmark.t	21.04 KB	-r--r--r--	2014-12-27 11:48
CGI.pm	255.23 KB	-r--r--r--	2014-12-27 11:49
CORE.pod	3.19 KB	-r--r--r--	2014-12-27 11:48
CPAN.pm	134.45 KB	-r--r--r--	2014-12-27 11:48
Carp.pm	27.8 KB	-r--r--r--	2014-12-27 11:49
Config.pm	3.18 KB	-rw-r--r--	2016-10-10 17:36
Config.pod	229.34 KB	-rw-r--r--	2016-10-10 17:36
Config.t	8.26 KB	-r--r--r--	2014-12-27 11:48
Config_git.pl	409 B	-rw-r--r--	2016-10-10 17:36
Config_heavy.pl	40.41 KB	-rw-r--r--	2016-10-10 17:36
Cwd.pm	21.95 KB	-r--r--r--	2015-01-10 12:06
DB.pm	18.5 KB	-r--r--r--	2014-12-27 11:48
DB.t	16.28 KB	-r--r--r--	2014-12-27 11:48
DBM_Filter.pm	14.05 KB	-r--r--r--	2014-12-27 11:48
DB_File.pm	62.24 KB	-r--r--r--	2016-10-10 17:38
Digest.pm	10.35 KB	-r--r--r--	2014-12-27 11:48
DirHandle.pm	1.52 KB	-r--r--r--	2014-12-27 11:48
DirHandle.t	930 B	-r--r--r--	2014-12-27 11:48
Dumpvalue.pm	16.5 KB	-r--r--r--	2014-12-27 11:48
DynaLoader.pm	24.99 KB	-r--r--r--	2016-10-10 17:38
Encode.pm	32.44 KB	-r--r--r--	2014-12-27 11:49
English.pm	4.64 KB	-r--r--r--	2014-12-27 11:48
English.t	4.11 KB	-r--r--r--	2014-12-27 11:48
Env.pm	5.39 KB	-r--r--r--	2014-12-27 11:48
Errno.pm	6.33 KB	-r--r--r--	2016-10-10 17:36
Exporter.pm	18.31 KB	-r--r--r--	2014-12-27 11:49
Fatal.pm	59.38 KB	-r--r--r--	2014-12-27 11:49
Fcntl.pm	3.83 KB	-r--r--r--	2014-12-27 11:49
FileCache.pm	5.44 KB	-r--r--r--	2014-12-27 11:48
FileHandle.pm	6.62 KB	-r--r--r--	2014-12-27 11:48
FileHandle.t	2.48 KB	-r--r--r--	2014-12-27 11:48
FindBin.pm	4.45 KB	-r--r--r--	2014-12-27 11:48
FindBin.t	338 B	-r--r--r--	2014-12-27 11:48
GDBM_File.pm	1.51 KB	-r--r--r--	2014-12-27 11:48
IO.pm	1.36 KB	-r--r--r--	2014-12-27 11:49
Internals.t	5.04 KB	-r--r--r--	2014-12-27 11:48
Memoize.pm	35.28 KB	-r--r--r--	2014-12-27 11:48
NDBM_File.pm	2.44 KB	-r--r--r--	2014-12-27 11:49
NEXT.pm	18.05 KB	-r--r--r--	2014-12-27 11:48
O.pm	4.11 KB	-r--r--r--	2014-12-27 11:48
Opcode.pm	15.33 KB	-r--r--r--	2014-12-27 11:49
POSIX.pm	16.44 KB	-r--r--r--	2014-12-27 11:49
POSIX.pod	65.45 KB	-r--r--r--	2014-12-27 11:49
PerlIO.pm	10.21 KB	-r--r--r--	2014-12-27 11:48
SDBM_File.pm	3.46 KB	-r--r--r--	2014-12-27 11:49
Safe.pm	24.27 KB	-r--r--r--	2014-12-27 11:49
SelectSaver.pm	1.05 KB	-r--r--r--	2014-12-27 11:48
SelectSaver.t	365 B	-r--r--r--	2014-12-27 11:48
SelfLoader.pm	16.94 KB	-r--r--r--	2014-12-27 11:49
Socket.pm	35.47 KB	-r--r--r--	2014-12-27 11:49
Storable.pm	42.13 KB	-r--r--r--	2015-01-15 22:12
Symbol.pm	4.68 KB	-r--r--r--	2014-12-27 11:48
Symbol.t	2.52 KB	-r--r--r--	2014-12-27 11:48
Test.pm	28.12 KB	-r--r--r--	2014-12-27 11:48
Thread.pm	8.09 KB	-r--r--r--	2014-12-27 11:48
Thread.t	1.59 KB	-r--r--r--	2014-12-27 11:48
UNIVERSAL.pm	6.97 KB	-r--r--r--	2014-12-27 11:49
XSLoader.pm	9.99 KB	-r--r--r--	2016-10-10 17:38
_charnames.pm	31.63 KB	-r--r--r--	2014-12-27 11:49
arybase.pm	2.75 KB	-r--r--r--	2014-12-27 11:49
attributes.pm	15.95 KB	-r--r--r--	2014-12-27 12:30
autodie.pm	11.9 KB	-r--r--r--	2014-12-27 11:49
autouse.pm	4.14 KB	-r--r--r--	2014-12-27 11:48
base.pm	7.21 KB	-r--r--r--	2014-12-27 11:48
bigint.pm	18.29 KB	-r--r--r--	2014-12-27 11:49
bignum.pm	17.7 KB	-r--r--r--	2014-12-27 11:49
bigrat.pm	13.58 KB	-r--r--r--	2014-12-27 11:49
blib.pm	2.04 KB	-r--r--r--	2014-12-27 11:48
blib.t	1.81 KB	-r--r--r--	2014-12-27 11:48
buildcustomize.pl	1.1 KB	-rw-r--r--	2016-10-10 17:36
bytes.pm	2.96 KB	-r--r--r--	2014-12-27 11:48
bytes.t	2.78 KB	-r--r--r--	2014-12-27 11:48
bytes_heavy.pl	758 B	-r--r--r--	2014-12-27 11:48
charnames.pm	20.39 KB	-r--r--r--	2014-12-27 11:49
charnames.t	372.58 KB	-r--r--r--	2014-12-27 11:49
constant.pm	13.99 KB	-r--r--r--	2014-12-27 11:49
dbm_filter_util.pl	1.83 KB	-r--r--r--	2014-12-27 11:48
deprecate.pm	3.01 KB	-r--r--r--	2014-12-27 11:48
diagnostics.pm	18.26 KB	-r--r--r--	2014-12-27 11:48
diagnostics.t	7.1 KB	-r--r--r--	2014-12-27 11:49
dumpvar.pl	15.24 KB	-r--r--r--	2014-12-27 11:48
dumpvar.t	5.81 KB	-r--r--r--	2014-12-27 11:48
encoding.pm	20.04 KB	-r--r--r--	2014-12-27 11:49
experimental.pm	3.88 KB	-r--r--r--	2014-12-27 11:49
feature.pm	13.46 KB	-rw-r--r--	2014-12-27 12:46
feature.t	78 B	-r--r--r--	2014-12-27 11:48
fields.pm	9.24 KB	-r--r--r--	2014-12-27 11:48
filetest.pm	3.91 KB	-r--r--r--	2014-12-27 11:48
filetest.t	3 KB	-r--r--r--	2014-12-27 11:48
h2ph.t	1.58 KB	-r--r--r--	2014-12-27 11:48
h2xs.t	7.64 KB	-r--r--r--	2014-12-27 11:48
if.pm	2.63 KB	-r--r--r--	2014-12-27 11:48
integer.pm	3.18 KB	-r--r--r--	2014-12-27 11:48
integer.t	1.32 KB	-r--r--r--	2014-12-27 11:48
less.pm	3.13 KB	-r--r--r--	2014-12-27 11:48
less.t	901 B	-r--r--r--	2014-12-27 11:48
lib.pm	5.87 KB	-r--r--r--	2016-10-10 17:37
locale.pm	2.13 KB	-r--r--r--	2014-12-27 11:49
locale.t	72.86 KB	-r--r--r--	2014-12-27 11:49
mro.pm	9.86 KB	-r--r--r--	2014-12-27 11:49
open.pm	7.83 KB	-r--r--r--	2014-12-27 11:48
open.t	6.4 KB	-r--r--r--	2014-12-27 11:48
ops.pm	997 B	-r--r--r--	2014-12-27 11:48
overload.pm	51.41 KB	-r--r--r--	2014-12-27 11:49
overload.t	71.98 KB	-r--r--r--	2014-12-27 11:49
overload64.t	8.33 KB	-r--r--r--	2014-12-27 11:48
overloading.pm	1.77 KB	-r--r--r--	2014-12-27 11:48
overloading.t	3.25 KB	-r--r--r--	2014-12-27 11:48
parent.pm	2.83 KB	-r--r--r--	2014-12-27 11:48
perl5db.pl	307.01 KB	-r--r--r--	2014-12-27 11:49
perl5db.t	56.06 KB	-r--r--r--	2014-12-27 11:49
perldoc.pod	8.69 KB	-r--r--r--	2014-12-27 11:48
perlfaq.pm	94 B	-r--r--r--	2014-12-27 11:49
perlfaq.pod	22.18 KB	-r--r--r--	2014-12-27 11:48
perlfaq1.pod	14.36 KB	-r--r--r--	2014-12-27 11:49
perlfaq2.pod	9.24 KB	-r--r--r--	2014-12-27 11:49
perlfaq3.pod	37.67 KB	-r--r--r--	2014-12-27 11:48
perlfaq4.pod	87.39 KB	-r--r--r--	2014-12-27 11:49
perlfaq5.pod	54.11 KB	-r--r--r--	2014-12-27 11:49
perlfaq6.pod	38.66 KB	-r--r--r--	2014-12-27 11:49
perlfaq7.pod	36.98 KB	-r--r--r--	2014-12-27 11:49
perlfaq8.pod	48.9 KB	-r--r--r--	2014-12-27 11:48
perlfaq9.pod	14.7 KB	-r--r--r--	2014-12-27 11:48
perlglossary.pod	133.98 KB	-r--r--r--	2014-12-27 11:48
perlxs.pod	76.6 KB	-r--r--r--	2014-12-27 11:49
perlxstut.pod	48.91 KB	-r--r--r--	2014-12-27 11:48
perlxstypemap.pod	23.02 KB	-r--r--r--	2014-12-27 11:49
re.pm	17.55 KB	-r--r--r--	2014-12-27 11:49
sigtrap.pm	7.44 KB	-r--r--r--	2014-12-27 11:48
sigtrap.t	2.65 KB	-r--r--r--	2014-12-27 11:48
sort.pm	5.94 KB	-r--r--r--	2014-12-27 11:48
sort.t	5.54 KB	-r--r--r--	2014-12-27 11:49
strict.pm	3.83 KB	-r--r--r--	2014-12-27 11:49
strict.t	439 B	-r--r--r--	2014-12-27 11:49
subs.pm	848 B	-r--r--r--	2014-12-27 11:48
subs.t	79 B	-r--r--r--	2014-12-27 11:48
threads.pm	34.93 KB	-r--r--r--	2014-12-27 11:49
utf8.pm	7.64 KB	-r--r--r--	2014-12-27 11:49
utf8.t	21.67 KB	-r--r--r--	2014-12-27 11:48
utf8_heavy.pl	31 KB	-r--r--r--	2014-12-27 11:49
vars.pm	2.36 KB	-r--r--r--	2014-12-27 11:48
vars.t	2.68 KB	-r--r--r--	2014-12-27 11:48
vars_carp.t	246 B	-r--r--r--	2014-12-27 11:48
version.pm	1.58 KB	-r--r--r--	2014-12-27 11:48
version.pod	9.62 KB	-r--r--r--	2014-12-27 11:48
vmsish.pm	4.21 KB	-r--r--r--	2014-12-27 11:48
vmsish.t	7.21 KB	-r--r--r--	2014-12-27 11:48
warnings.pm	38.5 KB	-rw-r--r--	2014-12-27 11:49
warnings.t	120 B	-r--r--r--	2014-12-27 11:48

Rename

#!./perl

BEGIN {
    chdir 't' if -d 't';
    @INC = '../lib';
    require './test.pl';
}

use strict;
use warnings;
use Config;

BEGIN {
    if (! -c "/dev/null") {
        print "1..0 # Skip: no /dev/null\n";
        exit 0;
    }

my $dev_tty = '/dev/tty';
    $dev_tty = 'TT:' if ($^O eq 'VMS');
    if (! -c $dev_tty) {
        print "1..0 # Skip: no $dev_tty\n";
        exit 0;
    }
    if ($ENV{PERL5DB}) {
        print "1..0 # Skip: \$ENV{PERL5DB} is already set to '$ENV{PERL5DB}'\n";
        exit 0;
    }
    $ENV{PERL_RL} = 'Perl'; # Suppress system Term::ReadLine::Gnu
}

plan(119);

my $rc_filename = '.perldb';

sub rc {
    open my $rc_fh, '>', $rc_filename
        or die $!;
    print {$rc_fh} @_;
    close ($rc_fh);

# overly permissive perms gives "Must not source insecure rcfile"
    # and hangs at the DB(1> prompt
    chmod 0644, $rc_filename;
}

sub _slurp
{
    my $filename = shift;

open my $in, '<', $filename
        or die "Cannot open '$filename' for slurping - $!";

local $/;
    my $contents = <$in>;

close($in);

return $contents;
}

my $out_fn = 'db.out';

sub _out_contents
{
    return _slurp($out_fn);
}

# Test for Proxy constants
{
    rc(
        <<'EOF',

&parse_options("NonStop=0 ReadLine=0 TTY=db.out");

sub afterinit {
    push(@DB::typeahead,
        'm main->s1',
        'q',
    );
}

EOF
    );

my $output = runperl(switches => [ '-d' ], stderr => 1, progfile => '../lib/perl5db/t/proxy-constants');
    is($output, "", "proxy constant subroutines");
}

# [perl #66110] Call a subroutine inside a regex
{
    local $ENV{PERLDB_OPTS} = "ReadLine=0 NonStop=1";
    my $output = runperl(switches => [ '-d' ], stderr => 1, progfile => '../lib/perl5db/t/rt-66110');
    like($output, "All tests successful.", "[perl #66110]");
}
# [ perl #116769] Frame=2
{
    local $ENV{PERLDB_OPTS} = "frame=2 nonstop";
    my $output = runperl( switches => [ '-d' ], prog => 'print q{success}' );
    is( $?, 0, '[perl #116769] frame=2 does not crash debugger, exit == 0' );
    like( $output, 'success' , '[perl #116769] code is run' );
}
# [ perl #116771] autotrace
{
    local $ENV{PERLDB_OPTS} = "autotrace nonstop";
    my $output = runperl( switches => [ '-d' ], prog => 'print q{success}' );
    is( $?, 0, '[perl #116771] autotrace does not crash debugger, exit == 0' );
    like( $output, 'success' , '[perl #116771] code is run' );
}
# [ perl #41461] Frame=2 noTTY
{
    local $ENV{PERLDB_OPTS} = "frame=2 noTTY nonstop";
    rc('');
    my $output = runperl( switches => [ '-d' ], prog => 'print q{success}' );
    is( $?, 0, '[perl #41461] frame=2 noTTY does not crash debugger, exit == 0' );
    like( $output, 'success' , '[perl #41461] code is run' );
}

package DebugWrap;

sub new {
    my $class = shift;

my $self = bless {}, $class;

$self->_init(@_);

return $self;
}

sub _cmds {
    my $self = shift;

if (@_) {
        $self->{_cmds} = shift;
    }

return $self->{_cmds};
}

sub _prog {
    my $self = shift;

if (@_) {
        $self->{_prog} = shift;
    }

return $self->{_prog};
}

sub _output {
    my $self = shift;

if (@_) {
        $self->{_output} = shift;
    }

return $self->{_output};
}

sub _include_t
{
    my $self = shift;

if (@_)
    {
        $self->{_include_t} = shift;
    }

return $self->{_include_t};
}

sub _stderr_val
{
    my $self = shift;

if (@_)
    {
        $self->{_stderr_val} = shift;
    }

return $self->{_stderr_val};
}

sub field
{
    my $self = shift;

if (@_)
    {
        $self->{field} = shift;
    }

return $self->{field};
}

sub _switches
{
    my $self = shift;

if (@_)
    {
        $self->{_switches} = shift;
    }

return $self->{_switches};
}

sub _contents
{
    my $self = shift;

if (@_)
    {
        $self->{_contents} = shift;
    }

return $self->{_contents};
}

sub _init
{
    my ($self, $args) = @_;

my $cmds = $args->{cmds};

if (ref($cmds) ne 'ARRAY') {
        die "cmds must be an array of commands.";
    }

$self->_cmds($cmds);

my $prog = $args->{prog};

if (ref($prog) ne '' or !defined($prog)) {
        die "prog should be a path to a program file.";
    }

$self->_prog($prog);

$self->_include_t($args->{include_t} ? 1 : 0);

$self->_stderr_val(exists($args->{stderr}) ? $args->{stderr} : 1);

if (exists($args->{switches}))
    {
        $self->_switches($args->{switches});
    }

$self->_run();

return;
}

sub _quote
{
    my ($self, $str) = @_;

$str =~ s/(["\@\$\\])/\\$1/g;
    $str =~ s/\n/\\n/g;
    $str =~ s/\r/\\r/g;

return qq{"$str"};
}

sub _run {
    my $self = shift;

my $rc = qq{&parse_options("NonStop=0 TTY=db.out");\n};

$rc .= join('',
        map { "$_\n"}
        (q#sub afterinit {#,
         q#push (@DB::typeahead,#,
         (map { $self->_quote($_) . "," } @{$self->_cmds()}),
         q#);#,
         q#}#,
        )
    );

# I guess two objects like that cannot be used at the same time.
    # Oh well.
    ::rc($rc);

my $output =
        ::runperl(
            switches =>
            [
                ($self->_switches ? (@{$self->_switches()}) : ('-d')),
                ($self->_include_t ? ('-I', '../lib/perl5db/t') : ())
            ],
            (defined($self->_stderr_val())
                ? (stderr => $self->_stderr_val())
                : ()
            ),
            progfile => $self->_prog()
        );

$self->_output($output);

$self->_contents(::_out_contents());

return;
}

sub get_output
{
    return shift->_output();
}

sub output_like {
    my ($self, $re, $msg) = @_;

local $::Level = $::Level + 1;
    ::like($self->_output(), $re, $msg);
}

sub output_unlike {
    my ($self, $re, $msg) = @_;

local $::Level = $::Level + 1;
    ::unlike($self->_output(), $re, $msg);
}

sub contents_like {
    my ($self, $re, $msg) = @_;

local $::Level = $::Level + 1;
    ::like($self->_contents(), $re, $msg);
}

sub contents_unlike {
    my ($self, $re, $msg) = @_;

local $::Level = $::Level + 1;
    ::unlike($self->_contents(), $re, $msg);
}

package main;

{
    local $ENV{PERLDB_OPTS} = "ReadLine=0";
    my $target = '../lib/perl5db/t/eval-line-bug';
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'b 23',
                'n',
                'n',
                'n',
                'c', # line 23
                'n',
                "p \@{'main::_<$target'}",
                'q',
            ],
            prog => $target,
        }
    );
    $wrapper->contents_like(
        qr/sub factorial/,
        'The ${main::_<filename} variable in the debugger was not destroyed',
    );
}

sub _calc_generic_wrapper
{
    my $args = shift;

my $extra_opts = delete($args->{extra_opts});
    $extra_opts ||= '';
    local $ENV{PERLDB_OPTS} = "ReadLine=0" . $extra_opts;
    return DebugWrap->new(
        {
            cmds => delete($args->{cmds}),
            prog => delete($args->{prog}),
            %$args,
        }
    );
}

sub _calc_new_var_wrapper
{
    my ($args) = @_;
    return _calc_generic_wrapper(
        {
            cmds =>
            [
                'b 23',
                'c',
                '$new_var = "Foo"',
                'x "new_var = <$new_var>\\n"',
                'q',
            ],
            %$args,
        }
    );
}

sub _calc_threads_wrapper
{
    my $args = shift;

return _calc_new_var_wrapper(
        {
            switches => [ '-dt', ],
            stderr => 1,
            %$args
        }
    );
}

{
    _calc_new_var_wrapper({ prog => '../lib/perl5db/t/eval-line-bug'})
        ->contents_like(
            qr/new_var = <Foo>/,
            "no strict 'vars' in evaluated lines.",
        );
}

{
    _calc_new_var_wrapper(
        {
            prog => '../lib/perl5db/t/lvalue-bug',
            stderr => undef(),
        },
    )->output_like(
            qr/foo is defined/,
             'lvalue subs work in the debugger',
         );
}

{
    _calc_new_var_wrapper(
        {
            prog =>  '../lib/perl5db/t/symbol-table-bug',
            extra_opts => "NonStop=1",
            stderr => undef(),
        }
    )->output_like(
        qr/Undefined symbols 0/,
        'there are no undefined values in the symbol table',
    );
}

SKIP:
{
    if ( $Config{usethreads} ) {
        skip('This perl has threads, skipping non-threaded debugger tests');
    }
    else {
        my $error = 'This Perl not built to support threads';
        _calc_threads_wrapper(
            {
                prog => '../lib/perl5db/t/eval-line-bug',
            }
        )->output_like(
            qr/\Q$error\E/,
            'Perl debugger correctly complains that it was not built with threads',
        );
    }
}

SKIP:
{
    if ( $Config{usethreads} ) {
        _calc_threads_wrapper(
            {
                prog =>  '../lib/perl5db/t/symbol-table-bug',
            }
        )->output_like(
            qr/Undefined symbols 0/,
            'there are no undefined values in the symbol table when running with thread support',
        );
    }
    else {
        skip("This perl is not threaded, skipping threaded debugger tests");
    }
}

# Test [perl #61222]
{
    local $ENV{PERLDB_OPTS};
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'm Pie',
                'q',
            ],
            prog => '../lib/perl5db/t/rt-61222',
        }
    );

$wrapper->contents_unlike(qr/INCORRECT/, "[perl #61222]");
}

sub _calc_trace_wrapper
{
    my ($args) = @_;

return _calc_generic_wrapper(
        {
            cmds =>
            [
                't 2',
                'c',
                'q',
            ],
            %$args,
        }
    );
}

# [perl 104168] level option for tracing
{
    my $wrapper = _calc_trace_wrapper({ prog =>  '../lib/perl5db/t/rt-104168' });
    $wrapper->contents_like(qr/level 2/, "[perl #104168] - level 2 appears");
    $wrapper->contents_unlike(qr/baz/, "[perl #104168] - no 'baz'");
}

# taint tests
{
    my $wrapper = _calc_trace_wrapper(
        {
            prog => '../lib/perl5db/t/taint',
            extra_opts => ' NonStop=1',
            switches => [ '-d', '-T', ],
        }
    );

my $output = $wrapper->get_output();
    chomp $output if $^O eq 'VMS'; # newline guaranteed at EOF
    is($output, '[$^X][done]', "taint");
}

# Testing that we can set a line in the middle of the file.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'b ../lib/perl5db/t/MyModule.pm:12',
                'c',
                q/do { use IO::Handle; STDOUT->autoflush(1); print "Var=$var\n"; }/,
                'c',
                'q',
            ],
            include_t => 1,
            prog => '../lib/perl5db/t/filename-line-breakpoint'
        }
    );

$wrapper->output_like(qr/
        ^Var=Bar$
            .*
        ^In\ MyModule\.$
            .*
        ^In\ Main\ File\.$
            .*
        /msx,
        "Can set breakpoint in a line in the middle of the file.");
}

# Testing that we can set a breakpoint
{
    my $wrapper = DebugWrap->new(
        {
            prog => '../lib/perl5db/t/breakpoint-bug',
            cmds =>
            [
                'b 6',
                'c',
                q/do { use IO::Handle; STDOUT->autoflush(1); print "X={$x}\n"; }/,
                'c',
                'q',
            ],
        },
    );

$wrapper->output_like(
        qr/X=\{Two\}/msx,
        "Can set breakpoint in a line."
    );
}

# Testing that we can disable a breakpoint at a numeric line.
{
    my $wrapper = DebugWrap->new(
        {
            prog =>  '../lib/perl5db/t/disable-breakpoints-1',
            cmds =>
            [
                'b 7',
                'b 11',
                'disable 7',
                'c',
                q/print "X={$x}\n";/,
                'c',
                'q',
            ],
        }
    );

$wrapper->output_like(qr/X=\{SecondVal\}/ms,
        "Can set breakpoint in a line.");
}

# Testing that we can re-enable a breakpoint at a numeric line.
{
    my $wrapper = DebugWrap->new(
        {
            prog =>  '../lib/perl5db/t/disable-breakpoints-2',
            cmds =>
            [
                'b 8',
                'b 24',
                'disable 24',
                'c',
                'enable 24',
                'c',
                q/print "X={$x}\n";/,
                'c',
                'q',
            ],
        },
    );

$wrapper->output_like(
        qr/
        X=\{SecondValOneHundred\}
        /msx,
        "Can set breakpoint in a line."
    );
}
# clean up.

# Disable and enable for breakpoints on outer files.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'b 10',
                'b ../lib/perl5db/t/EnableModule.pm:14',
                'disable ../lib/perl5db/t/EnableModule.pm:14',
                'c',
                'enable ../lib/perl5db/t/EnableModule.pm:14',
                'c',
                q/print "X={$x}\n";/,
                'c',
                'q',
            ],
            prog =>  '../lib/perl5db/t/disable-breakpoints-3',
            include_t => 1,
        }
    );

$wrapper->output_like(qr/
        X=\{SecondValTwoHundred\}
        /msx,
        "Can set breakpoint in a line.");
}

# Testing that the prompt with the information appears.
{
    my $wrapper = DebugWrap->new(
        {
            cmds => ['q'],
            prog => '../lib/perl5db/t/disable-breakpoints-1',
        }
    );

$wrapper->contents_like(qr/
        ^main::$[^$]*\bdisable-breakpoints-1:2\):\n
        2:\s+my\ \$x\ =\ "One";\n
        /msx,
        "Prompt should display the first line of code.");
}

# Testing that R (restart) and "B *" work.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'b 13',
                'c',
                'B *',
                'b 9',
                'R',
                'c',
                q/print "X={$x};dummy={$dummy}\n";/,
                'q',
            ],
            prog =>  '../lib/perl5db/t/disable-breakpoints-1',
        }
    );

$wrapper->output_like(qr/
        X=\{FirstVal\};dummy=\{1\}
        /msx,
        "Restart and delete all breakpoints work properly.");
}

{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'c 15',
                q/print "X={$x}\n";/,
                'c',
                'q',
            ],
            prog =>  '../lib/perl5db/t/disable-breakpoints-1',
        }
    );

$wrapper->output_like(qr/
        X=\{ThirdVal\}
        /msx,
        "'c line_num' is working properly.");
}

{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'n',
                'n',
                'b . $exp > 200',
                'c',
                q/print "Exp={$exp}\n";/,
                'q',
            ],
            prog => '../lib/perl5db/t/break-on-dot',
        }
    );

$wrapper->output_like(qr/
        Exp=\{256\}
        /msx,
        "'b .' is working correctly.");
}

# Testing that the prompt with the information appears inside a subroutine call.
# See https://rt.perl.org/rt3/Ticket/Display.html?id=104820
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'c back',
                'q',
            ],
            prog => '../lib/perl5db/t/with-subroutine',
        }
    );

$wrapper->contents_like(
        qr/
        ^main::back$[^$\n]*\bwith-subroutine:15\):[\ \t]*\n
        ^15:\s*print\ "hello\ back\\n";
        /msx,
        "Prompt should display the line of code inside a subroutine.");
}

# Checking that the p command works.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'p "<<<" . (4*6) . ">>>"',
                'q',
            ],
            prog => '../lib/perl5db/t/with-subroutine',
        }
    );

$wrapper->contents_like(
        qr/<<<24>>>/,
        "p command works.");
}

# Tests for x.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                q/x {500 => 600}/,
                'q',
            ],
            prog => '../lib/perl5db/t/with-subroutine',
        }
    );

$wrapper->contents_like(
        # qr/^0\s+HASH$[^$]+\)\n\s+500 => 600\n/,
        qr/^0\s+HASH$[^$]+\)\n\s+500 => 600\n/ms,
        "x command test."
    );
}

# Tests for x with @_
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'b 10',
                'c',
                'x @_',
                'q',
            ],
            prog => '../lib/perl5db/t/test-passing-at-underscore-to-x-etc',
        }
    );

$wrapper->contents_like(
        # qr/^0\s+HASH$[^$]+\)\n\s+500 => 600\n/,
        qr/Arg1.*?Capsula.*GreekHumor.*Socrates/ms,
        q/x command test with '@_'./,
    );
}

# Tests for mutating @_
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'b 10',
                'c',
                'shift(@_)',
                'print "\n\n\n(((" . join(",", @_) . ")))\n\n\n"',
                'q',
            ],
            prog => '../lib/perl5db/t/test-passing-at-underscore-to-x-etc',
        }
    );

$wrapper->output_like(
        qr/^$\(\(Capsula,GreekHumor,Socrates$\)\)$/ms,
        q/Mutating '@_'./,
    );
}

# Tests for x with AutoTrace=1.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'n',
                'o AutoTrace=1',
                # So it may fail.
                q/x "failure"/,
                q/x \$x/,
                'q',
            ],
            prog => '../lib/perl5db/t/with-subroutine',
        }
    );

$wrapper->contents_like(
        # qr/^0\s+HASH$[^$]+\)\n\s+500 => 600\n/,
        qr/^0\s+SCALAR$[^$]+\)\n\s+-> 'hello world'\n/ms,
        "x after AutoTrace=1 command is working."
    );
}

# Tests for "T" (stack trace).
{
    my $prog_fn = '../lib/perl5db/t/rt-104168';
    my $wrapper = DebugWrap->new(
        {
            prog => $prog_fn,
            cmds =>
            [
                'c baz',
                'T',
                'q',
            ],
        }
    );
    my $re_text = join('',
        map {
        sprintf(
            "%s = %s\$\$ called from file " .
            "'" . quotemeta($prog_fn) . "' line %s\\n",
            (map { quotemeta($_) } @$_)
            )
        }
        (
            ['.', 'main::baz', 14,],
            ['.', 'main::bar', 9,],
            ['.', 'main::foo', 6],
        )
    );
    $wrapper->contents_like(
        # qr/^0\s+HASH$[^$]+\)\n\s+500 => 600\n/,
        qr/^$re_text/ms,
        "T command test."
    );
}

# Test for s.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'b 9',
                'c',
                's',
                q/print "X={$x};dummy={$dummy}\n";/,
                'q',
            ],
            prog => '../lib/perl5db/t/disable-breakpoints-1'
        }
    );

$wrapper->output_like(qr/
        X=\{SecondVal\};dummy=\{1\}
        /msx,
        'test for s - single step',
    );
}

{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'n',
                'n',
                'b . $exp > 200',
                'c',
                q/print "Exp={$exp}\n";/,
                'q',
            ],
            prog => '../lib/perl5db/t/break-on-dot'
        }
    );

$wrapper->output_like(qr/
        Exp=\{256\}
        /msx,
        "'b .' is working correctly.");
}

{
    my $prog_fn = '../lib/perl5db/t/rt-104168';
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                's',
                'q',
            ],
            prog => $prog_fn,
        }
    );

$wrapper->contents_like(
        qr/
        ^main::foo$[^$\n]*\brt-104168:9\):[\ \t]*\n
        ^9:\s*bar;
        /msx,
        'Test for the s command.',
    );
}

{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                's uncalled_subroutine()',
                'c',
                'q',
            ],

prog => '../lib/perl5db/t/uncalled-subroutine'}
    );

$wrapper->output_like(
        qr/<1,2,3,4,5>\n/,
        'uncalled_subroutine was called after s EXPR()',
        );
}

{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'n uncalled_subroutine()',
                'c',
                'q',
            ],
            prog => '../lib/perl5db/t/uncalled-subroutine',
        }
    );

$wrapper->output_like(
        qr/<1,2,3,4,5>\n/,
        'uncalled_subroutine was called after n EXPR()',
        );
}

{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'b fact',
                'c',
                'c',
                'c',
                'n',
                'print "<$n>"',
                'q',
            ],
            prog => '../lib/perl5db/t/fact',
        }
    );

$wrapper->output_like(
        qr/<3>/,
        'b subroutine works fine',
    );
}

# Test for n with lvalue subs
DebugWrap->new({
    cmds =>
    [
        'n', 'print "<$x>\n"',
        'n', 'print "<$x>\n"',
        'q',
    ],
    prog => '../lib/perl5db/t/lsub-n',
})->output_like(
    qr/<1>\n<11>\n/,
    'n steps over lvalue subs',
);

# Test for 'M' (module list).
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'M',
                'q',
            ],
            prog => '../lib/perl5db/t/load-modules'
        }
    );

$wrapper->contents_like(
        qr[Scalar/Util\.pm],
        'M (module list) works fine',
    );
}

{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'b 14',
                'c',
                '$flag = 1;',
                'r',
                'print "Var=$var\n";',
                'q',
            ],
            prog => '../lib/perl5db/t/test-r-statement',
        }
    );

$wrapper->output_like(
        qr/
            ^Foo$
                .*?
            ^Bar$
                .*?
            ^Var=Test$
        /msx,
        'r statement is working properly.',
    );
}

{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'l',
                'q',
            ],
            prog => '../lib/perl5db/t/test-l-statement-1',
        }
    );

$wrapper->contents_like(
        qr/
            ^1==>\s+\$x\ =\ 1;\n
            2:\s+print\ "1\\n";\n
            3\s*\n
            4:\s+\$x\ =\ 2;\n
            5:\s+print\ "2\\n";\n
        /msx,
        'l statement is working properly (test No. 1).',
    );
}

{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'l',
                q/# After l 1/,
                'l',
                q/# After l 2/,
                '-',
                q/# After -/,
                'q',
            ],
            prog => '../lib/perl5db/t/test-l-statement-1',
        }
    );

my $first_l_out = qr/
        1==>\s+\$x\ =\ 1;\n
        2:\s+print\ "1\\n";\n
        3\s*\n
        4:\s+\$x\ =\ 2;\n
        5:\s+print\ "2\\n";\n
        6\s*\n
        7:\s+\$x\ =\ 3;\n
        8:\s+print\ "3\\n";\n
        9\s*\n
        10:\s+\$x\ =\ 4;\n
    /msx;

my $second_l_out = qr/
        11:\s+print\ "4\\n";\n
        12\s*\n
        13:\s+\$x\ =\ 5;\n
        14:\s+print\ "5\\n";\n
        15\s*\n
        16:\s+\$x\ =\ 6;\n
        17:\s+print\ "6\\n";\n
        18\s*\n
        19:\s+\$x\ =\ 7;\n
        20:\s+print\ "7\\n";\n
    /msx;
    $wrapper->contents_like(
        qr/
            ^$first_l_out
            [^\n]*?DB<\d+>\ \#\ After\ l\ 1\n
            [\ \t]*\n
            [^\n]*?DB<\d+>\ l\s*\n
            $second_l_out
            [^\n]*?DB<\d+>\ \#\ After\ l\ 2\n
            [\ \t]*\n
            [^\n]*?DB<\d+>\ -\s*\n
            $first_l_out
            [^\n]*?DB<\d+>\ \#\ After\ -\n
        /msx,
        'l followed by l and then followed by -',
    );
}

{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'l fact',
                'q',
            ],
            prog => '../lib/perl5db/t/test-l-statement-2',
        }
    );

my $first_l_out = qr/
        6\s+sub\ fact\ \{\n
        7:\s+my\ \$n\ =\ shift;\n
        8:\s+if\ $\$n\ >\ 1$\ \{\n
        9:\s+return\ \$n\ \*\ fact$\$n\ -\ 1$;
    /msx;

$wrapper->contents_like(
        qr/
            DB<1>\s+l\ fact\n
            $first_l_out
        /msx,
        'l subroutine_name',
    );
}

{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'b fact',
                'c',
                # Repeat several times to avoid @typeahead problems.
                '.',
                '.',
                '.',
                '.',
                'q',
            ],
            prog => '../lib/perl5db/t/test-l-statement-2',
        }
    );

my $line_out = qr /
        ^main::fact$[^\n]*?:7$:\n
        ^7:\s+my\ \$n\ =\ shift;\n
    /msx;

$wrapper->contents_like(
        qr/
            $line_out
            auto$-\d+$\s+DB<\d+>\s+\.\n
            $line_out
        /msx,
        'Test the "." command',
    );
}

# Testing that the f command works.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'f ../lib/perl5db/t/MyModule.pm',
                'b 12',
                'c',
                q/do { use IO::Handle; STDOUT->autoflush(1); print "Var=$var\n"; }/,
                'c',
                'q',
            ],
            include_t => 1,
            prog => '../lib/perl5db/t/filename-line-breakpoint'
        }
    );

$wrapper->output_like(qr/
        ^Var=Bar$
            .*
        ^In\ MyModule\.$
            .*
        ^In\ Main\ File\.$
            .*
        /msx,
        "f command is working.",
    );
}

# We broke the /pattern/ command because apparently the CORE::eval-s inside
# lib/perl5db.pl cannot handle lexical variable properly. So we now fix this
# bug.
#
# TODO :
#
# 1. Go over the rest of the "eval"s in lib/perl5db.t and see if they cause
# problems.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                '/for/',
                'q',
            ],
            prog => '../lib/perl5db/t/eval-line-bug',
        }
    );

$wrapper->contents_like(
        qr/12: \s* for\ my\ \$q\ $1\ \.\.\ 10$\ \{/msx,
        "/pat/ command is working and found a match.",
    );
}

{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'b 22',
                'c',
                '?for?',
                'q',
            ],
            prog => '../lib/perl5db/t/eval-line-bug',
        }
    );

$wrapper->contents_like(
        qr/12: \s* for\ my\ \$q\ $1\ \.\.\ 10$\ \{/msx,
        "?pat? command is working and found a match.",
    );
}

# Test the L command.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'b 6',
                'b 13 ($q == 5)',
                'L',
                'q',
            ],
            prog => '../lib/perl5db/t/eval-line-bug',
        }
    );

$wrapper->contents_like(
        qr#
        ^\S*?eval-line-bug:\n
        \s*6:\s*my\ \$i\ =\ 5;\n
        \s*break\ if\ $1$\n
        \s*13:\s*\$i\ \+=\ \$q;\n
        \s*break\ if\ $\(\$q\ ==\ 5$\)\n
        #msx,
        "L command is listing breakpoints",
    );
}

# Test the L command for watch expressions.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'w (5+6)',
                'L',
                'q',
            ],
            prog => '../lib/perl5db/t/eval-line-bug',
        }
    );

$wrapper->contents_like(
        qr#
        ^Watch-expressions:\n
        \s*$5\+6$\n
        #msx,
        "L command is listing watch expressions",
    );
}

{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'w (5+6)',
                'w (11*23)',
                'W (5+6)',
                'L',
                'q',
            ],
            prog => '../lib/perl5db/t/eval-line-bug',
        }
    );

$wrapper->contents_like(
        qr#
        ^Watch-expressions:\n
        \s*$11\*23$\n
        ^auto\(
        #msx,
        "L command is not listing deleted watch expressions",
    );
}

# Test the L command.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'b 6',
                'a 13 print $i',
                'L',
                'q',
            ],
            prog => '../lib/perl5db/t/eval-line-bug',
        }
    );

$wrapper->contents_like(
        qr#
        ^\S*?eval-line-bug:\n
        \s*6:\s*my\ \$i\ =\ 5;\n
        \s*break\ if\ $1$\n
        \s*13:\s*\$i\ \+=\ \$q;\n
        \s*action:\s+print\ \$i\n
        #msx,
        "L command is listing actions and breakpoints",
    );
}

{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'S',
                'q',
            ],
            prog =>  '../lib/perl5db/t/rt-104168',
        }
    );

$wrapper->contents_like(
        qr#
        ^main::bar\n
        main::baz\n
        main::foo\n
        #msx,
        "S command - 1",
    );
}

{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'S ^main::ba',
                'q',
            ],
            prog =>  '../lib/perl5db/t/rt-104168',
        }
    );

$wrapper->contents_like(
        qr#
        ^main::bar\n
        main::baz\n
        auto\(
        #msx,
        "S command with regex",
    );
}

{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'S !^main::ba',
                'q',
            ],
            prog =>  '../lib/perl5db/t/rt-104168',
        }
    );

$wrapper->contents_unlike(
        qr#
        ^main::ba
        #msx,
        "S command with negative regex",
    );

$wrapper->contents_like(
        qr#
        ^main::foo\n
        #msx,
        "S command with negative regex - what it still matches",
    );
}

# Test the 'a' command.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'a 13 print "\nVar<Q>=$q\n"',
                'c',
                'q',
            ],
            prog => '../lib/perl5db/t/eval-line-bug',
        }
    );

my $nl = $^O eq 'VMS' ? "" : "\\\n";
    $wrapper->output_like(qr#
        \nVar<Q>=1$nl
        \nVar<Q>=2$nl
        \nVar<Q>=3
        #msx,
        "a command is working",
    );
}

# Test the 'a' command with no line number.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'n',
                q/a print "Hello " . (3 * 4) . "\n";/,
                'c',
                'q',
            ],
            prog => '../lib/perl5db/t/test-a-statement-1',
        }
    );

$wrapper->output_like(qr#
        (?:^Hello\ 12\n.*?){4}
        #msx,
        "a command with no line number is working",
    );
}

# Test the 'A' command
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'a 13 print "\nVar<Q>=$q\n"',
                'A 13',
                'c',
                'q',
            ],
            prog => '../lib/perl5db/t/eval-line-bug',
        }
    );

$wrapper->output_like(
        qr#\A\z#msx, # The empty string.
        "A command (for removing actions) is working",
    );
}

# Test the 'A *' command
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'a 6 print "\nFail!\n"',
                'a 13 print "\nVar<Q>=$q\n"',
                'A *',
                'c',
                'q',
            ],
            prog => '../lib/perl5db/t/eval-line-bug',
        }
    );

$wrapper->output_like(
        qr#\A\z#msx, # The empty string.
        "'A *' command (for removing all actions) is working",
    );
}

{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'n',
                'w $foo',
                'c',
                'print "\nIDX=<$idx>\n"',
                'q',
            ],
            prog => '../lib/perl5db/t/test-w-statement-1',
        }
    );

$wrapper->contents_like(qr#
        \$foo\ changed:\n
        \s+old\ value:\s+'1'\n
        \s+new\ value:\s+'2'\n
        #msx,
        'w command - watchpoint changed',
    );
    $wrapper->output_like(qr#
        \nIDX=<20>\n
        #msx,
        "w command - correct output from IDX",
    );
}

{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'n',
                'w $foo',
                'W $foo',
                'c',
                'print "\nIDX=<$idx>\n"',
                'q',
            ],
            prog => '../lib/perl5db/t/test-w-statement-1',
        }
    );

$wrapper->contents_unlike(qr#
        \$foo\ changed:
        #msx,
        'W command - watchpoint was deleted',
    );

$wrapper->output_like(qr#
        \nIDX=<>\n
        #msx,
        "W command - stopped at end.",
    );
}

# Test the W * command.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'n',
                'w $foo',
                'w ($foo*$foo)',
                'W *',
                'c',
                'print "\nIDX=<$idx>\n"',
                'q',
            ],
            prog => '../lib/perl5db/t/test-w-statement-1',
        }
    );

$wrapper->contents_unlike(qr#
        \$foo\ changed:
        #msx,
        '"W *" command - watchpoint was deleted',
    );

$wrapper->output_like(qr#
        \nIDX=<>\n
        #msx,
        '"W *" command - stopped at end.',
    );
}

# Test the 'o' command (without further arguments).
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'o',
                'q',
            ],
            prog => '../lib/perl5db/t/test-w-statement-1',
        }
    );

$wrapper->contents_like(qr#
        ^\s*warnLevel\ =\ '1'\n
        #msx,
        q#"o" command (without arguments) displays warnLevel#,
    );

$wrapper->contents_like(qr#
        ^\s*signalLevel\ =\ '1'\n
        #msx,
        q#"o" command (without arguments) displays signalLevel#,
    );

$wrapper->contents_like(qr#
        ^\s*dieLevel\ =\ '1'\n
        #msx,
        q#"o" command (without arguments) displays dieLevel#,
    );

$wrapper->contents_like(qr#
        ^\s*hashDepth\ =\ 'N/A'\n
        #msx,
        q#"o" command (without arguments) displays hashDepth#,
    );
}

# Test the 'o' query command.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'o hashDepth? signalLevel?',
                'q',
            ],
            prog => '../lib/perl5db/t/test-w-statement-1',
        }
    );

$wrapper->contents_unlike(qr#warnLevel#,
        q#"o" query command does not display warnLevel#,
    );

$wrapper->contents_like(qr#
        ^\s*signalLevel\ =\ '1'\n
        #msx,
        q#"o" query command displays signalLevel#,
    );

$wrapper->contents_unlike(qr#dieLevel#,
        q#"o" query command does not display dieLevel#,
    );

$wrapper->contents_like(qr#
        ^\s*hashDepth\ =\ 'N/A'\n
        #msx,
        q#"o" query command displays hashDepth#,
    );
}

# Test the 'o' set command.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'o signalLevel=0',
                'o',
                'q',
            ],
            prog => '../lib/perl5db/t/test-w-statement-1',
        }
    );

$wrapper->contents_like(qr/
        ^\s*(signalLevel\ =\ '0'\n)
        .*?
        ^\s*\1
        /msx,
        q#o set command works#,
    );

$wrapper->contents_like(qr#
        ^\s*hashDepth\ =\ 'N/A'\n
        #msx,
        q#o set command - hashDepth#,
    );
}

# Test the '<' and "< ?" commands.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                q/< print "\nX=<$x>\n"/,
                q/b 7/,
                q/< ?/,
                'c',
                'q',
            ],
            prog => '../lib/perl5db/t/disable-breakpoints-1',
        }
    );

$wrapper->contents_like(qr/
        ^pre-perl\ commands:\n
        \s*<\ --\ print\ "\\nX=<\$x>\\n"\n
        /msx,
        q#Test < and < ? commands - contents.#,
    );

$wrapper->output_like(qr#
        ^X=<FirstVal>\n
        #msx,
        q#Test < and < ? commands - output.#,
    );
}

# Test the '< *' command.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                q/< print "\nX=<$x>\n"/,
                q/b 7/,
                q/< */,
                'c',
                'q',
            ],
            prog => '../lib/perl5db/t/disable-breakpoints-1',
        }
    );

$wrapper->output_unlike(qr/FirstVal/,
        q#Test the '< *' command.#,
    );
}

# Test the '>' and "> ?" commands.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                q/$::foo = 500;/,
                q/> print "\nFOO=<$::foo>\n"/,
                q/b 7/,
                q/> ?/,
                'c',
                'q',
            ],
            prog => '../lib/perl5db/t/disable-breakpoints-1',
        }
    );

$wrapper->contents_like(qr/
        ^post-perl\ commands:\n
        \s*>\ --\ print\ "\\nFOO=<\$::foo>\\n"\n
        /msx,
        q#Test > and > ? commands - contents.#,
    );

$wrapper->output_like(qr#
        ^FOO=<500>\n
        #msx,
        q#Test > and > ? commands - output.#,
    );
}

# Test the '> *' command.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                q/> print "\nFOO=<$::foo>\n"/,
                q/b 7/,
                q/> */,
                'c',
                'q',
            ],
            prog => '../lib/perl5db/t/disable-breakpoints-1',
        }
    );

$wrapper->output_unlike(qr/FOO=/,
        q#Test the '> *' command.#,
    );
}

# Test the < and > commands together
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                q/$::lorem = 0;/,
                q/< $::lorem += 10;/,
                q/> print "\nLOREM=<$::lorem>\n"/,
                q/b 7/,
                q/b 5/,
                'c',
                'c',
                'q',
            ],
            prog => '../lib/perl5db/t/disable-breakpoints-1',
        }
    );

$wrapper->output_like(qr#
        ^LOREM=<10>\n
        #msx,
        q#Test < and > commands. #,
    );
}

# Test the { ? and { [command] commands.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                '{ ?',
                '{ l',
                '{ ?',
                q/b 5/,
                q/c/,
                q/q/,
            ],
            prog => '../lib/perl5db/t/disable-breakpoints-1',
        }
    );

$wrapper->contents_like(qr#
        ^No\ pre-debugger\ actions\.\n
        .*?
        ^pre-debugger\ commands:\n
        \s+\{\ --\ l\n
        .*?
        ^5==>b\s+\$x\ =\ "FirstVal";\n
        6\s*\n
        7:\s+\$dummy\+\+;\n
        8\s*\n
        9:\s+\$x\ =\ "SecondVal";\n

#msx,
        'Test the pre-prompt debugger commands',
    );
}

# Test the { * command.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                '{ q',
                '{ *',
                q/b 5/,
                q/c/,
                q/print (("One" x 5), "\n");/,
                q/q/,
            ],
            prog => '../lib/perl5db/t/disable-breakpoints-1',
        }
    );

$wrapper->contents_like(qr#
        ^All\ \{\ actions\ cleared\.\n
        #msx,
        'Test the { * command',
    );

$wrapper->output_like(qr/OneOneOneOneOne/,
        '{ * test - output is OK.',
    );
}

# Test the ! command.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'l 3-5',
                '!',
                'q',
            ],
            prog => '../lib/perl5db/t/disable-breakpoints-1',
        }
    );

$wrapper->contents_like(qr#
        (^3:\s+my\ \$dummy\ =\ 0;\n
        4\s*\n
        5:\s+\$x\ =\ "FirstVal";)\n
        .*?
        ^l\ 3-5\n
        \1
        #msx,
        'Test the ! command (along with l 3-5)',
    );
}

# Test the ! -number command.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'l 3-5',
                'l 2',
                '! -1',
                'q',
            ],
            prog => '../lib/perl5db/t/disable-breakpoints-1',
        }
    );

$wrapper->contents_like(qr#
        (^3:\s+my\ \$dummy\ =\ 0;\n
        4\s*\n
        5:\s+\$x\ =\ "FirstVal";)\n
        .*?
        ^2==\>\s+my\ \$x\ =\ "One";\n
        .*?
        ^l\ 3-5\n
        \1
        #msx,
        'Test the ! -n command (along with l)',
    );
}

# Test the 'source' command.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'source ../lib/perl5db/t/source-cmd-test.perldb',
                # If we have a 'q' here, then the typeahead will override the
                # input, and so it won't be reached - solution:
                # put a q inside the .perldb commands.
                # ( This may be a bug or a misfeature. )
            ],
            prog => '../lib/perl5db/t/disable-breakpoints-1',
        }
    );

$wrapper->contents_like(qr#
        ^3:\s+my\ \$dummy\ =\ 0;\n
        4\s*\n
        5:\s+\$x\ =\ "FirstVal";\n
        6\s*\n
        7:\s+\$dummy\+\+;\n
        8\s*\n
        9:\s+\$x\ =\ "SecondVal";\n
        10\s*\n
        #msx,
        'Test the source command (along with l)',
    );
}

# Test the 'source' command being traversed from withing typeahead.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'source ../lib/perl5db/t/source-cmd-test-no-q.perldb',
                'q',
            ],
            prog => '../lib/perl5db/t/disable-breakpoints-1',
        }
    );

# Test the 'H -number' command.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'l 1-10',
                'l 5-10',
                'x "Hello World"',
                'l 1-5',
                'b 3',
                'x (20+4)',
                'H -7',
                'q',
            ],
            prog => '../lib/perl5db/t/disable-breakpoints-1',
        }
    );

$wrapper->contents_like(qr#
        ^\d+:\s+H\ -7\n
        \d+:\s+x\ $20\+4$\n
        \d+:\s+b\ 3\n
        \d+:\s+l\ 1-5\n
        \d+:\s+x\ "Hello\ World"\n
        \d+:\s+l\ 5-10\n
        \d+:\s+l\ 1-10\n
        #msx,
        'Test the H -num command',
    );
}

# Add a test for H (without arguments)
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'l 1-10',
                'l 5-10',
                'x "Hello World"',
                'l 1-5',
                'b 3',
                'x (20+4)',
                'H',
                'q',
            ],
            prog => '../lib/perl5db/t/disable-breakpoints-1',
        }
    );

$wrapper->contents_like(qr#
        ^\d+:\s+x\ $20\+4$\n
        \d+:\s+b\ 3\n
        \d+:\s+l\ 1-5\n
        \d+:\s+x\ "Hello\ World"\n
        \d+:\s+l\ 5-10\n
        \d+:\s+l\ 1-10\n
        #msx,
        'Test the H command (without a number.)',
    );
}

{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                '= quit q',
                '= foobar l',
                'foobar',
                'quit',
            ],
            prog => '../lib/perl5db/t/test-l-statement-1',
        }
    );

$wrapper->contents_like(
        qr/
            ^1==>\s+\$x\ =\ 1;\n
            2:\s+print\ "1\\n";\n
            3\s*\n
            4:\s+\$x\ =\ 2;\n
            5:\s+print\ "2\\n";\n
        /msx,
        'Test the = (command alias) command.',
    );
}

# Test the m statement.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'm main',
                'q',
            ],
            prog => '../lib/perl5db/t/disable-breakpoints-1',
        }
    );

$wrapper->contents_like(qr#
        ^via\ UNIVERSAL:\ DOES$
        #msx,
        "Test m for main - 1",
    );

$wrapper->contents_like(qr#
        ^via\ UNIVERSAL:\ can$
        #msx,
        "Test m for main - 2",
    );
}

# Test the m statement.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'b 41',
                'c',
                'm $obj',
                'q',
            ],
            prog => '../lib/perl5db/t/test-m-statement-1',
        }
    );

$wrapper->contents_like(qr#^greet$#ms,
        "Test m for obj - 1",
    );

$wrapper->contents_like(qr#^via UNIVERSAL: can$#ms,
        "Test m for obj - 1",
    );
}

# Test the M command.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'M',
                'q',
            ],
            prog => '../lib/perl5db/t/test-m-statement-1',
        }
    );

$wrapper->contents_like(qr#
        ^'strict\.pm'\ =>\ '\d+\.\d+\ from
        #msx,
        "Test M",
    );

}

# Test the recallCommand option.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'o recallCommand=%',
                'l 3-5',
                'l 2',
                '% -1',
                'q',
            ],
            prog => '../lib/perl5db/t/disable-breakpoints-1',
        }
    );

$wrapper->contents_like(qr#
        (^3:\s+my\ \$dummy\ =\ 0;\n
        4\s*\n
        5:\s+\$x\ =\ "FirstVal";)\n
        .*?
        ^2==\>\s+my\ \$x\ =\ "One";\n
        .*?
        ^l\ 3-5\n
        \1
        #msx,
        'Test the o recallCommand option',
    );
}

# Test the dieLevel option
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                q/o dieLevel='1'/,
                q/c/,
                'q',
            ],
            prog => '../lib/perl5db/t/test-dieLevel-option-1',
        }
    );

$wrapper->output_like(qr#
        ^This\ program\ dies\.\ at\ \S+\ line\ 18\N*\.\n
        .*?
        ^\s+main::baz\ called\ at\ \S+\ line\ 13\n
        \s+main::bar\ called\ at\ \S+\ line\ 7\n
        \s+main::foo\ called\ at\ \S+\ line\ 21\n
        #msx,
        'Test the o dieLevel option',
    );
}

# Test the warnLevel option
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                q/o warnLevel='1'/,
                q/c/,
                'q',
            ],
            prog => '../lib/perl5db/t/test-warnLevel-option-1',
        }
    );

$wrapper->contents_like(qr#
        ^This\ is\ not\ a\ warning\.\ at\ \S+\ line\ 18\N*\.\n
        .*?
        ^\s+main::baz\ called\ at\ \S+\ line\ 13\n
        \s+main::bar\ called\ at\ \S+\ line\ 25\n
        \s+main::myfunc\ called\ at\ \S+\ line\ 28\n
        #msx,
        'Test the o warnLevel option',
    );
}

# Test the t command
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                't',
                'c',
                'q',
            ],
            prog => '../lib/perl5db/t/disable-breakpoints-1',
        }
    );

$wrapper->contents_like(qr/
        ^main::$[^:]+:15$:\n
        15:\s+\$dummy\+\+;\n
        main::$[^:]+:17$:\n
        17:\s+\$x\ =\ "FourthVal";\n
        /msx,
        'Test the t command (without a number.)',
    );
}

# Test the o AutoTrace command
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'o AutoTrace',
                'c',
                'q',
            ],
            prog => '../lib/perl5db/t/disable-breakpoints-1',
        }
    );

$wrapper->contents_like(qr/
        ^main::$[^:]+:15$:\n
        15:\s+\$dummy\+\+;\n
        main::$[^:]+:17$:\n
        17:\s+\$x\ =\ "FourthVal";\n
        /msx,
        'Test the o AutoTrace command',
    );
}

# Test the t command with function calls
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                't',
                'b 18',
                'c',
                'x ["foo"]',
                'x ["bar"]',
                'q',
            ],
            prog => '../lib/perl5db/t/test-warnLevel-option-1',
        }
    );

$wrapper->contents_like(qr/
        ^main::$[^:]+:28$:\n
        28:\s+myfunc;\n
        auto$-\d+$\s+DB<1>\s+t\n
        Trace\ =\ on\n
        auto$-\d+$\s+DB<1>\s+b\ 18\n
        auto$-\d+$\s+DB<2>\s+c\n
        main::myfunc$[^:]+:25$:\n
        25:\s+bar;\n
        /msx,
        'Test the t command with function calls.',
    );
}

# Test the o AutoTrace command with function calls
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'o AutoTrace',
                'b 18',
                'c',
                'x ["foo"]',
                'x ["bar"]',
                'q',
            ],
            prog => '../lib/perl5db/t/test-warnLevel-option-1',
        }
    );

$wrapper->contents_like(qr/
        ^main::$[^:]+:28$:\n
        28:\s+myfunc;\n
        auto$-\d+$\s+DB<1>\s+o\ AutoTrace\n
        \s+AutoTrace\s+=\s+'1'\n
        auto$-\d+$\s+DB<2>\s+b\ 18\n
        auto$-\d+$\s+DB<3>\s+c\n
        main::myfunc$[^:]+:25$:\n
        25:\s+bar;\n
        /msx,
        'Test the o AutoTrace command with function calls.',
    );
}

# Test the final message.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'c',
                'q',
            ],
            prog => '../lib/perl5db/t/test-warnLevel-option-1',
        }
    );

$wrapper->contents_like(qr/
        ^Debugged\ program\ terminated\.
        /msx,
        'Test the final "Debugged program terminated" message.',
    );
}

# Test the o inhibit_exit=0 command
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'o inhibit_exit=0',
                'n',
                'n',
                'n',
                'n',
                'q',
            ],
            prog => '../lib/perl5db/t/test-warnLevel-option-1',
        }
    );

$wrapper->contents_unlike(qr/
        ^Debugged\ program\ terminated\.
        /msx,
        'Test the o inhibit_exit=0 command.',
    );
}

# Test the o PrintRet=1 option
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'o PrintRet=1',
                'b 29',
                'c',
                q/$x = 's';/,
                'b 10',
                'c',
                'r',
                'q',
            ],
            prog => '../lib/perl5db/t/test-PrintRet-option-1',
        }
    );

$wrapper->contents_like(
        qr/scalar context return from main::return_scalar: 20024/,
        "Test o PrintRet=1",
    );
}

# Test the o PrintRet=0 option
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'o PrintRet=0',
                'b 29',
                'c',
                q/$x = 's';/,
                'b 10',
                'c',
                'r',
                'q',
            ],
            prog => '../lib/perl5db/t/test-PrintRet-option-1',
        }
    );

$wrapper->contents_unlike(
        qr/scalar context/,
        "Test o PrintRet=0",
    );
}

# Test the o PrintRet=1 option in list context
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'o PrintRet=1',
                'b 29',
                'c',
                q/$x = 'l';/,
                'b 17',
                'c',
                'r',
                'q',
            ],
            prog => '../lib/perl5db/t/test-PrintRet-option-1',
        }
    );

$wrapper->contents_like(
        qr/list context return from main::return_list:\n0\s*'Foo'\n1\s*'Bar'\n2\s*'Baz'\n/,
        "Test o PrintRet=1 in list context",
    );
}

# Test the o PrintRet=0 option in list context
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'o PrintRet=0',
                'b 29',
                'c',
                q/$x = 'l';/,
                'b 17',
                'c',
                'r',
                'q',
            ],
            prog => '../lib/perl5db/t/test-PrintRet-option-1',
        }
    );

$wrapper->contents_unlike(
        qr/list context/,
        "Test o PrintRet=0 in list context",
    );
}

# Test the o PrintRet=1 option in void context
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'o PrintRet=1',
                'b 29',
                'c',
                q/$x = 'v';/,
                'b 24',
                'c',
                'r',
                'q',
            ],
            prog => '../lib/perl5db/t/test-PrintRet-option-1',
        }
    );

$wrapper->contents_like(
        qr/void context return from main::return_void/,
        "Test o PrintRet=1 in void context",
    );
}

# Test the o PrintRet=1 option in void context
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'o PrintRet=0',
                'b 29',
                'c',
                q/$x = 'v';/,
                'b 24',
                'c',
                'r',
                'q',
            ],
            prog => '../lib/perl5db/t/test-PrintRet-option-1',
        }
    );

$wrapper->contents_unlike(
        qr/void context/,
        "Test o PrintRet=0 in void context",
    );
}

# Test the o frame option.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                # This is to avoid getting the "Debugger program terminated"
                # junk that interferes with the normal output.
                'o inhibit_exit=0',
                'b 10',
                'c',
                'o frame=255',
                'c',
                'q',
            ],
            prog => '../lib/perl5db/t/test-frame-option-1',
        }
    );

$wrapper->contents_like(
        qr/
            in\s*\.=main::my_other_func$3,\ 1200$\ from.*?
            out\s*\.=main::my_other_func$3,\ 1200$\ from
        /msx,
        "Test o PrintRet=0 in void context",
    );
}

{ # test t expr
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                # This is to avoid getting the "Debugger program terminated"
                # junk that interferes with the normal output.
                'o inhibit_exit=0',
                't fact(3)',
                'q',
            ],
            prog => '../lib/perl5db/t/fact',
        }
    );

$wrapper->contents_like(
        qr/
	    (?:^main::fact.*return\ \$n\ \*\ fact$\$n\ -\ 1$;.*)
        /msx,
        "Test t expr",
    );
}

# Test the w for lexical variables expression.
{
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                # This is to avoid getting the "Debugger program terminated"
                # junk that interferes with the normal output.
                'w $exp',
                'n',
                'n',
                'n',
                'n',
                'q',
            ],
            prog => '../lib/perl5db/t/break-on-dot',
        }
    );

$wrapper->contents_like(
        qr/
\s+old\ value:\s+'1'\n
\s+new\ value:\s+'2'\n
        /msx,
        "Test w for lexical values.",
    );
}

# Test the perldoc command
# We don't actually run the program, but we need to provide one to the wrapper.
SKIP:
{
    $^O eq "linux"
        or skip "man errors aren't especially portable", 1;
    -x '/usr/bin/man'
        or skip "man command seems to be missing", 1;
    local $ENV{LANG} = "C";
    local $ENV{LC_MESSAGES} = "C";
    local $ENV{LC_ALL} = "C";
    my $wrapper = DebugWrap->new(
        {
            cmds =>
            [
                'perldoc perlrules',
                'q',
            ],
            prog => '../lib/perl5db/t/fact',
        }
    );

$wrapper->output_like(
        qr/No manual entry for perlrules/,
        'perldoc command works fine',
    );
}

END {
    1 while unlink ($rc_filename, $out_fn);
}