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 -Tw

BEGIN {
        chdir 't' if -d 't';
        @INC = '../lib';
	require Config;
	if (($Config::Config{'extensions'} !~ m!\bList/Util\b!) ){
		print "1..0 # Skip -- Perl configured without List::Util module\n";
		exit 0;
	}
}

# symbolic references used later
use strict qw( vars subs );

# @DB::dbline values have both integer and string components (Benjamin Goldberg)
use Scalar::Util qw( dualvar );
my $dualfalse = dualvar(0, 'false');
my $dualtrue = dualvar(1, 'true');

use Test::More tests => 106;

# must happen at compile time for DB:: package variable localizations to work
BEGIN {
        use_ok( 'DB' );
}

# test DB::sub()
{
        my $callflag = 0;
        local $DB::sub = sub {
                $callflag += shift || 1;
                my @vals = (1, 4, 9);
                return @vals;
        };
        my $ret = DB::sub;
        is( $ret, 3, 'DB::sub() should handle scalar context' );
        is( $callflag, 1, '... should call $DB::sub contents' );
        $ret = join(' ', DB::sub(2));
        is( $ret, '1 4 9', '... should handle scalar context' );
        is( $callflag, 3, '... should pass along arguments to the sub' );
        ok( defined($DB::ret),'$DB::ret should be defined after successful return');
        DB::sub;
        ok( !defined($DB::ret), '... should respect void context' );
        $DB::sub = '::DESTROY';
        ok( !defined($DB::ret), '... should return undef for DESTROY()' );
}

# test DB::DB()
{ 
        ok( ! defined DB::DB(), 
                'DB::DB() should return undef if $DB::ready is false');
        is( DB::catch(), 1, 'DB::catch() should work' );
        is( DB->skippkg('foo'), 1, 'DB->skippkg() should push args' );

# change packages to mess with caller()
        package foo;
        ::ok( ! defined DB::DB(), 'DB::DB() should skip skippable packages' );

package main;
        is( $DB::filename, $0, '... should set $DB::filename' );
        is( $DB::lineno, __LINE__ - 4, '... should set $DB::lineno' );

DB::DB();
        # stops at line 94
}

# test DB::save()
{
       no warnings 'uninitialized';

# assigning a number to $! seems to produce an error message, when read
        local ($@, $,, $/, $\, $^W, $!) = (1 .. 5);
        DB::save();
        is( "$@$!$,$/$\$^W", "1\n0", 'DB::save() should reset punctuation vars' );
}

# test DB::catch()
{
        local $DB::signal;
        DB::catch();
        ok( $DB::signal, 'DB::catch() should set $DB::signal' );
        # add clients and test to see if they are awakened
}

# test DB::_clientname()
is( DB::_clientname('foo=A(1)'), 'foo',
    'DB::_clientname should return refname');
is( DB::_clientname('bar'), undef,
        'DB::_clientname should not return non refname');

# test DB::next() and DB::step()
{
        local $DB::single;
        DB->next();
        is( $DB::single, 2, 'DB->next() should set $DB::single to 2' );
        DB->step();
        is( $DB::single, 1, 'DB->step() should set $DB::single to 1' );
}

# test DB::cont()
{
        # cannot test @stack

local $DB::single = 1;
        my $fdb = FakeDB->new();
        DB::cont($fdb, 2);
        is( $fdb->{tbreak}, 2, 'DB::cont() should set tbreak in object' );
        is( $DB::single, 0, '... should set $DB::single to 0' );
}

# test DB::ret()
{
        # cannot test @stack

local $DB::single = 1;
        DB::ret();
        is( $DB::single, 0, 'DB::ret() should set $DB::single to 0' );
}

# test DB::backtrace()
{
        local (@DB::args, $DB::signal);

my $line = __LINE__ + 1;
        my @ret = eval { DB->backtrace() };
        like( $ret[0], qr/file.+\Q$0\E/, 'DB::backtrace() should report current file');
        like( $ret[0], qr/line $line/, '... should report calling line number' );
        like( $ret[0], qr/eval\Q {...}/, '... should catch eval BLOCK' );

@ret = eval "one(2)";
        is( scalar @ret, 1, '... should report from provided stack frame number' );
        like( $ret[0], qr/\@ = &eval \'one.+?2\)\'/, #'
                '... should find eval STRING construct');
        $ret[0] = check_context(1);
        like( $ret[0], qr/\$ = &main::check_context/, 
                '... should respect context of calling construct');
        
        $DB::signal = 1;
        @DB::args = (1, 7);
        @ret = three(1);
        is( scalar @ret, 1, '... should end loop if $DB::signal is true' );

# does not check 'require' or @DB::args mangling
}

