1#!./perl -- -*- mode: cperl; cperl-indent-level: 4 -*- 2 3BEGIN { 4 chdir 't' if -d 't'; 5 @INC = '../lib'; 6 require Config; 7 if (($Config::Config{'extensions'} !~ m!\bList/Util\b!) ){ 8 print "1..0 # Skip -- Perl configured without List::Util module\n"; 9 exit 0; 10 } 11} 12 13use strict; 14 15$|=1; 16 17my @prgs; 18{ 19 local $/; 20 @prgs = split "########\n", <DATA>; 21 close DATA; 22} 23 24use Test::More; 25 26plan tests => scalar @prgs; 27 28require "dumpvar.pl"; 29 30sub unctrl { print dumpvar::unctrl($_[0]), "\n" } 31sub uniescape { print dumpvar::uniescape($_[0]), "\n" } 32sub stringify { print dumpvar::stringify($_[0]), "\n" } 33sub dumpvalue { 34 # Call main::dumpValue exactly as the perl5db.pl calls it. 35 local $\ = ''; 36 local $, = ''; 37 local $" = ' '; 38 my @params = @_; 39 &main::dumpValue(\@params,-1); 40} 41 42package Foo; 43 44sub new { my $class = shift; bless [ @_ ], $class } 45 46package Bar; 47 48sub new { my $class = shift; bless [ @_ ], $class } 49 50use overload '""' => sub { "Bar<@{$_[0]}>" }; 51 52package main; 53 54my $foo = Foo->new(1..5); 55my $bar = Bar->new(1..5); 56 57for (@prgs) { 58 my($prog, $expected) = split(/\nEXPECT\n?/, $_); 59 # TODO: dumpvar::stringify() is controlled by a pile of package 60 # dumpvar variables: $printUndef, $unctrl, $quoteHighBit, $bareStringify, 61 # and so forth. We need to test with various settings of those. 62 my $out = tie *STDOUT, 'TieOut'; 63 eval $prog; 64 my $ERR = $@; 65 untie $out; 66 if ($ERR) { 67 ok(0, "$prog - $ERR"); 68 } else { 69 if ($expected =~ m:^/:) { 70 like($$out, $expected, $prog); 71 } else { 72 is($$out, $expected, $prog); 73 } 74 } 75} 76 77package TieOut; 78 79sub TIEHANDLE { 80 bless( \(my $self), $_[0] ); 81} 82 83sub PRINT { 84 my $self = shift; 85 $$self .= join('', @_); 86} 87 88sub read { 89 my $self = shift; 90 substr( $$self, 0, length($$self), '' ); 91} 92 93__END__ 94unctrl("A"); 95EXPECT 96A 97######## 98unctrl("\cA"); 99EXPECT 100^A 101######## 102uniescape("A"); 103EXPECT 104A 105######## 106uniescape("\x{100}"); 107EXPECT 108\x{0100} 109######## 110stringify(undef); 111EXPECT 112undef 113######## 114stringify("foo"); 115EXPECT 116'foo' 117######## 118stringify("\cA"); 119EXPECT 120"\cA" 121######## 122stringify(*a); 123EXPECT 124*main::a 125######## 126stringify(\undef); 127EXPECT 128/^'SCALAR\(0x[0-9a-f]+\)'$/i 129######## 130stringify([]); 131EXPECT 132/^'ARRAY\(0x[0-9a-f]+\)'$/i 133######## 134stringify({}); 135EXPECT 136/^'HASH\(0x[0-9a-f]+\)'$/i 137######## 138stringify(sub{}); 139EXPECT 140/^'CODE\(0x[0-9a-f]+\)'$/i 141######## 142stringify(\*a); 143EXPECT 144/^'GLOB\(0x[0-9a-f]+\)'$/i 145######## 146stringify($foo); 147EXPECT 148/^'Foo=ARRAY\(0x[0-9a-f]+\)'$/i 149######## 150stringify($bar); 151EXPECT 152/^'Bar=ARRAY\(0x[0-9a-f]+\)'$/i 153######## 154dumpValue(undef); 155EXPECT 156undef 157######## 158dumpValue(1); 159EXPECT 1601 161######## 162dumpValue("\cA"); 163EXPECT 164"\cA" 165######## 166dumpValue("\x{100}"); 167EXPECT 168'\x{0100}' 169######## 170dumpValue("1\n2\n3"); 171EXPECT 172'1 1732 1743' 175######## 176dumpValue([1..3],1); 177EXPECT 1780 1 1791 2 1802 3 181######## 182dumpValue([1..3]); 183EXPECT 1840 1 1851 2 1862 3 187######## 188dumpValue({1..4},1); 189EXPECT 1901 => 2 1913 => 4 192######## 193dumpValue({1..4}); 194EXPECT 1951 => 2 1963 => 4 197######## 198dumpValue($foo,1); 199EXPECT 2000 1 2011 2 2022 3 2033 4 2044 5 205######## 206dumpValue($foo); 207EXPECT 2080 1 2091 2 2102 3 2113 4 2124 5 213######## 214dumpValue($bar,1); 215EXPECT 2160 1 2171 2 2182 3 2193 4 2204 5 221######## 222dumpValue($bar); 223EXPECT 2240 1 2251 2 2262 3 2273 4 2284 5 229######## 230dumpvalue("a"); 231EXPECT 2320 'a' 233######## 234dumpvalue("\cA"); 235EXPECT 2360 "\cA" 237######## 238dumpvalue("\x{100}"); 239EXPECT 2400 '\x{0100}' 241######## 242dumpvalue(undef); 243EXPECT 2440 undef 245######## 246dumpvalue("foo"); 247EXPECT 2480 'foo' 249######## 250dumpvalue(\undef); 251EXPECT 252/0 SCALAR\(0x[0-9a-f]+\)\n -> undef\n/i 253######## 254dumpvalue(\\undef); 255EXPECT 256/0 REF\(0x[0-9a-f]+\)\n -> SCALAR\(0x[0-9a-f]+\)\n -> undef\n/i 257######## 258dumpvalue([]); 259EXPECT 260/0 ARRAY\(0x[0-9a-f]+\)\n empty array/i 261######## 262dumpvalue({}); 263EXPECT 264/0 HASH\(0x[0-9a-f]+\)\n\s+empty hash/i 265######## 266dumpvalue(sub{}); 267EXPECT 268/0 CODE\(0x[0-9a-f]+\)\n -> &CODE\(0x[0-9a-f]+\) in /i 269######## 270dumpvalue(\*a); 271EXPECT 272/0 GLOB\(0x[0-9a-f]+\)\n -> \*main::a\n/i 273######## 274dumpvalue($foo); 275EXPECT 276/0 Foo=ARRAY\(0x[0-9a-f]+\)\n 0 1\n 1 2\n 2 3\n 3 4\n 4 5\n/i 277######## 278dumpvalue($bar); 279EXPECT 280/0 Bar=ARRAY\(0x[0-9a-f]+\)\n 0 1\n 1 2\n 2 3\n 3 4\n 4 5\n/i 281######## 282dumpvalue("1\n2\n3") 283EXPECT 284/0 '1\n2\n3'\n/i 285######## 286dumpvalue([1..4]); 287EXPECT 288/0 ARRAY\(0x[0-9a-f]+\)\n 0 1\n 1 2\n 2 3\n 3 4\n/i 289######## 290dumpvalue({1..4}); 291EXPECT 292/0 HASH\(0x[0-9a-f]+\)\n 1 => 2\n 3 => 4\n/i 293######## 294dumpvalue({1=>2,3=>4}); 295EXPECT 296/0 HASH\(0x[0-9a-f]+\)\n 1 => 2\n 3 => 4\n/i 297######## 298dumpvalue({a=>1,b=>2}); 299EXPECT 300/0 HASH\(0x[0-9a-f]+\)\n 'a' => 1\n 'b' => 2\n/i 301######## 302dumpvalue([{a=>[1,2,3],b=>{c=>1,d=>2}},{e=>{f=>1,g=>2},h=>[qw(i j k)]}]); 303EXPECT 304/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 305######## 306dumpvalue({reverse map {$_=>1} sort qw(the quick brown fox)}) 307EXPECT 308/0 HASH\(0x[0-9a-f]+\)\n 1 => 'brown'\n/i 309######## 310my @x=qw(a b c); dumpvalue(\@x); 311EXPECT 312/0 ARRAY\(0x[0-9a-f]+\)\n 0 'a'\n 1 'b'\n 2 'c'\n/i 313######## 314my %x=(a=>1, b=>2); dumpvalue(\%x); 315EXPECT 316/0 HASH\(0x[0-9a-f]+\)\n 'a' => 1\n 'b' => 2\n/i 317