1#!./perl -- -*- mode: cperl; cperl-indent-level: 4 -*- 2 3BEGIN { 4 chdir 't' if -d 't'; 5 @INC = '../lib'; 6} 7 8use strict; 9 10$|=1; 11 12my @prgs; 13{ 14 local $/; 15 @prgs = split "########\n", <DATA>; 16 close DATA; 17} 18 19use Test::More; 20 21plan tests => scalar @prgs; 22 23require "dumpvar.pl"; 24 25sub unctrl { print dumpvar::unctrl($_[0]), "\n" } 26sub uniescape { print dumpvar::uniescape($_[0]), "\n" } 27sub stringify { print dumpvar::stringify($_[0]), "\n" } 28sub dumpvalue { 29 # Call main::dumpValue exactly as the perl5db.pl calls it. 30 local $\ = ''; 31 local $, = ''; 32 local $" = ' '; 33 my @params = @_; 34 &main::dumpValue(\@params,-1); 35} 36 37package Foo; 38 39sub new { my $class = shift; bless [ @_ ], $class } 40 41package Bar; 42 43sub new { my $class = shift; bless [ @_ ], $class } 44 45use overload '""' => sub { "Bar<@{$_[0]}>" }; 46 47package main; 48 49my $foo = Foo->new(1..5); 50my $bar = Bar->new(1..5); 51 52for (@prgs) { 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'; 58 eval $prog; 59 my $ERR = $@; 60 untie $out; 61 if ($ERR) { 62 ok(0, "$prog - $ERR"); 63 } else { 64 if ($expected =~ m:^/:) { 65 like($$out, $expected, $prog); 66 } else { 67 is($$out, $expected, $prog); 68 } 69 } 70} 71 72package TieOut; 73 74sub TIEHANDLE { 75 bless( \(my $self), $_[0] ); 76} 77 78sub PRINT { 79 my $self = shift; 80 $$self .= join('', @_); 81} 82 83sub read { 84 my $self = shift; 85 substr( $$self, 0, length($$self), '' ); 86} 87 88__END__ 89unctrl("A"); 90EXPECT 91A 92######## 93unctrl("\cA"); 94EXPECT 95^A 96######## 97uniescape("A"); 98EXPECT 99A 100######## 101uniescape("\x{100}"); 102EXPECT 103\x{0100} 104######## 105stringify(undef); 106EXPECT 107undef 108######## 109stringify("foo"); 110EXPECT 111'foo' 112######## 113stringify("\cA"); 114EXPECT 115"\cA" 116######## 117stringify(*a); 118EXPECT 119*main::a 120######## 121stringify(\undef); 122EXPECT 123/^'SCALAR\(0x[0-9a-f]+\)'$/i 124######## 125stringify([]); 126EXPECT 127/^'ARRAY\(0x[0-9a-f]+\)'$/i 128######## 129stringify({}); 130EXPECT 131/^'HASH\(0x[0-9a-f]+\)'$/i 132######## 133stringify(sub{}); 134EXPECT 135/^'CODE\(0x[0-9a-f]+\)'$/i 136######## 137stringify(\*a); 138EXPECT 139/^'GLOB\(0x[0-9a-f]+\)'$/i 140######## 141stringify($foo); 142EXPECT 143/^'Foo=ARRAY\(0x[0-9a-f]+\)'$/i 144######## 145stringify($bar); 146EXPECT 147/^'Bar=ARRAY\(0x[0-9a-f]+\)'$/i 148######## 149dumpValue(undef); 150EXPECT 151undef 152######## 153dumpValue(1); 154EXPECT 1551 156######## 157dumpValue("\cA"); 158EXPECT 159"\cA" 160######## 161dumpValue("\x{100}"); 162EXPECT 163'\x{0100}' 164######## 165dumpValue("1\n2\n3"); 166EXPECT 167'1 1682 1693' 170######## 171dumpValue([1..3],1); 172EXPECT 1730 1 1741 2 1752 3 176######## 177dumpValue([1..3]); 178EXPECT 1790 1 1801 2 1812 3 182######## 183dumpValue({1..4},1); 184EXPECT 1851 => 2 1863 => 4 187######## 188dumpValue({1..4}); 189EXPECT 1901 => 2 1913 => 4 192######## 193dumpValue($foo,1); 194EXPECT 1950 1 1961 2 1972 3 1983 4 1994 5 200######## 201dumpValue($foo); 202EXPECT 2030 1 2041 2 2052 3 2063 4 2074 5 208######## 209dumpValue($bar,1); 210EXPECT 2110 1 2121 2 2132 3 2143 4 2154 5 216######## 217dumpValue($bar); 218EXPECT 2190 1 2201 2 2212 3 2223 4 2234 5 224######## 225dumpvalue("a"); 226EXPECT 2270 'a' 228######## 229dumpvalue("\cA"); 230EXPECT 2310 "\cA" 232######## 233dumpvalue("\x{100}"); 234EXPECT 2350 '\x{0100}' 236######## 237dumpvalue(undef); 238EXPECT 2390 undef 240######## 241dumpvalue("foo"); 242EXPECT 2430 'foo' 244######## 245dumpvalue(\undef); 246EXPECT 247/0 SCALAR\(0x[0-9a-f]+\)\n -> undef\n/i 248######## 249dumpvalue(\\undef); 250EXPECT 251/0 REF\(0x[0-9a-f]+\)\n -> SCALAR\(0x[0-9a-f]+\)\n -> undef\n/i 252######## 253dumpvalue([]); 254EXPECT 255/0 ARRAY\(0x[0-9a-f]+\)\n empty array/i 256######## 257dumpvalue({}); 258EXPECT 259/0 HASH\(0x[0-9a-f]+\)\n\s+empty hash/i 260######## 261dumpvalue(sub{}); 262EXPECT 263/0 CODE\(0x[0-9a-f]+\)\n -> &CODE\(0x[0-9a-f]+\) in /i 264######## 265dumpvalue(\*a); 266EXPECT 267/0 GLOB\(0x[0-9a-f]+\)\n -> \*main::a\n/i 268######## 269dumpvalue($foo); 270EXPECT 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 272######## 273dumpvalue($bar); 274EXPECT 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 276######## 277dumpvalue("1\n2\n3") 278EXPECT 279/0 '1\n2\n3'\n/i 280######## 281dumpvalue([1..4]); 282EXPECT 283/0 ARRAY\(0x[0-9a-f]+\)\n 0 1\n 1 2\n 2 3\n 3 4\n/i 284######## 285dumpvalue({1..4}); 286EXPECT 287/0 HASH\(0x[0-9a-f]+\)\n 1 => 2\n 3 => 4\n/i 288######## 289dumpvalue({1=>2,3=>4}); 290EXPECT 291/0 HASH\(0x[0-9a-f]+\)\n 1 => 2\n 3 => 4\n/i 292######## 293dumpvalue({a=>1,b=>2}); 294EXPECT 295/0 HASH\(0x[0-9a-f]+\)\n 'a' => 1\n 'b' => 2\n/i 296######## 297dumpvalue([{a=>[1,2,3],b=>{c=>1,d=>2}},{e=>{f=>1,g=>2},h=>[qw(i j k)]}]); 298EXPECT 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 300######## 301dumpvalue({reverse map {$_=>1} sort qw(the quick brown fox)}) 302EXPECT 303/0 HASH\(0x[0-9a-f]+\)\n 1 => 'brown'\n/i 304######## 305my @x=qw(a b c); dumpvalue(\@x); 306EXPECT 307/0 ARRAY\(0x[0-9a-f]+\)\n 0 'a'\n 1 'b'\n 2 'c'\n/i 308######## 309my %x=(a=>1, b=>2); dumpvalue(\%x); 310EXPECT 311/0 HASH\(0x[0-9a-f]+\)\n 'a' => 1\n 'b' => 2\n/i 312