sub check_context {
        return (eval "one($_[0])")[-1];
}
sub one { DB->backtrace(@_) }
sub two { one(@_) }
sub three { two(@_) }

# test DB::trace_toggle
{
        local $DB::trace = 0;
        DB->trace_toggle;
        ok( $DB::trace, 'DB::trace_toggle() should toggle $DB::trace' );
        DB->trace_toggle;
        ok( !$DB::trace, '... should toggle $DB::trace (back)' );
}

# test DB::subs()
{
        local %DB::sub;
        my $subs = DB->subs;
        is( $subs, 0, 'DB::subs() should return keys of %DB::subs' );
        %DB::sub = ( foo => 'foo:23-45' , bar => 'ba:r:7-890' );
        $subs = DB->subs;
        is( $subs, 2, '... same song, different key' );
        my @subs = DB->subs( 'foo', 'boo', 'bar' );
        is( scalar @subs, 2, '... should report only for requested subs' );
        my @expected = ( [ 'foo', 23, 45 ], [ 'ba:r', 7, 890 ] );
        ok( eq_array( \@subs, \@expected ), '... find file, start, end for subs' );
}

# test DB::filesubs()
{
        local ($DB::filename, %DB::sub);
        $DB::filename = 'baz';
        %DB::sub = map { $_ => $_ } qw( bazbar bazboo boobar booboo boobaz );
        my @ret = DB->filesubs();
        is( scalar @ret, 2, 'DB::filesubs() should use $DB::filename with no args');
        @ret = grep { /^baz/ } @ret;    
        is( scalar @ret, 2, '... should pick up subs in proper file' );
        @ret = DB->filesubs('boo');
        is( scalar @ret, 3, '... should use argument to find subs' );
        @ret = grep { /^boo/ } @ret;    
        is( scalar @ret, 3, '... should pick up subs in proper file with argument');
}

# test DB::files()
{
        my $dbf = () = DB::files();
        my $main = () = grep ( m!^_<!, keys %main:: );
        is( $dbf, $main, 'DB::files() should pick up filenames from %main::' );
}

# test DB::lines()
{
        local @DB::dbline = ( 'foo' );
        is( DB->lines->[0], 'foo', 'DB::lines() should return ref to @DB::dbline' );
}

# test DB::loadfile()
SKIP: {
        local (*DB::dbline, $DB::filename);
        ok( ! defined DB->loadfile('notafile'),
                'DB::loadfile() should not find unloaded file' );
        my $file = (grep { m|^_<.+\.pm| } keys %main:: )[0];
        skip('cannot find loaded file', 3) unless $file;
        $file =~ s/^_<..//;

my $db = DB->loadfile($file);
        like( $db, qr!$file\z!, '... should find loaded file from partial name');

is( *DB::dbline, *{ "_<$db" } , 
                '... should set *DB::dbline to associated glob');
        is( $DB::filename, $db, '... should set $DB::filename to file name' );

# test clients
}

# test DB::lineevents()
{
        use vars qw( *baz );

local $DB::filename = 'baz';
        local *baz = *{ "main::_<baz" };
        
        @baz = map { dualvar(1, $_) } qw( one two three four five );
        %baz = (
                1 => "foo\0bar",
                3 => "boo\0far",
                4 => "fazbaz",
        );
        my %ret = DB->lineevents();
        is( scalar keys %ret, 3, 'DB::lineevents() should pick up defined lines' );

# array access in DB::lineevents() starts at element 1, not 0
        is( join(' ', @{ $ret{1} }), 'two foo bar', '... should stash data in hash');
}

