1*0Sstevel@tonic-gate#!./perl -- -*- mode: cperl; cperl-indent-level: 4 -*- 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gateBEGIN { 4*0Sstevel@tonic-gate chdir 't' if -d 't'; 5*0Sstevel@tonic-gate @INC = '../lib'; 6*0Sstevel@tonic-gate} 7*0Sstevel@tonic-gate 8*0Sstevel@tonic-gateuse strict; 9*0Sstevel@tonic-gate 10*0Sstevel@tonic-gate$|=1; 11*0Sstevel@tonic-gate 12*0Sstevel@tonic-gatemy @prgs; 13*0Sstevel@tonic-gate{ 14*0Sstevel@tonic-gate local $/; 15*0Sstevel@tonic-gate @prgs = split "########\n", <DATA>; 16*0Sstevel@tonic-gate close DATA; 17*0Sstevel@tonic-gate} 18*0Sstevel@tonic-gate 19*0Sstevel@tonic-gateuse Test::More; 20*0Sstevel@tonic-gate 21*0Sstevel@tonic-gateplan tests => scalar @prgs; 22*0Sstevel@tonic-gate 23*0Sstevel@tonic-gaterequire "dumpvar.pl"; 24*0Sstevel@tonic-gate 25*0Sstevel@tonic-gatesub unctrl { print dumpvar::unctrl($_[0]), "\n" } 26*0Sstevel@tonic-gatesub uniescape { print dumpvar::uniescape($_[0]), "\n" } 27*0Sstevel@tonic-gatesub stringify { print dumpvar::stringify($_[0]), "\n" } 28*0Sstevel@tonic-gatesub dumpvalue { 29*0Sstevel@tonic-gate # Call main::dumpValue exactly as the perl5db.pl calls it. 30*0Sstevel@tonic-gate local $\ = ''; 31*0Sstevel@tonic-gate local $, = ''; 32*0Sstevel@tonic-gate local $" = ' '; 33*0Sstevel@tonic-gate my @params = @_; 34*0Sstevel@tonic-gate &main::dumpValue(\@params,-1); 35*0Sstevel@tonic-gate} 36*0Sstevel@tonic-gate 37*0Sstevel@tonic-gatepackage Foo; 38*0Sstevel@tonic-gate 39*0Sstevel@tonic-gatesub new { my $class = shift; bless [ @_ ], $class } 40*0Sstevel@tonic-gate 41*0Sstevel@tonic-gatepackage Bar; 42*0Sstevel@tonic-gate 43*0Sstevel@tonic-gatesub new { my $class = shift; bless [ @_ ], $class } 44*0Sstevel@tonic-gate 45*0Sstevel@tonic-gateuse overload '""' => sub { "Bar<@{$_[0]}>" }; 46*0Sstevel@tonic-gate 47*0Sstevel@tonic-gatepackage main; 48*0Sstevel@tonic-gate 49*0Sstevel@tonic-gatemy $foo = Foo->new(1..5); 50*0Sstevel@tonic-gatemy $bar = Bar->new(1..5); 51*0Sstevel@tonic-gate 52*0Sstevel@tonic-gatefor (@prgs) { 53*0Sstevel@tonic-gate my($prog, $expected) = split(/\nEXPECT\n?/, $_); 54*0Sstevel@tonic-gate # TODO: dumpvar::stringify() is controlled by a pile of package 55*0Sstevel@tonic-gate # dumpvar variables: $printUndef, $unctrl, $quoteHighBit, $bareStringify, 56*0Sstevel@tonic-gate # and so forth. We need to test with various settings of those. 57*0Sstevel@tonic-gate my $out = tie *STDOUT, 'TieOut'; 58*0Sstevel@tonic-gate eval $prog; 59*0Sstevel@tonic-gate my $ERR = $@; 60*0Sstevel@tonic-gate untie $out; 61*0Sstevel@tonic-gate if ($ERR) { 62*0Sstevel@tonic-gate ok(0, "$prog - $ERR"); 63*0Sstevel@tonic-gate } else { 64*0Sstevel@tonic-gate if ($expected =~ m:^/:) { 65*0Sstevel@tonic-gate like($$out, $expected, $prog); 66*0Sstevel@tonic-gate } else { 67*0Sstevel@tonic-gate is($$out, $expected, $prog); 68*0Sstevel@tonic-gate } 69*0Sstevel@tonic-gate } 70*0Sstevel@tonic-gate} 71*0Sstevel@tonic-gate 72*0Sstevel@tonic-gatepackage TieOut; 73*0Sstevel@tonic-gate 74*0Sstevel@tonic-gatesub TIEHANDLE { 75*0Sstevel@tonic-gate bless( \(my $self), $_[0] ); 76*0Sstevel@tonic-gate} 77*0Sstevel@tonic-gate 78*0Sstevel@tonic-gatesub PRINT { 79*0Sstevel@tonic-gate my $self = shift; 80*0Sstevel@tonic-gate $$self .= join('', @_); 81*0Sstevel@tonic-gate} 82*0Sstevel@tonic-gate 83*0Sstevel@tonic-gatesub read { 84*0Sstevel@tonic-gate my $self = shift; 85*0Sstevel@tonic-gate substr( $$self, 0, length($$self), '' ); 86*0Sstevel@tonic-gate} 87*0Sstevel@tonic-gate 88*0Sstevel@tonic-gate__END__ 89*0Sstevel@tonic-gateunctrl("A"); 90*0Sstevel@tonic-gateEXPECT 91*0Sstevel@tonic-gateA 92*0Sstevel@tonic-gate######## 93*0Sstevel@tonic-gateunctrl("\cA"); 94*0Sstevel@tonic-gateEXPECT 95*0Sstevel@tonic-gate^A 96*0Sstevel@tonic-gate######## 97*0Sstevel@tonic-gateuniescape("A"); 98*0Sstevel@tonic-gateEXPECT 99*0Sstevel@tonic-gateA 100*0Sstevel@tonic-gate######## 101*0Sstevel@tonic-gateuniescape("\x{100}"); 102*0Sstevel@tonic-gateEXPECT 103*0Sstevel@tonic-gate\x{0100} 104*0Sstevel@tonic-gate######## 105*0Sstevel@tonic-gatestringify(undef); 106*0Sstevel@tonic-gateEXPECT 107*0Sstevel@tonic-gateundef 108*0Sstevel@tonic-gate######## 109*0Sstevel@tonic-gatestringify("foo"); 110*0Sstevel@tonic-gateEXPECT 111*0Sstevel@tonic-gate'foo' 112*0Sstevel@tonic-gate######## 113*0Sstevel@tonic-gatestringify("\cA"); 114*0Sstevel@tonic-gateEXPECT 115*0Sstevel@tonic-gate"\cA" 116*0Sstevel@tonic-gate######## 117*0Sstevel@tonic-gatestringify(*a); 118*0Sstevel@tonic-gateEXPECT 119*0Sstevel@tonic-gate*main::a 120*0Sstevel@tonic-gate######## 121*0Sstevel@tonic-gatestringify(\undef); 122*0Sstevel@tonic-gateEXPECT 123*0Sstevel@tonic-gate/^'SCALAR\(0x[0-9a-f]+\)'$/i 124*0Sstevel@tonic-gate######## 125*0Sstevel@tonic-gatestringify([]); 126*0Sstevel@tonic-gateEXPECT 127*0Sstevel@tonic-gate/^'ARRAY\(0x[0-9a-f]+\)'$/i 128*0Sstevel@tonic-gate######## 129*0Sstevel@tonic-gatestringify({}); 130*0Sstevel@tonic-gateEXPECT 131*0Sstevel@tonic-gate/^'HASH\(0x[0-9a-f]+\)'$/i 132*0Sstevel@tonic-gate######## 133*0Sstevel@tonic-gatestringify(sub{}); 134*0Sstevel@tonic-gateEXPECT 135*0Sstevel@tonic-gate/^'CODE\(0x[0-9a-f]+\)'$/i 136*0Sstevel@tonic-gate######## 137*0Sstevel@tonic-gatestringify(\*a); 138*0Sstevel@tonic-gateEXPECT 139*0Sstevel@tonic-gate/^'GLOB\(0x[0-9a-f]+\)'$/i 140*0Sstevel@tonic-gate######## 141*0Sstevel@tonic-gatestringify($foo); 142*0Sstevel@tonic-gateEXPECT 143*0Sstevel@tonic-gate/^'Foo=ARRAY\(0x[0-9a-f]+\)'$/i 144*0Sstevel@tonic-gate######## 145*0Sstevel@tonic-gatestringify($bar); 146*0Sstevel@tonic-gateEXPECT 147*0Sstevel@tonic-gate/^'Bar=ARRAY\(0x[0-9a-f]+\)'$/i 148*0Sstevel@tonic-gate######## 149*0Sstevel@tonic-gatedumpValue(undef); 150*0Sstevel@tonic-gateEXPECT 151*0Sstevel@tonic-gateundef 152*0Sstevel@tonic-gate######## 153*0Sstevel@tonic-gatedumpValue(1); 154*0Sstevel@tonic-gateEXPECT 155*0Sstevel@tonic-gate1 156*0Sstevel@tonic-gate######## 157*0Sstevel@tonic-gatedumpValue("\cA"); 158*0Sstevel@tonic-gateEXPECT 159*0Sstevel@tonic-gate"\cA" 160*0Sstevel@tonic-gate######## 161*0Sstevel@tonic-gatedumpValue("\x{100}"); 162*0Sstevel@tonic-gateEXPECT 163*0Sstevel@tonic-gate'\x{0100}' 164*0Sstevel@tonic-gate######## 165*0Sstevel@tonic-gatedumpValue("1\n2\n3"); 166*0Sstevel@tonic-gateEXPECT 167*0Sstevel@tonic-gate'1 168*0Sstevel@tonic-gate2 169*0Sstevel@tonic-gate3' 170*0Sstevel@tonic-gate######## 171*0Sstevel@tonic-gatedumpValue([1..3],1); 172*0Sstevel@tonic-gateEXPECT 173*0Sstevel@tonic-gate0 1 174*0Sstevel@tonic-gate1 2 175*0Sstevel@tonic-gate2 3 176*0Sstevel@tonic-gate######## 177*0Sstevel@tonic-gatedumpValue([1..3]); 178*0Sstevel@tonic-gateEXPECT 179*0Sstevel@tonic-gate0 1 180*0Sstevel@tonic-gate1 2 181*0Sstevel@tonic-gate2 3 182*0Sstevel@tonic-gate######## 183*0Sstevel@tonic-gatedumpValue({1..4},1); 184*0Sstevel@tonic-gateEXPECT 185*0Sstevel@tonic-gate1 => 2 186*0Sstevel@tonic-gate3 => 4 187*0Sstevel@tonic-gate######## 188*0Sstevel@tonic-gatedumpValue({1..4}); 189*0Sstevel@tonic-gateEXPECT 190*0Sstevel@tonic-gate1 => 2 191*0Sstevel@tonic-gate3 => 4 192*0Sstevel@tonic-gate######## 193*0Sstevel@tonic-gatedumpValue($foo,1); 194*0Sstevel@tonic-gateEXPECT 195*0Sstevel@tonic-gate0 1 196*0Sstevel@tonic-gate1 2 197*0Sstevel@tonic-gate2 3 198*0Sstevel@tonic-gate3 4 199*0Sstevel@tonic-gate4 5 200*0Sstevel@tonic-gate######## 201*0Sstevel@tonic-gatedumpValue($foo); 202*0Sstevel@tonic-gateEXPECT 203*0Sstevel@tonic-gate0 1 204*0Sstevel@tonic-gate1 2 205*0Sstevel@tonic-gate2 3 206*0Sstevel@tonic-gate3 4 207*0Sstevel@tonic-gate4 5 208*0Sstevel@tonic-gate######## 209*0Sstevel@tonic-gatedumpValue($bar,1); 210*0Sstevel@tonic-gateEXPECT 211*0Sstevel@tonic-gate0 1 212*0Sstevel@tonic-gate1 2 213*0Sstevel@tonic-gate2 3 214*0Sstevel@tonic-gate3 4 215*0Sstevel@tonic-gate4 5 216*0Sstevel@tonic-gate######## 217*0Sstevel@tonic-gatedumpValue($bar); 218*0Sstevel@tonic-gateEXPECT 219*0Sstevel@tonic-gate0 1 220*0Sstevel@tonic-gate1 2 221*0Sstevel@tonic-gate2 3 222*0Sstevel@tonic-gate3 4 223*0Sstevel@tonic-gate4 5 224*0Sstevel@tonic-gate######## 225*0Sstevel@tonic-gatedumpvalue("a"); 226*0Sstevel@tonic-gateEXPECT 227*0Sstevel@tonic-gate0 'a' 228*0Sstevel@tonic-gate######## 229*0Sstevel@tonic-gatedumpvalue("\cA"); 230*0Sstevel@tonic-gateEXPECT 231*0Sstevel@tonic-gate0 "\cA" 232*0Sstevel@tonic-gate######## 233*0Sstevel@tonic-gatedumpvalue("\x{100}"); 234*0Sstevel@tonic-gateEXPECT 235*0Sstevel@tonic-gate0 '\x{0100}' 236*0Sstevel@tonic-gate######## 237*0Sstevel@tonic-gatedumpvalue(undef); 238*0Sstevel@tonic-gateEXPECT 239*0Sstevel@tonic-gate0 undef 240*0Sstevel@tonic-gate######## 241*0Sstevel@tonic-gatedumpvalue("foo"); 242*0Sstevel@tonic-gateEXPECT 243*0Sstevel@tonic-gate0 'foo' 244*0Sstevel@tonic-gate######## 245*0Sstevel@tonic-gatedumpvalue(\undef); 246*0Sstevel@tonic-gateEXPECT 247*0Sstevel@tonic-gate/0 SCALAR\(0x[0-9a-f]+\)\n -> undef\n/i 248*0Sstevel@tonic-gate######## 249*0Sstevel@tonic-gatedumpvalue(\\undef); 250*0Sstevel@tonic-gateEXPECT 251*0Sstevel@tonic-gate/0 REF\(0x[0-9a-f]+\)\n -> SCALAR\(0x[0-9a-f]+\)\n -> undef\n/i 252*0Sstevel@tonic-gate######## 253*0Sstevel@tonic-gatedumpvalue([]); 254*0Sstevel@tonic-gateEXPECT 255*0Sstevel@tonic-gate/0 ARRAY\(0x[0-9a-f]+\)\n empty array/i 256*0Sstevel@tonic-gate######## 257*0Sstevel@tonic-gatedumpvalue({}); 258*0Sstevel@tonic-gateEXPECT 259*0Sstevel@tonic-gate/0 HASH\(0x[0-9a-f]+\)\n\s+empty hash/i 260*0Sstevel@tonic-gate######## 261*0Sstevel@tonic-gatedumpvalue(sub{}); 262*0Sstevel@tonic-gateEXPECT 263*0Sstevel@tonic-gate/0 CODE\(0x[0-9a-f]+\)\n -> &CODE\(0x[0-9a-f]+\) in /i 264*0Sstevel@tonic-gate######## 265*0Sstevel@tonic-gatedumpvalue(\*a); 266*0Sstevel@tonic-gateEXPECT 267*0Sstevel@tonic-gate/0 GLOB\(0x[0-9a-f]+\)\n -> \*main::a\n/i 268*0Sstevel@tonic-gate######## 269*0Sstevel@tonic-gatedumpvalue($foo); 270*0Sstevel@tonic-gateEXPECT 271*0Sstevel@tonic-gate/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*0Sstevel@tonic-gate######## 273*0Sstevel@tonic-gatedumpvalue($bar); 274*0Sstevel@tonic-gateEXPECT 275*0Sstevel@tonic-gate/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*0Sstevel@tonic-gate######## 277*0Sstevel@tonic-gatedumpvalue("1\n2\n3") 278*0Sstevel@tonic-gateEXPECT 279*0Sstevel@tonic-gate/0 '1\n2\n3'\n/i 280*0Sstevel@tonic-gate######## 281*0Sstevel@tonic-gatedumpvalue([1..4]); 282*0Sstevel@tonic-gateEXPECT 283*0Sstevel@tonic-gate/0 ARRAY\(0x[0-9a-f]+\)\n 0 1\n 1 2\n 2 3\n 3 4\n/i 284*0Sstevel@tonic-gate######## 285*0Sstevel@tonic-gatedumpvalue({1..4}); 286*0Sstevel@tonic-gateEXPECT 287*0Sstevel@tonic-gate/0 HASH\(0x[0-9a-f]+\)\n 1 => 2\n 3 => 4\n/i 288*0Sstevel@tonic-gate######## 289*0Sstevel@tonic-gatedumpvalue({1=>2,3=>4}); 290*0Sstevel@tonic-gateEXPECT 291*0Sstevel@tonic-gate/0 HASH\(0x[0-9a-f]+\)\n 1 => 2\n 3 => 4\n/i 292*0Sstevel@tonic-gate######## 293*0Sstevel@tonic-gatedumpvalue({a=>1,b=>2}); 294*0Sstevel@tonic-gateEXPECT 295*0Sstevel@tonic-gate/0 HASH\(0x[0-9a-f]+\)\n 'a' => 1\n 'b' => 2\n/i 296*0Sstevel@tonic-gate######## 297*0Sstevel@tonic-gatedumpvalue([{a=>[1,2,3],b=>{c=>1,d=>2}},{e=>{f=>1,g=>2},h=>[qw(i j k)]}]); 298*0Sstevel@tonic-gateEXPECT 299*0Sstevel@tonic-gate/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*0Sstevel@tonic-gate######## 301*0Sstevel@tonic-gatedumpvalue({reverse map {$_=>1} sort qw(the quick brown fox)}) 302*0Sstevel@tonic-gateEXPECT 303*0Sstevel@tonic-gate/0 HASH\(0x[0-9a-f]+\)\n 1 => 'brown'\n/i 304*0Sstevel@tonic-gate######## 305*0Sstevel@tonic-gatemy @x=qw(a b c); dumpvalue(\@x); 306*0Sstevel@tonic-gateEXPECT 307*0Sstevel@tonic-gate/0 ARRAY\(0x[0-9a-f]+\)\n 0 'a'\n 1 'b'\n 2 'c'\n/i 308*0Sstevel@tonic-gate######## 309*0Sstevel@tonic-gatemy %x=(a=>1, b=>2); dumpvalue(\%x); 310*0Sstevel@tonic-gateEXPECT 311*0Sstevel@tonic-gate/0 HASH\(0x[0-9a-f]+\)\n 'a' => 1\n 'b' => 2\n/i 312