Dumpvalue.t revision 7c478bd95313f5f23a4c958a745db2134aa03244
#!./perl
BEGIN {
chdir 't' if -d 't';
print "1..0 # skip: EBCDIC\n";
exit 0;
}
}
my $d;
$d->set( globPrint => 1, dumpReused => 1 );
# check to see if unctrl works
# check to see if stringify works
# the default is 1, but we want two single quotes
$d->{printUndef} = 0;
# check for double-quotes if there's an unprintable character
$d->{tick} = 'auto';
# 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';
$d->{quoteHighBit} = 1;
like( $d->stringify("b\205"), qr!^'b\\205!, 'high-bit now escaped in unctrl');
# if 'quote' is set
$d->{unctrl} = 'quote';
# add ticks, if necessary
my $out = tie *OUT, 'TieOut';
select(OUT);
# test DumpElem, it does its magic with veryCompact set
$d->{veryCompact} = 1;
$d->DumpElem([1, 2, 3]);
$d->DumpElem({ one => 1, two => 2 });
$d->DumpElem('hi');
$d->{veryCompact} = 0;
$d->DumpElem([]);
# should compact simple arrays just fine
$d->{veryCompact} = 1;
$d->DumpElem([1, 2, 3]);
$d->{arrayDepth} = 2;
$d->DumpElem([1, 2, 3]);
# should compact simple hashes just fine
$d->DumpElem({ a => 1, b => 2, c => 3 });
$d->{hashDepth} = 2;
$d->DumpElem({ a => 1, b => 2, c => 3 });
# should just stringify what it is
$d->{veryCompact} = 0;
$d->DumpElem([]);
$d->DumpElem({});
$d->DumpElem(1);
# 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);
$d->unwrap(\$foo);
$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;
$d->unwrap([ 2, 3 ]);
$d->unwrap(*FOO);
is( $out->read, '', 'unwrap ignored glob on first try');
$d->unwrap(*FOO);
$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');
# 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;
$foo = 1;
$d->dumpglob( '', 2, 'foo', local *foo = \$foo );
@bar = (1, 2);
# the key name is a little different here
$d->dumpglob( '', 0, 'boo', *bar );
%baz = ( one => 1, two => 2 );
$d->dumpglob( '', 0, 'baz', *baz );
'dumped glob for %baz fine' );
SKIP: {
my $fileno = fileno(FILE);
is( $out->read, "FileHandle(FILE) => fileno($fileno)\n",
}
$d->dumpglob( '', 0, 'read', *TieOut::read );
$d->dumpglob( '', 0, 'read', \&TieOut::read, 1 );
# see if it dumps DB-like values correctly
$d->{dumpDBFiles} = 1;
# test CvGV name
SKIP: {
}
# test dumpsub
# test findsubs
# this should print just a usage message
$d->{usageOnly} = 1;
# this should report @INC and %INC
# this should report nothing
'hashUsage message okay' );
'hashUsage complex message okay' );
# and now, the real show
# dumpValues (the rest of these should be caught by unwrap)
sub TIEHANDLE {
my $class = shift;
}
sub PRINT {
my $self = shift;
}
sub read {
my $self = shift;
}