# test DB::set_break()
{
        local ($DB::lineno, *DB::dbline, $DB::package);

%DB::dbline = (
                1 => "\0",
                2 => undef,
                3 => "123\0\0\0abc",
                4 => "\0abc",
        );

*DB::dbline = [ $dualfalse, $dualtrue, $dualfalse, $dualfalse, $dualtrue ];

local %DB::sub = (
                'main::foo'     => 'foo:1-4',
        );
         
        DB->set_break(1, 'foo');
        is( $DB::dbline{1}, "foo\0", 'DB::set_break() should set break condition' );

$DB::lineno = 1;
        DB->set_break(undef, 'bar');
        is( $DB::dbline{1}, "bar\0", 
                '... should use $DB::lineno without specified line' );

DB->set_break(4);
        is( $DB::dbline{4}, "1\0abc", '... should use default condition if needed');

local %DB::sub = (
                'main::foo'     => 'foo:1-4',
        );
        DB->set_break('foo', 'baz');
        is( $DB::dbline{4}, "baz\0abc", 
                '... should use _find_subline() to resolve subname' );

my $db = FakeDB->new();
        DB::set_break($db, 2);
        like( $db->{output}, qr/2 not break/, '... should respect @DB::dbline' );

DB::set_break($db, 'nonfoo');
        like( $db->{output}, qr/not found/, '... should warn on unfound sub' );
}

# test DB::set_tbreak()
{
        local ($DB::lineno, *DB::dbline, $DB::package);
        *DB::dbline = [ $dualfalse, $dualtrue, $dualfalse, $dualfalse, $dualtrue ];

DB->set_tbreak(1);
        is( $DB::dbline{1}, ';9', 'DB::set_tbreak() should set tbreak condition' );

local %DB::sub = (
                'main::foo'     => 'foo:1-4',
        );
        DB->set_tbreak('foo', 'baz');
        is( $DB::dbline{4}, ';9', 
                '... should use _find_subline() to resolve subname' );

my $db = FakeDB->new();
        DB::set_tbreak($db, 2);
        like( $db->{output}, qr/2 not break/, '... should respect @DB::dbline' );

DB::set_break($db, 'nonfoo');
        like( $db->{output}, qr/not found/, '... should warn on unfound sub' );
}

# test DB::_find_subline()
{
        my @foo;
        local *{ "::_<foo" } = \@foo;

local $DB::package;
        local %DB::sub = (
                'TEST::foo'     => 'foo:10-15',
                'main::foo'     => 'foo:11-12',
                'bar::bar'      => 'foo:10-16',
        );

$foo[11] = $dualtrue;

is( DB::_find_subline('TEST::foo'), 11, 
                'DB::_find_subline() should find fully qualified sub' );
        is( DB::_find_subline("TEST'foo"), 11, '... should handle old package sep');
        is( DB::_find_subline('foo'), 11, 
                '... should resolve unqualified package name to main::' );

$DB::package = 'bar';
        is( DB::_find_subline('bar'), 11, 
                '... should resolve unqualified name with $DB::package, if defined' );
        
        $foo[11] = $dualfalse;

is( DB::_find_subline('TEST::foo'), 15, 
                '... should increment past lines with no events' );
                
        ok( ! defined DB::_find_subline('sirnotappearinginthisfilm'),
                '... should not find nonexistant sub' );
}

# test DB::clr_breaks()
{
        local *DB::dbline;
        my %lines = (
                1 => "\0",
                2 => undef,
                3 => "123\0\0\0abc",
                4 => "\0\0\0abc",
        );

%DB::dbline = %lines;
        DB->clr_breaks(1 .. 4);
        is( scalar keys %DB::dbline, 3, 'DB::clr_breaks() should clear breaks' );
        ok( ! exists($DB::dbline{1}), '... should delete empty actions' );
        is( $DB::dbline{3}, "\0\0\0abc", '... should remove break, leaving action');
        is( $DB::dbline{4}, "\0\0\0abc", '... should not remove set actions' );

local *{ "::_<foo" } = [ 0, 0, 0, 1 ];

local $DB::package;
        local %DB::sub = (
                'main::foo'     => 'foo:1-3',
        );

%DB::dbline = %lines;
        DB->clr_breaks('foo');

is( $DB::dbline{3}, "\0\0\0abc", 
                '... should find lines via _find_subline()' );
        
        my $db = FakeDB->new();
        DB::clr_breaks($db, 'abadsubname');
        is( $db->{output}, "Subroutine not found.\n", 
                '... should output warning if sub cannot be found');

@DB::dbline = (1 .. 4);
        %DB::dbline = (%lines, 5 => "\0" );

DB::clr_breaks();

is( scalar keys %DB::dbline, 4, 
                'Relying on @DB::dbline in DB::clr_breaks() should clear breaks' );
        ok( ! exists($DB::dbline{1}), '... should delete empty actions' );
        is( $DB::dbline{3}, "\0\0\0abc", '... should remove break, leaving action');
        is( $DB::dbline{4}, "\0\0\0abc", '... should not remove set actions' );
        ok( exists($DB::dbline{5}), 
                '... should only go to last index of @DB::dbline' );
}

