dumpvar.t revision 7c478bd95313f5f23a4c958a745db2134aa03244
#!./perl -- -*- mode: cperl; cperl-indent-level: 4 -*-
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
}
use strict;
$|=1;
my @prgs;
{
local $/;
@prgs = split "########\n", <DATA>;
close DATA;
}
use Test::More;
plan tests => scalar @prgs;
require "dumpvar.pl";
sub unctrl { print dumpvar::unctrl($_[0]), "\n" }
sub uniescape { print dumpvar::uniescape($_[0]), "\n" }
sub stringify { print dumpvar::stringify($_[0]), "\n" }
sub dumpvalue {
# Call main::dumpValue exactly as the perl5db.pl calls it.
local $\ = '';
local $, = '';
local $" = ' ';
my @params = @_;
&main::dumpValue(\@params,-1);
}
package Foo;
sub new { my $class = shift; bless [ @_ ], $class }
package Bar;
sub new { my $class = shift; bless [ @_ ], $class }
use overload '""' => sub { "Bar<@{$_[0]}>" };
package main;
my $foo = Foo->new(1..5);
my $bar = Bar->new(1..5);
for (@prgs) {
my($prog, $expected) = split(/\nEXPECT\n?/, $_);
# TODO: dumpvar::stringify() is controlled by a pile of package
# dumpvar variables: $printUndef, $unctrl, $quoteHighBit, $bareStringify,
# and so forth. We need to test with various settings of those.
my $out = tie *STDOUT, 'TieOut';
eval $prog;
my $ERR = $@;
untie $out;
if ($ERR) {
ok(0, "$prog - $ERR");
} else {
if ($expected =~ m:^/:) {
like($$out, $expected, $prog);
} else {
is($$out, $expected, $prog);
}
}
}
package TieOut;
sub TIEHANDLE {
bless( \(my $self), $_[0] );
}
sub PRINT {
my $self = shift;
$$self .= join('', @_);
}
sub read {
my $self = shift;
substr( $$self, 0, length($$self), '' );
}
__END__
unctrl("A");
EXPECT
A
########
unctrl("\cA");
EXPECT
^A
########
uniescape("A");
EXPECT
A
########
uniescape("\x{100}");
EXPECT
\x{0100}
########
stringify(undef);
EXPECT
undef
########
stringify("foo");
EXPECT
'foo'
########
stringify("\cA");
EXPECT
"\cA"
########
stringify(*a);
EXPECT
*main::a
########
stringify(\undef);
EXPECT
/^'SCALAR\(0x[0-9a-f]+\)'$/i
########
stringify([]);
EXPECT
/^'ARRAY\(0x[0-9a-f]+\)'$/i
########
stringify({});
EXPECT
/^'HASH\(0x[0-9a-f]+\)'$/i
########
stringify(sub{});
EXPECT
/^'CODE\(0x[0-9a-f]+\)'$/i
########
stringify(\*a);
EXPECT
/^'GLOB\(0x[0-9a-f]+\)'$/i
########
stringify($foo);
EXPECT
/^'Foo=ARRAY\(0x[0-9a-f]+\)'$/i
########
stringify($bar);
EXPECT
/^'Bar=ARRAY\(0x[0-9a-f]+\)'$/i
########
dumpValue(undef);
EXPECT
undef
########
dumpValue(1);
EXPECT
1
########
dumpValue("\cA");
EXPECT
"\cA"
########
dumpValue("\x{100}");
EXPECT
'\x{0100}'
########
dumpValue("1\n2\n3");
EXPECT
'1
2
3'
########
dumpValue([1..3],1);
EXPECT
0 1
1 2
2 3
########
dumpValue([1..3]);
EXPECT
0 1
1 2
2 3
########
dumpValue({1..4},1);
EXPECT
1 => 2
3 => 4
########
dumpValue({1..4});
EXPECT
1 => 2
3 => 4
########
dumpValue($foo,1);
EXPECT
0 1
1 2
2 3
3 4
4 5
########
dumpValue($foo);
EXPECT
0 1
1 2
2 3
3 4
4 5
########
dumpValue($bar,1);
EXPECT
0 1
1 2
2 3
3 4
4 5
########
dumpValue($bar);
EXPECT
0 1
1 2
2 3
3 4
4 5
########
dumpvalue("a");
EXPECT
0 'a'
########
dumpvalue("\cA");
EXPECT
0 "\cA"
########
dumpvalue("\x{100}");
EXPECT
0 '\x{0100}'
########
dumpvalue(undef);
EXPECT
0 undef
########
dumpvalue("foo");
EXPECT
0 'foo'
########
dumpvalue(\undef);
EXPECT
/0 SCALAR\(0x[0-9a-f]+\)\n -> undef\n/i
########
dumpvalue(\\undef);
EXPECT
/0 REF\(0x[0-9a-f]+\)\n -> SCALAR\(0x[0-9a-f]+\)\n -> undef\n/i
########
dumpvalue([]);
EXPECT
/0 ARRAY\(0x[0-9a-f]+\)\n empty array/i
########
dumpvalue({});
EXPECT
/0 HASH\(0x[0-9a-f]+\)\n\s+empty hash/i
########
dumpvalue(sub{});
EXPECT
/0 CODE\(0x[0-9a-f]+\)\n -> &CODE\(0x[0-9a-f]+\) in /i
########
dumpvalue(\*a);
EXPECT
/0 GLOB\(0x[0-9a-f]+\)\n -> \*main::a\n/i
########
dumpvalue($foo);
EXPECT
/0 Foo=ARRAY\(0x[0-9a-f]+\)\n 0 1\n 1 2\n 2 3\n 3 4\n 4 5\n/i
########
dumpvalue($bar);
EXPECT
/0 Bar=ARRAY\(0x[0-9a-f]+\)\n 0 1\n 1 2\n 2 3\n 3 4\n 4 5\n/i
########
dumpvalue("1\n2\n3")
EXPECT
/0 '1\n2\n3'\n/i
########
dumpvalue([1..4]);
EXPECT
/0 ARRAY\(0x[0-9a-f]+\)\n 0 1\n 1 2\n 2 3\n 3 4\n/i
########
dumpvalue({1..4});
EXPECT
/0 HASH\(0x[0-9a-f]+\)\n 1 => 2\n 3 => 4\n/i
########
dumpvalue({1=>2,3=>4});
EXPECT
/0 HASH\(0x[0-9a-f]+\)\n 1 => 2\n 3 => 4\n/i
########
dumpvalue({a=>1,b=>2});
EXPECT
/0 HASH\(0x[0-9a-f]+\)\n 'a' => 1\n 'b' => 2\n/i
########
dumpvalue([{a=>[1,2,3],b=>{c=>1,d=>2}},{e=>{f=>1,g=>2},h=>[qw(i j k)]}]);
EXPECT
/0 ARRAY\(0x[0-9a-f]+\)\n 0 HASH\(0x[0-9a-f]+\)\n 'a' => ARRAY\(0x[0-9a-f]+\)\n 0 1\n 1 2\n 2 3\n 'b' => HASH\(0x[0-9a-f]+\)\n 'c' => 1\n 'd' => 2\n 1 HASH\(0x[0-9a-f]+\)\n 'e' => HASH\(0x[0-9a-f]+\)\n 'f' => 1\n 'g' => 2\n 'h' => ARRAY\(0x[0-9a-f]+\)\n 0 'i'\n 1 'j'\n 2 'k'/i
########
dumpvalue({reverse map {$_=>1} sort qw(the quick brown fox)})
EXPECT
/0 HASH\(0x[0-9a-f]+\)\n 1 => 'brown'\n/i
########
my @x=qw(a b c); dumpvalue(\@x);
EXPECT
/0 ARRAY\(0x[0-9a-f]+\)\n 0 'a'\n 1 'b'\n 2 'c'\n/i
########
my %x=(a=>1, b=>2); dumpvalue(\%x);
EXPECT
/0 HASH\(0x[0-9a-f]+\)\n 'a' => 1\n 'b' => 2\n/i