[perl5.git] / lib / Dumpvalue.t

#!./perl

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

use vars qw( $foo @bar %baz );

use Test::More tests => 88;

use_ok( 'Dumpvalue' );

my $d;
ok( $d = Dumpvalue->new(), 'create a new Dumpvalue object' );

$d->set( globPrint => 1, dumpReused => 1 );
is( $d->{globPrint}, 1, 'set an option correctly' );
is( $d->get('globPrint'), 1, 'get an option correctly' );
is( $d->get('globPrint', 'dumpReused'), qw( 1 1 ), 'get multiple options' );

# check to see if unctrl works
is( ref( Dumpvalue::unctrl(*FOO) ), 'GLOB', 'unctrl should not modify GLOB' );
is( Dumpvalue::unctrl('donotchange'), 'donotchange', "unctrl shouldn't modify");
like( Dumpvalue::unctrl("bo\007nd"), qr/bo\^.nd/, 'unctrl should escape' );

# check to see if stringify works
is( $d->stringify(), 'undef', 'stringify handles undef okay' );

# the default is 1, but we want two single quotes
$d->{printUndef} = 0;
is( $d->stringify(), "''", 'stringify skips undef when asked nicely' );

is( $d->stringify(*FOO), *FOO . "", 'stringify stringifies globs alright' );

