1 #!./perl -- -*- mode: cperl; cperl-indent-level: 4 -*-
15 @prgs = split "########\n", <DATA>;
21 plan tests => scalar @prgs;
25 sub unctrl { print dumpvar::unctrl($_[0]), "\n" }
26 sub uniescape { print dumpvar::uniescape($_[0]), "\n" }
27 sub stringify { print dumpvar::stringify($_[0]), "\n" }
29 # Call main::dumpValue exactly as the perl5db.pl calls it.
34 &main::dumpValue(\@params,-1);
39 sub new { my $class = shift; bless [ @_ ], $class }
43 sub new { my $class = shift; bless [ @_ ], $class }
45 use overload '""' => sub { "Bar<@{$_[0]}>" };
49 my $foo = Foo->new(1..5);
50 my $bar = Bar->new(1..5);
53 my($prog, $expected) = split(/\nEXPECT\n?/, $_);
54 # TODO: dumpvar::stringify() is controlled by a pile of package
55 # dumpvar variables: $printUndef, $unctrl, $quoteHighBit, $bareStringify,
56 # and so forth. We need to test with various settings of those.
57 my $out = tie *STDOUT, 'TieOut';
62 ok(0, "$prog - $ERR");
64 if ($expected =~ m:^/:) {
65 like($$out, $expected, $prog);
67 is($$out, $expected, $prog);
75 bless( \(my $self), $_[0] );
80 $$self .= join('', @_);
85 substr( $$self, 0, length($$self), '' );
101 uniescape("\x{100}");
123 /^'SCALAR\(0x[0-9a-f]+\)'$/i
127 /^'ARRAY\(0x[0-9a-f]+\)'$/i
131 /^'HASH\(0x[0-9a-f]+\)'$/i
135 /^'CODE\(0x[0-9a-f]+\)'$/i
139 /^'GLOB\(0x[0-9a-f]+\)'$/i
143 /^'Foo=ARRAY\(0x[0-9a-f]+\)'$/i
147 /^'Bar=ARRAY\(0x[0-9a-f]+\)'$/i
161 dumpValue("\x{100}");
165 dumpValue("1\n2\n3");
233 dumpvalue("\x{100}");
247 /0 SCALAR\(0x[0-9a-f]+\)\n -> undef\n/i
251 /0 REF\(0x[0-9a-f]+\)\n -> SCALAR\(0x[0-9a-f]+\)\n -> undef\n/i
255 /0 ARRAY\(0x[0-9a-f]+\)\n empty array/i
259 /0 HASH\(0x[0-9a-f]+\)\n\s+empty hash/i
263 /0 CODE\(0x[0-9a-f]+\)\n -> &CODE\(0x[0-9a-f]+\) in /i
267 /0 GLOB\(0x[0-9a-f]+\)\n -> \*main::a\n/i
271 /0 Foo=ARRAY\(0x[0-9a-f]+\)\n 0 1\n 1 2\n 2 3\n 3 4\n 4 5\n/i
275 /0 Bar=ARRAY\(0x[0-9a-f]+\)\n 0 1\n 1 2\n 2 3\n 3 4\n 4 5\n/i
283 /0 ARRAY\(0x[0-9a-f]+\)\n 0 1\n 1 2\n 2 3\n 3 4\n/i
287 /0 HASH\(0x[0-9a-f]+\)\n 1 => 2\n 3 => 4\n/i
289 dumpvalue({1=>2,3=>4});
291 /0 HASH\(0x[0-9a-f]+\)\n 1 => 2\n 3 => 4\n/i
293 dumpvalue({a=>1,b=>2});
295 /0 HASH\(0x[0-9a-f]+\)\n 'a' => 1\n 'b' => 2\n/i
297 dumpvalue([{a=>[1,2,3],b=>{c=>1,d=>2}},{e=>{f=>1,g=>2},h=>[qw(i j k)]}]);
299 /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
301 dumpvalue({reverse map {$_=>1} sort qw(the quick brown fox)})
303 /0 HASH\(0x[0-9a-f]+\)\n 1 => 'brown'\n/i
305 my @x=qw(a b c); dumpvalue(\@x);
307 /0 ARRAY\(0x[0-9a-f]+\)\n 0 'a'\n 1 'b'\n 2 'c'\n/i
309 my %x=(a=>1, b=>2); dumpvalue(\%x);
311 /0 HASH\(0x[0-9a-f]+\)\n 'a' => 1\n 'b' => 2\n/i