# test DB::set_action()
{
        local *DB::dbline;

%DB::dbline = (
                2 => "\0abc",
        );

*DB::dbline = [ $dualfalse, $dualfalse, $dualtrue, $dualtrue ];

DB->set_action(2, 'def');
        is( $DB::dbline{2}, "\0def", 
                'DB::set_action() should replace existing action' );
        DB->set_action(3, '');
        is( $DB::dbline{3}, "\0", '... should set new action' );

my $db = FakeDB->new();
        DB::set_action($db, 'abadsubname');
        is( $db->{output}, "Subroutine not found.\n", 
                '... should output warning if sub cannot be found');

DB::set_action($db, 1);
        like( $db->{output}, qr/1 not action/, 
                '... should warn if line cannot be actionivated' );
}

# test DB::clr_actions()
{
        local *DB::dbline;
        my %lines = (
                1 => "\0",
                2 => undef,
                3 => "123\0abc",
                4 => "abc\0",
        );

%DB::dbline = %lines;
        *DB::dbline = [ ($dualtrue) x 4 ];

DB->clr_actions(1 .. 4);

is( scalar keys %DB::dbline, 2, 'DB::clr_actions() should clear actions' );
        ok( ! exists($DB::dbline{1}), '... should delete empty actions' );
        is( $DB::dbline{3}, "123", '... should remove action, leaving break');
        is( $DB::dbline{4}, "abc\0", '... should not remove set breaks' );

local *{ "::_<foo" } = [ 0, 0, 0, 1 ];

local $DB::package;
        local %DB::sub = (
                'main::foo'     => 'foo:1-3',
        );

%DB::dbline = %lines;
        DB->clr_actions('foo');

is( $DB::dbline{3}, "123", '... should find lines via _find_subline()' );
        
        my $db = FakeDB->new();
        DB::clr_actions($db, 'abadsubname');
        is( $db->{output}, "Subroutine not found.\n", 
                '... should output warning if sub cannot be found');

@DB::dbline = (1 .. 4);
        %DB::dbline = (%lines, 5 => "\0" );

DB::clr_actions();

is( scalar keys %DB::dbline, 4, 
                'Relying on @DB::dbline in DB::clr_actions() should clear actions' );
        ok( ! exists($DB::dbline{1}), '... should delete empty actions' );
        is( $DB::dbline{3}, "123", '... should remove action, leaving break');
        is( $DB::dbline{4}, "abc\0", '... should not remove set breaks' );
        ok( exists($DB::dbline{5}), 
                '... should only go to last index of @DB::dbline' );
}

# test DB::prestop()
ok( ! defined DB::prestop('test'),
        'DB::prestop() should return undef for undef value' );
DB::prestop('test', 897);
is( DB::prestop('test'), 897, '... should return value when set' );

# test DB::poststop(), not exactly parallel
ok( ! defined DB::poststop('tset'), 
        'DB::prestop() should return undef for undef value' );
DB::poststop('tset', 987);
is( DB::poststop('tset'), 987, '... should return value when set' );

# test DB::evalcode()
ok( ! defined DB::evalcode('foo'),
        'DB::evalcode() should return undef for undef value' );

DB::evalcode('foo', 'bar');
is( DB::evalcode('foo'), 'bar', '... should return value when set' );

# test DB::_outputall(), must create fake clients first
ok( DB::register( FakeDB->new() ), 'DB::register() should work' );
DB::register( FakeDB->new() ) for ( 1 .. 2);

DB::_outputall(1, 2, 3);
is( $FakeDB::output, '123123123', 
        'DB::_outputall() should call output(@_) on all clients' );

# test virtual methods
for my $method (qw( cprestop cpoststop awaken init stop idle cleanup output )) {
        ok( defined &{ "DB::$method" }, "DB::$method() should be defined" );
}

# DB::skippkg() uses lexical
# DB::ready() uses lexical

package FakeDB;

use vars qw( $output );

sub new {
        bless({}, $_[0]);
}

sub set_tbreak {
        my ($self, $val) = @_;
        $self->{tbreak} = $val;
}

sub output {
        my $self = shift;
        if (ref $self) {
                $self->{output} = join('', @_);
        } else {
                $output .= join('', @_);
        }
}