# check for double-quotes if there's an unprintable character
$d->{tick} = 'auto';
like( $d->stringify("hi\005"), qr/^"hi/, 'added double-quotes when necessary' );

# if no unprintable character, escape ticks or backslashes
is( $d->stringify('hi'), "'hi'", 'used single-quotes when appropriate' );

# if 'unctrl' is set
$d->{unctrl} = 'unctrl';
like( $d->stringify('double and whack:\ "'), qr!\\ \"!, 'escaped with unctrl' );
like( $d->stringify("a\005"), qr/^"a\^/, 'escaped ASCII value in unctrl' );
like( $d->stringify("b\205"), qr!^'b.'$!, 'no high-bit escape value in unctrl');

$d->{quoteHighBit} = 1;
like( $d->stringify("b\205"), qr!^'b\\205!, 'high-bit now escaped in unctrl');

# if 'quote' is set
$d->{unctrl} = 'quote';
is( $d->stringify('5@ $1'), "'5\@ \$1'", 'quoted $ and @ fine' );
is( $d->stringify("5@\033\$1"), '"5\@\e\$1"', 'quoted $ and @ and \033 fine' );
like( $d->stringify("\037"), qr/^"\\c/, 'escaped ASCII value okay' );

# add ticks, if necessary
is( $d->stringify("no ticks", 1), 'no ticks', 'avoid ticks if asked' );

my $out = tie *OUT, 'TieOut';
select(OUT);

# test DumpElem, it does its magic with veryCompact set
$d->{veryCompact} = 1;
$d->DumpElem([1, 2, 3]);
is( $out->read, "0..2  1 2 3\n", 'DumpElem worked on array ref');
$d->DumpElem({ one => 1, two => 2 });
is( $out->read, "'one' => 1, 'two' => 2\n", 'DumpElem worked on hash ref' );
$d->DumpElem('hi');
is( $out->read, "'hi'\n", 'DumpElem worked on simple scalar' );
$d->{veryCompact} = 0;
$d->DumpElem([]);
like( $out->read, qr/ARRAY/, 'DumpElem okay with reference and no veryCompact');

# should compact simple arrays just fine
$d->{veryCompact} = 1;
$d->DumpElem([1, 2, 3]);
is( $out->read, "0..2  1 2 3\n", 'dumped array fine' );
$d->{arrayDepth} = 2;
$d->DumpElem([1, 2, 3]);
is( $out->read, "0..2  1 2 ...\n", 'dumped limited array fine' );

# should compact simple hashes just fine
$d->DumpElem({ a => 1, b => 2, c => 3 });
is( $out->read, "'a' => 1, 'b' => 2, 'c' => 3\n", 'dumped hash fine' );
$d->{hashDepth} = 2;
$d->DumpElem({ a => 1, b => 2, c => 3 });
is( $out->read, "'a' => 1, 'b' => 2 ...\n", 'dumped limited hash fine' );

# should just stringify what it is
$d->{veryCompact} = 0;
$d->DumpElem([]);
like( $out->read, qr/ARRAY.+empty array/s, 'stringified empty array ref' );
$d->DumpElem({});
like( $out->read, qr/HASH.+empty hash/s, 'stringified empty hash ref' );
$d->DumpElem(1);
is( $out->read, "1\n", 'stringified simple scalar' );

# test unwrap
$DB::signal = $d->{stopDbSignal} = 1;
is( $d->unwrap(), undef, 'unwrap returns if DB signal is set' );
undef $DB::signal;

my $foo = 7;
$d->{dumpReused} = 0;
$d->unwrap(\$foo);
is( $out->read, "-> 7\n", 'unwrap worked on scalar' );
$d->unwrap(\$foo);
is( $out->read, "-> REUSED_ADDRESS\n", 'unwrap worked on scalar' );
$d->unwrap({ one => 1 });

# leaving this at zero may cause some subsequent tests to fail
# if they reuse an address creating an anonymous variable
$d->{dumpReused} = 1;
is( $out->read, "'one' => 1\n", 'unwrap worked on hash' );
$d->unwrap([ 2, 3 ]);
is( $out->read, "0  2\n1  3\n", 'unwrap worked on array' );
$d->unwrap(*FOO);
is( $out->read, '', 'unwrap ignored glob on first try');
$d->unwrap(*FOO);
is( $out->read, "*DUMPED_GLOB*\n", 'unwrap worked on glob');
$d->unwrap(qr/foo(.+)/);
is( $out->read, "-> qr/(?-xism:foo(.+))/\n", 'unwrap worked on Regexp' );
$d->unwrap( sub {} );
like( $out->read, qr/^-> &CODE/, 'unwrap worked on sub ref' );

# test matchvar
# test to see if first arg 'eq' second
ok( Dumpvalue::matchvar(1, 1), 'matchvar matched numbers fine' );
ok( Dumpvalue::matchvar('hi', 'hi'), 'matchvar matched strings fine' );
ok( !Dumpvalue::matchvar('hello', 1), 'matchvar caught failed match fine' );

# test compactDump, which doesn't do much
is( $d->compactDump(3), 3, 'set compactDump to 3' );
is( $d->compactDump(1), 479, 'compactDump reset to 6*80-1 when less than 2' );

# test veryCompact, which does slightly more, setting compactDump sometimes
$d->{compactDump} = 0;
is( $d->veryCompact(1), 1, 'set veryCompact successfully' );
ok( $d->compactDump(), 'and it set compactDump as well' );

# test set_unctrl
$d->set_unctrl('impossible value');
like( $out->read, qr/^Unknown value/, 'set_unctrl caught bad value' );
is( $d->set_unctrl('quote'), 'quote', 'set quote fine' );
is( $d->set_unctrl(), 'quote', 'retrieved quote fine' );

# test set_quote
$d->set_quote('"');
is( $d->{tick}, '"', 'set_quote set tick right' );
is( $d->{unctrl}, 'quote', 'set unctrl right too' );
$d->set_quote('auto');
is( $d->{tick}, 'auto', 'set_quote set auto right' );
$d->set_quote('foo');
is( $d->{tick}, "'", 'default value set to " correctly' );

# test dumpglob
# should do nothing if debugger signal flag is raised
$d->{stopDbSignal} = $DB::signal = 1;
is( $d->dumpglob(*DB::signal), undef, 'returned early with DB signal set' );
undef $DB::signal;

# test dumping "normal" variables, this is a nasty glob trick
$foo = 1;
$d->dumpglob( '', 2, 'foo', local *foo = \$foo );
is( $out->read, "  \$foo = 1\n", 'dumped glob for $foo correctly' );
@bar = (1, 2);

# the key name is a little different here
$d->dumpglob( '', 0, 'boo', *bar );
is( $out->read, "\@boo = (\n   0..1  1 2\n)\n", 'dumped glob for @bar fine' );

%baz = ( one => 1, two => 2 );
$d->dumpglob( '', 0, 'baz', *baz );
is( $out->read, "\%baz = (\n   'one' => 1, 'two' => 2\n)\n",
	'dumped glob for %baz fine' );

SKIP: {
	skip( "Couldn't open $0 for reading", 1 ) unless open(FILE, $0);
	my $fileno = fileno(FILE);
	$d->dumpglob( '', 0, 'FILE', *FILE );
	is( $out->read, "FileHandle(FILE) => fileno($fileno)\n",
		'dumped filehandle from glob fine' );
}

$d->dumpglob( '', 0, 'read', *TieOut::read );
is( $out->read, '', 'no sub dumped without $all set' );
$d->dumpglob( '', 0, 'read', \&TieOut::read, 1 );
is( $out->read, "&read in ???\n", 'sub dumped when requested' );

# see if it dumps DB-like values correctly
$d->{dumpDBFiles} = 1;
$d->dumpglob( '', 0, '_<foo', *foo );
is( $out->read, "\$_<foo = 1\n", 'dumped glob for $_<foo correctly (DB)' );

# test CvGV name
SKIP: {
	if (" $Config::Config{'extensions'} " !~ m[ Devel/Peek ]) {
	    skip( 'no Devel::Peek', 2 );
	}
	use_ok( 'Devel::Peek' );
	is( $d->CvGV_name(\&TieOut::read), 'TieOut::read', 'CvGV_name found sub' );
}

# test dumpsub
$d->dumpsub( '', 'TieOut::read' );
like( $out->read, qr/&TieOut::read in/, 'dumpsub found sub fine' );

# test findsubs
is( $d->findsubs(), undef, 'findsubs returns nothing without %DB::sub' );
$DB::sub{'TieOut::read'} = 'TieOut';
is( $d->findsubs( \&TieOut::read ), 'TieOut::read', 'findsubs reported sub' );

# now that it's capable of finding the package...
$d->dumpsub( '', 'TieOut::read' );
is( $out->read, "&TieOut::read in TieOut\n", 'dumpsub found sub fine again' );

# this should print just a usage message
$d->{usageOnly} = 1;
$d->dumpvars( 'Fake', 'veryfake' );
like( $out->read, qr/^String space:/, 'printed usage message fine' );
delete $d->{usageOnly};

# this should report @INC and %INC
$d->dumpvars( 'main', 'INC' );
like( $out->read, qr/\@INC =/, 'dumped variables from a package' );

# this should report nothing
$DB::signal = 1;
$d->dumpvars( 'main', 'INC' );
is( $out->read, '', 'no dump when $DB::signal is set' );
undef $DB::signal;

is( $d->scalarUsage('12345'), 5, 'scalarUsage reports length correctly' );
is( $d->arrayUsage( [1, 2, 3], 'a' ), 3, 'arrayUsage reports correct lengths' );
is( $out->read, "\@a = 3 items (data: 3 bytes)\n", 'arrayUsage message okay' );
is( $d->hashUsage({ one => 1 }, 'b'), 4, 'hashUsage reports correct lengths' );
is( $out->read, "\%b = 1 item (keys: 3; values: 1; total: 4 bytes)\n",
	'hashUsage message okay' );
is( $d->hashUsage({ one => [ 1, 2, 3 ]}, 'c'), 6, 'complex hash okay' );
is( $out->read, "\%c = 1 item (keys: 3; values: 3; total: 6 bytes)\n",
	'hashUsage complex message okay' );

$foo = 'one';
@foo = ('two');
%foo = ( three => '123' );
is( $d->globUsage(\*foo, 'foo'), 14, 'globUsage reports length correctly' );
like( $out->read, qr/\@foo =.+\%foo =/s, 'globValue message okay' );

# and now, the real show
$d->dumpValue(undef);
is( $out->read, "undef\n", 'dumpValue caught undef value okay' );
$d->dumpValue($foo);
is( $out->read, "'one'\n", 'dumpValue worked' );
$d->dumpValue(@foo);
is( $out->read, "'two'\n", 'dumpValue worked on array' );
$d->dumpValue(\$foo);
is( $out->read, "-> 'one'\n", 'dumpValue worked on scalar ref' );

# dumpValues (the rest of these should be caught by unwrap)
$d->dumpValues(undef);
is( $out->read, "undef\n", 'dumpValues caught undef value fine' );
$d->dumpValues(\@foo);
is( $out->read, "0  0..0  'two'\n", 'dumpValues worked on array ref' );
$d->dumpValues('one', 'two');
is( $out->read, "0..1  'one' 'two'\n", 'dumpValues worked on multiple values' );


package TieOut;
use overload '"' => sub { "overloaded!" };

sub TIEHANDLE {
	my $class = shift;
	bless(\( my $ref), $class);
}

sub PRINT {
	my $self = shift;
	$$self .= join('', @_);
}

sub read {
	my $self = shift;
	return substr($$self, 0, length($$self), '');
}
Commit	Line	Data
8f90a6c7	1	#!./perl
	2
	3	BEGIN {
	4	chdir 't' if -d 't';
	5	@INC = '../lib';
ca092af1 JH	6	if (ord('A') == 193) {
	7	print "1..0 # skip: EBCDIC\n";
	8	exit 0;
	9	}
78cd8b71	10	require Config;
98641f60	11	if (($Config::Config{'extensions'} !~ m!\bList/Util\b!) ){
78cd8b71 NC	12	print "1..0 # Skip -- Perl configured without List::Util module\n";
	13	exit 0;
	14	}
8f90a6c7	15	}
	16
	17	use vars qw( $foo @bar %baz );
	18
	19	use Test::More tests => 88;
	20
	21	use_ok( 'Dumpvalue' );
	22
	23	my $d;
	24	ok( $d = Dumpvalue->new(), 'create a new Dumpvalue object' );
	25
	26	$d->set( globPrint => 1, dumpReused => 1 );
	27	is( $d->{globPrint}, 1, 'set an option correctly' );
	28	is( $d->get('globPrint'), 1, 'get an option correctly' );
	29	is( $d->get('globPrint', 'dumpReused'), qw( 1 1 ), 'get multiple options' );
	30
	31	# check to see if unctrl works
	32	is( ref( Dumpvalue::unctrl(*FOO) ), 'GLOB', 'unctrl should not modify GLOB' );
	33	is( Dumpvalue::unctrl('donotchange'), 'donotchange', "unctrl shouldn't modify");
	34	like( Dumpvalue::unctrl("bo\007nd"), qr/bo\^.nd/, 'unctrl should escape' );
	35
	36	# check to see if stringify works
	37	is( $d->stringify(), 'undef', 'stringify handles undef okay' );
	38
	39	# the default is 1, but we want two single quotes
	40	$d->{printUndef} = 0;
	41	is( $d->stringify(), "''", 'stringify skips undef when asked nicely' );
	42
	43	is( $d->stringify(FOO), FOO . "", 'stringify stringifies globs alright' );
	44
	45	# check for double-quotes if there's an unprintable character
	46	$d->{tick} = 'auto';
	47	like( $d->stringify("hi\005"), qr/^"hi/, 'added double-quotes when necessary' );
	48
	49	# if no unprintable character, escape ticks or backslashes
	50	is( $d->stringify('hi'), "'hi'", 'used single-quotes when appropriate' );
	51
	52	# if 'unctrl' is set
	53	$d->{unctrl} = 'unctrl';
	54	like( $d->stringify('double and whack:\ "'), qr!\\ \"!, 'escaped with unctrl' );
	55	like( $d->stringify("a\005"), qr/^"a\^/, 'escaped ASCII value in unctrl' );
	56	like( $d->stringify("b\205"), qr!^'b.'$!, 'no high-bit escape value in unctrl');
	57
	58	$d->{quoteHighBit} = 1;
	59	like( $d->stringify("b\205"), qr!^'b\\205!, 'high-bit now escaped in unctrl');
	60
	61	# if 'quote' is set
	62	$d->{unctrl} = 'quote';
	63	is( $d->stringify('5@ $1'), "'5\@ \$1'", 'quoted $ and @ fine' );
	64	is( $d->stringify("5@\033\$1"), '"5\@\e\$1"', 'quoted $ and @ and \033 fine' );
	65	like( $d->stringify("\037"), qr/^"\\c/, 'escaped ASCII value okay' );
	66
	67	# add ticks, if necessary
	68	is( $d->stringify("no ticks", 1), 'no ticks', 'avoid ticks if asked' );
	69
	70	my $out = tie *OUT, 'TieOut';
	71	select(OUT);
	72
	73	# test DumpElem, it does its magic with veryCompact set
	74	$d->{veryCompact} = 1;
	75	$d->DumpElem([1, 2, 3]);
	76	is( $out->read, "0..2 1 2 3\n", 'DumpElem worked on array ref');
	77	$d->DumpElem({ one => 1, two => 2 });
	78	is( $out->read, "'one' => 1, 'two' => 2\n", 'DumpElem worked on hash ref' );
79	$d->DumpElem('hi');
80	is( $out->read, "'hi'\n", 'DumpElem worked on simple scalar' );
81	$d->{veryCompact} = 0;
82	$d->DumpElem([]);
83	like( $out->read, qr/ARRAY/, 'DumpElem okay with reference and no veryCompact');
84
85	# should compact simple arrays just fine
86	$d->{veryCompact} = 1;
87	$d->DumpElem([1, 2, 3]);
88	is( $out->read, "0..2 1 2 3\n", 'dumped array fine' );
89	$d->{arrayDepth} = 2;
90	$d->DumpElem([1, 2, 3]);
91	is( $out->read, "0..2 1 2 ...\n", 'dumped limited array fine' );
92
93	# should compact simple hashes just fine
94	$d->DumpElem({ a => 1, b => 2, c => 3 });
95	is( $out->read, "'a' => 1, 'b' => 2, 'c' => 3\n", 'dumped hash fine' );
96	$d->{hashDepth} = 2;
97	$d->DumpElem({ a => 1, b => 2, c => 3 });
98	is( $out->read, "'a' => 1, 'b' => 2 ...\n", 'dumped limited hash fine' );
99
100	# should just stringify what it is
101	$d->{veryCompact} = 0;
102	$d->DumpElem([]);
103	like( $out->read, qr/ARRAY.+empty array/s, 'stringified empty array ref' );
104	$d->DumpElem({});
105	like( $out->read, qr/HASH.+empty hash/s, 'stringified empty hash ref' );
106	$d->DumpElem(1);
107	is( $out->read, "1\n", 'stringified simple scalar' );
108
109	# test unwrap
110	$DB::signal = $d->{stopDbSignal} = 1;
111	is( $d->unwrap(), undef, 'unwrap returns if DB signal is set' );
112	undef $DB::signal;
113
114	my $foo = 7;
115	$d->{dumpReused} = 0;
116	$d->unwrap(\$foo);
117	is( $out->read, "-> 7\n", 'unwrap worked on scalar' );
118	$d->unwrap(\$foo);
119	is( $out->read, "-> REUSED_ADDRESS\n", 'unwrap worked on scalar' );
120	$d->unwrap({ one => 1 });
121
122	# leaving this at zero may cause some subsequent tests to fail
123	# if they reuse an address creating an anonymous variable
124	$d->{dumpReused} = 1;
125	is( $out->read, "'one' => 1\n", 'unwrap worked on hash' );
126	$d->unwrap([ 2, 3 ]);
127	is( $out->read, "0 2\n1 3\n", 'unwrap worked on array' );
128	$d->unwrap(*FOO);
129	is( $out->read, '', 'unwrap ignored glob on first try');
130	$d->unwrap(*FOO);
131	is( $out->read, "DUMPED_GLOB\n", 'unwrap worked on glob');
132	$d->unwrap(qr/foo(.+)/);
133	is( $out->read, "-> qr/(?-xism:foo(.+))/\n", 'unwrap worked on Regexp' );
134	$d->unwrap( sub {} );
135	like( $out->read, qr/^-> &CODE/, 'unwrap worked on sub ref' );
136
137	# test matchvar
138	# test to see if first arg 'eq' second
139	ok( Dumpvalue::matchvar(1, 1), 'matchvar matched numbers fine' );
140	ok( Dumpvalue::matchvar('hi', 'hi'), 'matchvar matched strings fine' );
141	ok( !Dumpvalue::matchvar('hello', 1), 'matchvar caught failed match fine' );
142
143	# test compactDump, which doesn't do much
144	is( $d->compactDump(3), 3, 'set compactDump to 3' );
145	is( $d->compactDump(1), 479, 'compactDump reset to 6*80-1 when less than 2' );
146
147	# test veryCompact, which does slightly more, setting compactDump sometimes
148	$d->{compactDump} = 0;
149	is( $d->veryCompact(1), 1, 'set veryCompact successfully' );
150	ok( $d->compactDump(), 'and it set compactDump as well' );
151
152	# test set_unctrl
153	$d->set_unctrl('impossible value');
154	like( $out->read, qr/^Unknown value/, 'set_unctrl caught bad value' );
155	is( $d->set_unctrl('quote'), 'quote', 'set quote fine' );
156	is( $d->set_unctrl(), 'quote', 'retrieved quote fine' );
157
158	# test set_quote
159	$d->set_quote('"');
160	is( $d->{tick}, '"', 'set_quote set tick right' );
161	is( $d->{unctrl}, 'quote', 'set unctrl right too' );
162	$d->set_quote('auto');
163	is( $d->{tick}, 'auto', 'set_quote set auto right' );
164	$d->set_quote('foo');
165	is( $d->{tick}, "'", 'default value set to " correctly' );
166
167	# test dumpglob
168	# should do nothing if debugger signal flag is raised
169	$d->{stopDbSignal} = $DB::signal = 1;
170	is( $d->dumpglob(*DB::signal), undef, 'returned early with DB signal set' );
171	undef $DB::signal;
172
173	# test dumping "normal" variables, this is a nasty glob trick
174	$foo = 1;
175	$d->dumpglob( '', 2, 'foo', local *foo = \$foo );
176	is( $out->read, " \$foo = 1\n", 'dumped glob for $foo correctly' );
177	@bar = (1, 2);
178
179	# the key name is a little different here
180	$d->dumpglob( '', 0, 'boo', *bar );
181	is( $out->read, "\@boo = (\n 0..1 1 2\n)\n", 'dumped glob for @bar fine' );
182
183	%baz = ( one => 1, two => 2 );
184	$d->dumpglob( '', 0, 'baz', *baz );
185	is( $out->read, "\%baz = (\n 'one' => 1, 'two' => 2\n)\n",
186	'dumped glob for %baz fine' );
187
188	SKIP: {
189	skip( "Couldn't open $0 for reading", 1 ) unless open(FILE, $0);
190	my $fileno = fileno(FILE);
191	$d->dumpglob( '', 0, 'FILE', *FILE );
192	is( $out->read, "FileHandle(FILE) => fileno($fileno)\n",
193	'dumped filehandle from glob fine' );
194	}
195
196	$d->dumpglob( '', 0, 'read', *TieOut::read );
197	is( $out->read, '', 'no sub dumped without $all set' );
198	$d->dumpglob( '', 0, 'read', \&TieOut::read, 1 );
199	is( $out->read, "&read in ???\n", 'sub dumped when requested' );
200
201	# see if it dumps DB-like values correctly
202	$d->{dumpDBFiles} = 1;
203	$d->dumpglob( '', 0, '_<foo', *foo );
204	is( $out->read, "\$_<foo = 1\n", 'dumped glob for $_<foo correctly (DB)' );
205
206	# test CvGV name
207	SKIP: {
af3f5016 MHM	208	if (" $Config::Config{'extensions'} " !~ m[ Devel/Peek ]) {
	209	skip( 'no Devel::Peek', 2 );
	210	}
	211	use_ok( 'Devel::Peek' );
8f90a6c7	212	is( $d->CvGV_name(\&TieOut::read), 'TieOut::read', 'CvGV_name found sub' );
	213	}
	214
	215	# test dumpsub
	216	$d->dumpsub( '', 'TieOut::read' );
	217	like( $out->read, qr/&TieOut::read in/, 'dumpsub found sub fine' );
	218
	219	# test findsubs
	220	is( $d->findsubs(), undef, 'findsubs returns nothing without %DB::sub' );
	221	$DB::sub{'TieOut::read'} = 'TieOut';
	222	is( $d->findsubs( \&TieOut::read ), 'TieOut::read', 'findsubs reported sub' );
	223
	224	# now that it's capable of finding the package...
	225	$d->dumpsub( '', 'TieOut::read' );
	226	is( $out->read, "&TieOut::read in TieOut\n", 'dumpsub found sub fine again' );
	227
	228	# this should print just a usage message
	229	$d->{usageOnly} = 1;
	230	$d->dumpvars( 'Fake', 'veryfake' );
	231	like( $out->read, qr/^String space:/, 'printed usage message fine' );
	232	delete $d->{usageOnly};
	233
	234	# this should report @INC and %INC
	235	$d->dumpvars( 'main', 'INC' );
	236	like( $out->read, qr/\@INC =/, 'dumped variables from a package' );
	237
	238	# this should report nothing
	239	$DB::signal = 1;
	240	$d->dumpvars( 'main', 'INC' );
	241	is( $out->read, '', 'no dump when $DB::signal is set' );
	242	undef $DB::signal;
	243
	244	is( $d->scalarUsage('12345'), 5, 'scalarUsage reports length correctly' );
	245	is( $d->arrayUsage( [1, 2, 3], 'a' ), 3, 'arrayUsage reports correct lengths' );
	246	is( $out->read, "\@a = 3 items (data: 3 bytes)\n", 'arrayUsage message okay' );
	247	is( $d->hashUsage({ one => 1 }, 'b'), 4, 'hashUsage reports correct lengths' );
	248	is( $out->read, "\%b = 1 item (keys: 3; values: 1; total: 4 bytes)\n",
	249	'hashUsage message okay' );
	250	is( $d->hashUsage({ one => [ 1, 2, 3 ]}, 'c'), 6, 'complex hash okay' );
	251	is( $out->read, "\%c = 1 item (keys: 3; values: 3; total: 6 bytes)\n",
	252	'hashUsage complex message okay' );
	253
	254	$foo = 'one';
	255	@foo = ('two');
	256	%foo = ( three => '123' );
	257	is( $d->globUsage(\*foo, 'foo'), 14, 'globUsage reports length correctly' );
	258	like( $out->read, qr/\@foo =.+\%foo =/s, 'globValue message okay' );
	259
	260	# and now, the real show
	261	$d->dumpValue(undef);
	262	is( $out->read, "undef\n", 'dumpValue caught undef value okay' );
	263	$d->dumpValue($foo);
	264	is( $out->read, "'one'\n", 'dumpValue worked' );
	265	$d->dumpValue(@foo);
	266	is( $out->read, "'two'\n", 'dumpValue worked on array' );
	267	$d->dumpValue(\$foo);
	268	is( $out->read, "-> 'one'\n", 'dumpValue worked on scalar ref' );
	269
	270	# dumpValues (the rest of these should be caught by unwrap)
	271	$d->dumpValues(undef);
	272	is( $out->read, "undef\n", 'dumpValues caught undef value fine' );
	273	$d->dumpValues(\@foo);
	274	is( $out->read, "0 0..0 'two'\n", 'dumpValues worked on array ref' );
	275	$d->dumpValues('one', 'two');
276	is( $out->read, "0..1 'one' 'two'\n", 'dumpValues worked on multiple values' );
277
278
279	package TieOut;
280	use overload '"' => sub { "overloaded!" };
281
282	sub TIEHANDLE {
283	my $class = shift;
284	bless(\( my $ref), $class);
285	}
286
287	sub PRINT {
288	my $self = shift;
289	$$self .= join('', @_);
290	}
291
292	sub read {
293	my $self = shift;
294	return substr($$self, 0, length($$self), '');
295	}