1b39c5158Smillert#!./perl -w 2b39c5158Smillert# 3b39c5158Smillert# testsuite for Data::Dumper 4b39c5158Smillert# 5b39c5158Smillert 6b39c5158SmillertBEGIN { 7b39c5158Smillert require Config; import Config; 8b39c5158Smillert if ($Config{'extensions'} !~ /\bData\/Dumper\b/) { 9b39c5158Smillert print "1..0 # Skip: Data::Dumper was not built\n"; 10b39c5158Smillert exit 0; 11b39c5158Smillert } 12b39c5158Smillert} 13b39c5158Smillert 14b39c5158Smillert# Since Perl 5.8.1 because otherwise hash ordering is really random. 15b39c5158Smillertlocal $Data::Dumper::Sortkeys = 1; 16b39c5158Smillert 17b39c5158Smillertuse Data::Dumper; 18b39c5158Smillertuse Config; 19b39c5158Smillertmy $Is_ebcdic = defined($Config{'ebcdic'}) && $Config{'ebcdic'} eq 'define'; 20b39c5158Smillert 21b39c5158Smillert$Data::Dumper::Pad = "#"; 22b39c5158Smillertmy $TMAX; 23b39c5158Smillertmy $XS; 24b39c5158Smillertmy $TNUM = 0; 25b39c5158Smillertmy $WANT = ''; 26b39c5158Smillert 27b39c5158Smillertsub TEST { 28b39c5158Smillert my $string = shift; 29b39c5158Smillert my $name = shift; 30b39c5158Smillert my $t = eval $string; 31b39c5158Smillert ++$TNUM; 32b39c5158Smillert $t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g 33b39c5158Smillert if ($WANT =~ /deadbeef/); 34b39c5158Smillert if ($Is_ebcdic) { 35b39c5158Smillert # these data need massaging with non ascii character sets 36b39c5158Smillert # because of hashing order differences 37b39c5158Smillert $WANT = join("\n",sort(split(/\n/,$WANT))); 38b39c5158Smillert $WANT =~ s/\,$//mg; 39b39c5158Smillert $t = join("\n",sort(split(/\n/,$t))); 40b39c5158Smillert $t =~ s/\,$//mg; 41b39c5158Smillert } 42b39c5158Smillert $name = $name ? " - $name" : ''; 43b39c5158Smillert print( ($t eq $WANT and not $@) ? "ok $TNUM$name\n" 44b39c5158Smillert : "not ok $TNUM$name\n--Expected--\n$WANT\n--Got--\n$@$t\n"); 45b39c5158Smillert 46b39c5158Smillert ++$TNUM; 47b39c5158Smillert if ($Is_ebcdic) { # EBCDIC. 48b39c5158Smillert if ($TNUM == 311 || $TNUM == 314) { 49b39c5158Smillert eval $string; 50b39c5158Smillert } else { 51b39c5158Smillert eval $t; 52b39c5158Smillert } 53b39c5158Smillert } else { 54b39c5158Smillert eval "$t"; 55b39c5158Smillert } 56b39c5158Smillert print $@ ? "not ok $TNUM\n# \$@ says: $@\n" : "ok $TNUM\n"; 57b39c5158Smillert 58b39c5158Smillert $t = eval $string; 59b39c5158Smillert ++$TNUM; 60b39c5158Smillert $t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g 61b39c5158Smillert if ($WANT =~ /deadbeef/); 62b39c5158Smillert if ($Is_ebcdic) { 63b39c5158Smillert # here too there are hashing order differences 64b39c5158Smillert $WANT = join("\n",sort(split(/\n/,$WANT))); 65b39c5158Smillert $WANT =~ s/\,$//mg; 66b39c5158Smillert $t = join("\n",sort(split(/\n/,$t))); 67b39c5158Smillert $t =~ s/\,$//mg; 68b39c5158Smillert } 69b39c5158Smillert print( ($t eq $WANT and not $@) ? "ok $TNUM\n" 70b39c5158Smillert : "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n"); 71b39c5158Smillert} 72b39c5158Smillert 73b39c5158Smillertsub SKIP_TEST { 74b39c5158Smillert my $reason = shift; 75b39c5158Smillert ++$TNUM; print "ok $TNUM # skip $reason\n"; 76b39c5158Smillert ++$TNUM; print "ok $TNUM # skip $reason\n"; 77b39c5158Smillert ++$TNUM; print "ok $TNUM # skip $reason\n"; 78b39c5158Smillert} 79b39c5158Smillert 80b39c5158Smillert# Force Data::Dumper::Dump to use perl. We test Dumpxs explicitly by calling 81b39c5158Smillert# it direct. Out here it lets us knobble the next if to test that the perl 82b39c5158Smillert# only tests do work (and count correctly) 83b39c5158Smillert$Data::Dumper::Useperl = 1; 84b39c5158Smillertif (defined &Data::Dumper::Dumpxs) { 85b39c5158Smillert print "### XS extension loaded, will run XS tests\n"; 86*91f110e0Safresh1 $TMAX = 402; $XS = 1; 87b39c5158Smillert} 88b39c5158Smillertelse { 89b39c5158Smillert print "### XS extensions not loaded, will NOT run XS tests\n"; 90*91f110e0Safresh1 $TMAX = 201; $XS = 0; 91b39c5158Smillert} 92b39c5158Smillert 93b39c5158Smillertprint "1..$TMAX\n"; 94b39c5158Smillert 95b39c5158Smillert#XXXif (0) { 96b39c5158Smillert############# 97b39c5158Smillert############# 98b39c5158Smillert 99b39c5158Smillert@c = ('c'); 100b39c5158Smillert$c = \@c; 101b39c5158Smillert$b = {}; 102b39c5158Smillert$a = [1, $b, $c]; 103b39c5158Smillert$b->{a} = $a; 104b39c5158Smillert$b->{b} = $a->[1]; 105b39c5158Smillert$b->{c} = $a->[2]; 106b39c5158Smillert 107b39c5158Smillert############# 1 108b39c5158Smillert## 109b39c5158Smillert$WANT = <<'EOT'; 110b39c5158Smillert#$a = [ 111b39c5158Smillert# 1, 112b39c5158Smillert# { 113b39c5158Smillert# 'a' => $a, 114b39c5158Smillert# 'b' => $a->[1], 115b39c5158Smillert# 'c' => [ 116b39c5158Smillert# 'c' 117b39c5158Smillert# ] 118b39c5158Smillert# }, 119b39c5158Smillert# $a->[1]{'c'} 120b39c5158Smillert# ]; 121b39c5158Smillert#$b = $a->[1]; 122b39c5158Smillert#$6 = $a->[1]{'c'}; 123b39c5158SmillertEOT 124b39c5158Smillert 125b39c5158SmillertTEST q(Data::Dumper->Dump([$a,$b,$c], [qw(a b), 6])); 126b39c5158SmillertTEST q(Data::Dumper->Dumpxs([$a,$b,$c], [qw(a b), 6])) if $XS; 127b39c5158Smillert 128*91f110e0Safresh1SCOPE: { 129*91f110e0Safresh1 local $Data::Dumper::Sparseseen = 1; 130*91f110e0Safresh1 TEST q(Data::Dumper->Dump([$a,$b,$c], [qw(a b), 6])); 131*91f110e0Safresh1 TEST q(Data::Dumper->Dumpxs([$a,$b,$c], [qw(a b), 6])) if $XS; 132*91f110e0Safresh1} 133b39c5158Smillert 134b39c5158Smillert############# 7 135b39c5158Smillert## 136b39c5158Smillert$WANT = <<'EOT'; 137b39c5158Smillert#@a = ( 138b39c5158Smillert# 1, 139b39c5158Smillert# { 140b39c5158Smillert# 'a' => [], 141b39c5158Smillert# 'b' => {}, 142b39c5158Smillert# 'c' => [ 143b39c5158Smillert# 'c' 144b39c5158Smillert# ] 145b39c5158Smillert# }, 146b39c5158Smillert# [] 147b39c5158Smillert# ); 148b39c5158Smillert#$a[1]{'a'} = \@a; 149b39c5158Smillert#$a[1]{'b'} = $a[1]; 150b39c5158Smillert#$a[2] = $a[1]{'c'}; 151b39c5158Smillert#$b = $a[1]; 152b39c5158SmillertEOT 153b39c5158Smillert 154b39c5158Smillert$Data::Dumper::Purity = 1; # fill in the holes for eval 155b39c5158SmillertTEST q(Data::Dumper->Dump([$a, $b], [qw(*a b)])); # print as @a 156b39c5158SmillertTEST q(Data::Dumper->Dumpxs([$a, $b], [qw(*a b)])) if $XS; 157b39c5158Smillert 158*91f110e0Safresh1SCOPE: { 159*91f110e0Safresh1 local $Data::Dumper::Sparseseen = 1; 160*91f110e0Safresh1 TEST q(Data::Dumper->Dump([$a, $b], [qw(*a b)])); # print as @a 161*91f110e0Safresh1 TEST q(Data::Dumper->Dumpxs([$a, $b], [qw(*a b)])) if $XS; 162*91f110e0Safresh1} 163*91f110e0Safresh1 164b39c5158Smillert############# 13 165b39c5158Smillert## 166b39c5158Smillert$WANT = <<'EOT'; 167b39c5158Smillert#%b = ( 168b39c5158Smillert# 'a' => [ 169b39c5158Smillert# 1, 170b39c5158Smillert# {}, 171b39c5158Smillert# [ 172b39c5158Smillert# 'c' 173b39c5158Smillert# ] 174b39c5158Smillert# ], 175b39c5158Smillert# 'b' => {}, 176b39c5158Smillert# 'c' => [] 177b39c5158Smillert# ); 178b39c5158Smillert#$b{'a'}[1] = \%b; 179b39c5158Smillert#$b{'b'} = \%b; 180b39c5158Smillert#$b{'c'} = $b{'a'}[2]; 181b39c5158Smillert#$a = $b{'a'}; 182b39c5158SmillertEOT 183b39c5158Smillert 184b39c5158SmillertTEST q(Data::Dumper->Dump([$b, $a], [qw(*b a)])); # print as %b 185b39c5158SmillertTEST q(Data::Dumper->Dumpxs([$b, $a], [qw(*b a)])) if $XS; 186b39c5158Smillert 187b39c5158Smillert############# 19 188b39c5158Smillert## 189b39c5158Smillert$WANT = <<'EOT'; 190b39c5158Smillert#$a = [ 191b39c5158Smillert# 1, 192b39c5158Smillert# { 193b39c5158Smillert# 'a' => [], 194b39c5158Smillert# 'b' => {}, 195b39c5158Smillert# 'c' => [] 196b39c5158Smillert# }, 197b39c5158Smillert# [] 198b39c5158Smillert#]; 199b39c5158Smillert#$a->[1]{'a'} = $a; 200b39c5158Smillert#$a->[1]{'b'} = $a->[1]; 201b39c5158Smillert#$a->[1]{'c'} = \@c; 202b39c5158Smillert#$a->[2] = \@c; 203b39c5158Smillert#$b = $a->[1]; 204b39c5158SmillertEOT 205b39c5158Smillert 206b39c5158Smillert$Data::Dumper::Indent = 1; 207b39c5158SmillertTEST q( 208b39c5158Smillert $d = Data::Dumper->new([$a,$b], [qw(a b)]); 209b39c5158Smillert $d->Seen({'*c' => $c}); 210b39c5158Smillert $d->Dump; 211b39c5158Smillert ); 212b39c5158Smillertif ($XS) { 213b39c5158Smillert TEST q( 214b39c5158Smillert $d = Data::Dumper->new([$a,$b], [qw(a b)]); 215b39c5158Smillert $d->Seen({'*c' => $c}); 216b39c5158Smillert $d->Dumpxs; 217b39c5158Smillert ); 218b39c5158Smillert} 219b39c5158Smillert 220b39c5158Smillert 221b39c5158Smillert############# 25 222b39c5158Smillert## 223b39c5158Smillert$WANT = <<'EOT'; 224b39c5158Smillert#$a = [ 225b39c5158Smillert# #0 226b39c5158Smillert# 1, 227b39c5158Smillert# #1 228b39c5158Smillert# { 229b39c5158Smillert# a => $a, 230b39c5158Smillert# b => $a->[1], 231b39c5158Smillert# c => [ 232b39c5158Smillert# #0 233b39c5158Smillert# 'c' 234b39c5158Smillert# ] 235b39c5158Smillert# }, 236b39c5158Smillert# #2 237b39c5158Smillert# $a->[1]{c} 238b39c5158Smillert# ]; 239b39c5158Smillert#$b = $a->[1]; 240b39c5158SmillertEOT 241b39c5158Smillert 242b39c5158Smillert$d->Indent(3); 243b39c5158Smillert$d->Purity(0)->Quotekeys(0); 244b39c5158SmillertTEST q( $d->Reset; $d->Dump ); 245b39c5158Smillert 246b39c5158SmillertTEST q( $d->Reset; $d->Dumpxs ) if $XS; 247b39c5158Smillert 248b39c5158Smillert############# 31 249b39c5158Smillert## 250b39c5158Smillert$WANT = <<'EOT'; 251b39c5158Smillert#$VAR1 = [ 252b39c5158Smillert# 1, 253b39c5158Smillert# { 254b39c5158Smillert# 'a' => [], 255b39c5158Smillert# 'b' => {}, 256b39c5158Smillert# 'c' => [ 257b39c5158Smillert# 'c' 258b39c5158Smillert# ] 259b39c5158Smillert# }, 260b39c5158Smillert# [] 261b39c5158Smillert#]; 262b39c5158Smillert#$VAR1->[1]{'a'} = $VAR1; 263b39c5158Smillert#$VAR1->[1]{'b'} = $VAR1->[1]; 264b39c5158Smillert#$VAR1->[2] = $VAR1->[1]{'c'}; 265b39c5158SmillertEOT 266b39c5158Smillert 267b39c5158SmillertTEST q(Dumper($a)); 268b39c5158SmillertTEST q(Data::Dumper::DumperX($a)) if $XS; 269b39c5158Smillert 270b39c5158Smillert############# 37 271b39c5158Smillert## 272b39c5158Smillert$WANT = <<'EOT'; 273b39c5158Smillert#[ 274b39c5158Smillert# 1, 275b39c5158Smillert# { 276b39c5158Smillert# a => $VAR1, 277b39c5158Smillert# b => $VAR1->[1], 278b39c5158Smillert# c => [ 279b39c5158Smillert# 'c' 280b39c5158Smillert# ] 281b39c5158Smillert# }, 282b39c5158Smillert# $VAR1->[1]{c} 283b39c5158Smillert#] 284b39c5158SmillertEOT 285b39c5158Smillert 286b39c5158Smillert{ 287b39c5158Smillert local $Data::Dumper::Purity = 0; 288b39c5158Smillert local $Data::Dumper::Quotekeys = 0; 289b39c5158Smillert local $Data::Dumper::Terse = 1; 290b39c5158Smillert TEST q(Dumper($a)); 291b39c5158Smillert TEST q(Data::Dumper::DumperX($a)) if $XS; 292b39c5158Smillert} 293b39c5158Smillert 294b39c5158Smillert 295b39c5158Smillert############# 43 296b39c5158Smillert## 297b39c5158Smillert$WANT = <<'EOT'; 298b39c5158Smillert#$VAR1 = { 299b39c5158Smillert# "abc\0'\efg" => "mno\0", 300b39c5158Smillert# "reftest" => \\1 301b39c5158Smillert#}; 302b39c5158SmillertEOT 303b39c5158Smillert 304b39c5158Smillert$foo = { "abc\000\'\efg" => "mno\000", 305b39c5158Smillert "reftest" => \\1, 306b39c5158Smillert }; 307b39c5158Smillert{ 308b39c5158Smillert local $Data::Dumper::Useqq = 1; 309b39c5158Smillert TEST q(Dumper($foo)); 310b39c5158Smillert} 311b39c5158Smillert 312b39c5158Smillert $WANT = <<"EOT"; 313b39c5158Smillert#\$VAR1 = { 314b39c5158Smillert# 'abc\0\\'\efg' => 'mno\0', 315b39c5158Smillert# 'reftest' => \\\\1 316b39c5158Smillert#}; 317b39c5158SmillertEOT 318b39c5158Smillert 319b39c5158Smillert { 320b39c5158Smillert local $Data::Dumper::Useqq = 1; 321b39c5158Smillert TEST q(Data::Dumper::DumperX($foo)) if $XS; # cheat 322b39c5158Smillert } 323b39c5158Smillert 324b39c5158Smillert 325b39c5158Smillert 326b39c5158Smillert############# 327b39c5158Smillert############# 328b39c5158Smillert 329b39c5158Smillert{ 330b39c5158Smillert package main; 331b39c5158Smillert use Data::Dumper; 332b39c5158Smillert $foo = 5; 333b39c5158Smillert @foo = (-10,\*foo); 334b39c5158Smillert %foo = (a=>1,b=>\$foo,c=>\@foo); 335b39c5158Smillert $foo{d} = \%foo; 336b39c5158Smillert $foo[2] = \%foo; 337b39c5158Smillert 338b39c5158Smillert############# 49 339b39c5158Smillert## 340b39c5158Smillert $WANT = <<'EOT'; 341b39c5158Smillert#$foo = \*::foo; 342b39c5158Smillert#*::foo = \5; 343b39c5158Smillert#*::foo = [ 344b39c5158Smillert# #0 345b39c5158Smillert# -10, 346b39c5158Smillert# #1 347b39c5158Smillert# do{my $o}, 348b39c5158Smillert# #2 349b39c5158Smillert# { 350b39c5158Smillert# 'a' => 1, 351b39c5158Smillert# 'b' => do{my $o}, 352b39c5158Smillert# 'c' => [], 353b39c5158Smillert# 'd' => {} 354b39c5158Smillert# } 355b39c5158Smillert# ]; 356b39c5158Smillert#*::foo{ARRAY}->[1] = $foo; 357b39c5158Smillert#*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR}; 358b39c5158Smillert#*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY}; 359b39c5158Smillert#*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2]; 360b39c5158Smillert#*::foo = *::foo{ARRAY}->[2]; 361b39c5158Smillert#@bar = @{*::foo{ARRAY}}; 362b39c5158Smillert#%baz = %{*::foo{ARRAY}->[2]}; 363b39c5158SmillertEOT 364b39c5158Smillert 365b39c5158Smillert $Data::Dumper::Purity = 1; 366b39c5158Smillert $Data::Dumper::Indent = 3; 367b39c5158Smillert TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])); 368b39c5158Smillert TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])) if $XS; 369b39c5158Smillert 370b39c5158Smillert############# 55 371b39c5158Smillert## 372b39c5158Smillert $WANT = <<'EOT'; 373b39c5158Smillert#$foo = \*::foo; 374b39c5158Smillert#*::foo = \5; 375b39c5158Smillert#*::foo = [ 376b39c5158Smillert# -10, 377b39c5158Smillert# do{my $o}, 378b39c5158Smillert# { 379b39c5158Smillert# 'a' => 1, 380b39c5158Smillert# 'b' => do{my $o}, 381b39c5158Smillert# 'c' => [], 382b39c5158Smillert# 'd' => {} 383b39c5158Smillert# } 384b39c5158Smillert#]; 385b39c5158Smillert#*::foo{ARRAY}->[1] = $foo; 386b39c5158Smillert#*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR}; 387b39c5158Smillert#*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY}; 388b39c5158Smillert#*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2]; 389b39c5158Smillert#*::foo = *::foo{ARRAY}->[2]; 390b39c5158Smillert#$bar = *::foo{ARRAY}; 391b39c5158Smillert#$baz = *::foo{ARRAY}->[2]; 392b39c5158SmillertEOT 393b39c5158Smillert 394b39c5158Smillert $Data::Dumper::Indent = 1; 395b39c5158Smillert TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])); 396b39c5158Smillert TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])) if $XS; 397b39c5158Smillert 398b39c5158Smillert############# 61 399b39c5158Smillert## 400b39c5158Smillert $WANT = <<'EOT'; 401b39c5158Smillert#@bar = ( 402b39c5158Smillert# -10, 403b39c5158Smillert# \*::foo, 404b39c5158Smillert# {} 405b39c5158Smillert#); 406b39c5158Smillert#*::foo = \5; 407b39c5158Smillert#*::foo = \@bar; 408b39c5158Smillert#*::foo = { 409b39c5158Smillert# 'a' => 1, 410b39c5158Smillert# 'b' => do{my $o}, 411b39c5158Smillert# 'c' => [], 412b39c5158Smillert# 'd' => {} 413b39c5158Smillert#}; 414b39c5158Smillert#*::foo{HASH}->{'b'} = *::foo{SCALAR}; 415b39c5158Smillert#*::foo{HASH}->{'c'} = \@bar; 416b39c5158Smillert#*::foo{HASH}->{'d'} = *::foo{HASH}; 417b39c5158Smillert#$bar[2] = *::foo{HASH}; 418b39c5158Smillert#%baz = %{*::foo{HASH}}; 419b39c5158Smillert#$foo = $bar[1]; 420b39c5158SmillertEOT 421b39c5158Smillert 422b39c5158Smillert TEST q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo'])); 423b39c5158Smillert TEST q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo'])) if $XS; 424b39c5158Smillert 425b39c5158Smillert############# 67 426b39c5158Smillert## 427b39c5158Smillert $WANT = <<'EOT'; 428b39c5158Smillert#$bar = [ 429b39c5158Smillert# -10, 430b39c5158Smillert# \*::foo, 431b39c5158Smillert# {} 432b39c5158Smillert#]; 433b39c5158Smillert#*::foo = \5; 434b39c5158Smillert#*::foo = $bar; 435b39c5158Smillert#*::foo = { 436b39c5158Smillert# 'a' => 1, 437b39c5158Smillert# 'b' => do{my $o}, 438b39c5158Smillert# 'c' => [], 439b39c5158Smillert# 'd' => {} 440b39c5158Smillert#}; 441b39c5158Smillert#*::foo{HASH}->{'b'} = *::foo{SCALAR}; 442b39c5158Smillert#*::foo{HASH}->{'c'} = $bar; 443b39c5158Smillert#*::foo{HASH}->{'d'} = *::foo{HASH}; 444b39c5158Smillert#$bar->[2] = *::foo{HASH}; 445b39c5158Smillert#$baz = *::foo{HASH}; 446b39c5158Smillert#$foo = $bar->[1]; 447b39c5158SmillertEOT 448b39c5158Smillert 449b39c5158Smillert TEST q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo'])); 450b39c5158Smillert TEST q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo'])) if $XS; 451b39c5158Smillert 452b39c5158Smillert############# 73 453b39c5158Smillert## 454b39c5158Smillert $WANT = <<'EOT'; 455b39c5158Smillert#$foo = \*::foo; 456b39c5158Smillert#@bar = ( 457b39c5158Smillert# -10, 458b39c5158Smillert# $foo, 459b39c5158Smillert# { 460b39c5158Smillert# a => 1, 461b39c5158Smillert# b => \5, 462b39c5158Smillert# c => \@bar, 463b39c5158Smillert# d => $bar[2] 464b39c5158Smillert# } 465b39c5158Smillert#); 466b39c5158Smillert#%baz = %{$bar[2]}; 467b39c5158SmillertEOT 468b39c5158Smillert 469b39c5158Smillert $Data::Dumper::Purity = 0; 470b39c5158Smillert $Data::Dumper::Quotekeys = 0; 471b39c5158Smillert TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])); 472b39c5158Smillert TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])) if $XS; 473b39c5158Smillert 474b39c5158Smillert############# 79 475b39c5158Smillert## 476b39c5158Smillert $WANT = <<'EOT'; 477b39c5158Smillert#$foo = \*::foo; 478b39c5158Smillert#$bar = [ 479b39c5158Smillert# -10, 480b39c5158Smillert# $foo, 481b39c5158Smillert# { 482b39c5158Smillert# a => 1, 483b39c5158Smillert# b => \5, 484b39c5158Smillert# c => $bar, 485b39c5158Smillert# d => $bar->[2] 486b39c5158Smillert# } 487b39c5158Smillert#]; 488b39c5158Smillert#$baz = $bar->[2]; 489b39c5158SmillertEOT 490b39c5158Smillert 491b39c5158Smillert TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])); 492b39c5158Smillert TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])) if $XS; 493b39c5158Smillert 494b39c5158Smillert} 495b39c5158Smillert 496b39c5158Smillert############# 497b39c5158Smillert############# 498b39c5158Smillert{ 499b39c5158Smillert package main; 500b39c5158Smillert @dogs = ( 'Fido', 'Wags' ); 501b39c5158Smillert %kennel = ( 502b39c5158Smillert First => \$dogs[0], 503b39c5158Smillert Second => \$dogs[1], 504b39c5158Smillert ); 505b39c5158Smillert $dogs[2] = \%kennel; 506b39c5158Smillert $mutts = \%kennel; 507b39c5158Smillert $mutts = $mutts; # avoid warning 508b39c5158Smillert 509b39c5158Smillert############# 85 510b39c5158Smillert## 511b39c5158Smillert $WANT = <<'EOT'; 512b39c5158Smillert#%kennels = ( 513b39c5158Smillert# First => \'Fido', 514b39c5158Smillert# Second => \'Wags' 515b39c5158Smillert#); 516b39c5158Smillert#@dogs = ( 517b39c5158Smillert# ${$kennels{First}}, 518b39c5158Smillert# ${$kennels{Second}}, 519b39c5158Smillert# \%kennels 520b39c5158Smillert#); 521b39c5158Smillert#%mutts = %kennels; 522b39c5158SmillertEOT 523b39c5158Smillert 524b39c5158Smillert TEST q( 525b39c5158Smillert $d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts], 526b39c5158Smillert [qw(*kennels *dogs *mutts)] ); 527b39c5158Smillert $d->Dump; 528b39c5158Smillert ); 529b39c5158Smillert if ($XS) { 530b39c5158Smillert TEST q( 531b39c5158Smillert $d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts], 532b39c5158Smillert [qw(*kennels *dogs *mutts)] ); 533b39c5158Smillert $d->Dumpxs; 534b39c5158Smillert ); 535b39c5158Smillert } 536b39c5158Smillert 537b39c5158Smillert############# 91 538b39c5158Smillert## 539b39c5158Smillert $WANT = <<'EOT'; 540b39c5158Smillert#%kennels = %kennels; 541b39c5158Smillert#@dogs = @dogs; 542b39c5158Smillert#%mutts = %kennels; 543b39c5158SmillertEOT 544b39c5158Smillert 545b39c5158Smillert TEST q($d->Dump); 546b39c5158Smillert TEST q($d->Dumpxs) if $XS; 547b39c5158Smillert 548b39c5158Smillert############# 97 549b39c5158Smillert## 550b39c5158Smillert $WANT = <<'EOT'; 551b39c5158Smillert#%kennels = ( 552b39c5158Smillert# First => \'Fido', 553b39c5158Smillert# Second => \'Wags' 554b39c5158Smillert#); 555b39c5158Smillert#@dogs = ( 556b39c5158Smillert# ${$kennels{First}}, 557b39c5158Smillert# ${$kennels{Second}}, 558b39c5158Smillert# \%kennels 559b39c5158Smillert#); 560b39c5158Smillert#%mutts = %kennels; 561b39c5158SmillertEOT 562b39c5158Smillert 563b39c5158Smillert 564b39c5158Smillert TEST q($d->Reset; $d->Dump); 565b39c5158Smillert if ($XS) { 566b39c5158Smillert TEST q($d->Reset; $d->Dumpxs); 567b39c5158Smillert } 568b39c5158Smillert 569b39c5158Smillert############# 103 570b39c5158Smillert## 571b39c5158Smillert $WANT = <<'EOT'; 572b39c5158Smillert#@dogs = ( 573b39c5158Smillert# 'Fido', 574b39c5158Smillert# 'Wags', 575b39c5158Smillert# { 576b39c5158Smillert# First => \$dogs[0], 577b39c5158Smillert# Second => \$dogs[1] 578b39c5158Smillert# } 579b39c5158Smillert#); 580b39c5158Smillert#%kennels = %{$dogs[2]}; 581b39c5158Smillert#%mutts = %{$dogs[2]}; 582b39c5158SmillertEOT 583b39c5158Smillert 584b39c5158Smillert TEST q( 585b39c5158Smillert $d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts], 586b39c5158Smillert [qw(*dogs *kennels *mutts)] ); 587b39c5158Smillert $d->Dump; 588b39c5158Smillert ); 589b39c5158Smillert if ($XS) { 590b39c5158Smillert TEST q( 591b39c5158Smillert $d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts], 592b39c5158Smillert [qw(*dogs *kennels *mutts)] ); 593b39c5158Smillert $d->Dumpxs; 594b39c5158Smillert ); 595b39c5158Smillert } 596b39c5158Smillert 597b39c5158Smillert############# 109 598b39c5158Smillert## 599b39c5158Smillert TEST q($d->Reset->Dump); 600b39c5158Smillert if ($XS) { 601b39c5158Smillert TEST q($d->Reset->Dumpxs); 602b39c5158Smillert } 603b39c5158Smillert 604b39c5158Smillert############# 115 605b39c5158Smillert## 606b39c5158Smillert $WANT = <<'EOT'; 607b39c5158Smillert#@dogs = ( 608b39c5158Smillert# 'Fido', 609b39c5158Smillert# 'Wags', 610b39c5158Smillert# { 611b39c5158Smillert# First => \'Fido', 612b39c5158Smillert# Second => \'Wags' 613b39c5158Smillert# } 614b39c5158Smillert#); 615b39c5158Smillert#%kennels = ( 616b39c5158Smillert# First => \'Fido', 617b39c5158Smillert# Second => \'Wags' 618b39c5158Smillert#); 619b39c5158SmillertEOT 620b39c5158Smillert 621b39c5158Smillert TEST q( 622b39c5158Smillert $d = Data::Dumper->new( [\@dogs, \%kennel], [qw(*dogs *kennels)] ); 623b39c5158Smillert $d->Deepcopy(1)->Dump; 624b39c5158Smillert ); 625b39c5158Smillert if ($XS) { 626b39c5158Smillert TEST q($d->Reset->Dumpxs); 627b39c5158Smillert } 628b39c5158Smillert 629b39c5158Smillert} 630b39c5158Smillert 631b39c5158Smillert{ 632b39c5158Smillert 633b39c5158Smillertsub z { print "foo\n" } 634b39c5158Smillert$c = [ \&z ]; 635b39c5158Smillert 636b39c5158Smillert############# 121 637b39c5158Smillert## 638b39c5158Smillert $WANT = <<'EOT'; 639b39c5158Smillert#$a = $b; 640b39c5158Smillert#$c = [ 641b39c5158Smillert# $b 642b39c5158Smillert#]; 643b39c5158SmillertEOT 644b39c5158Smillert 645b39c5158SmillertTEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dump;); 646b39c5158SmillertTEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dumpxs;) 647b39c5158Smillert if $XS; 648b39c5158Smillert 649b39c5158Smillert############# 127 650b39c5158Smillert## 651b39c5158Smillert $WANT = <<'EOT'; 652b39c5158Smillert#$a = \&b; 653b39c5158Smillert#$c = [ 654b39c5158Smillert# \&b 655b39c5158Smillert#]; 656b39c5158SmillertEOT 657b39c5158Smillert 658b39c5158SmillertTEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dump;); 659b39c5158SmillertTEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dumpxs;) 660b39c5158Smillert if $XS; 661b39c5158Smillert 662b39c5158Smillert############# 133 663b39c5158Smillert## 664b39c5158Smillert $WANT = <<'EOT'; 665b39c5158Smillert#*a = \&b; 666b39c5158Smillert#@c = ( 667b39c5158Smillert# \&b 668b39c5158Smillert#); 669b39c5158SmillertEOT 670b39c5158Smillert 671b39c5158SmillertTEST q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dump;); 672b39c5158SmillertTEST q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dumpxs;) 673b39c5158Smillert if $XS; 674b39c5158Smillert 675b39c5158Smillert} 676b39c5158Smillert 677b39c5158Smillert{ 678b39c5158Smillert $a = []; 679b39c5158Smillert $a->[1] = \$a->[0]; 680b39c5158Smillert 681b39c5158Smillert############# 139 682b39c5158Smillert## 683b39c5158Smillert $WANT = <<'EOT'; 684b39c5158Smillert#@a = ( 685b39c5158Smillert# undef, 686b39c5158Smillert# do{my $o} 687b39c5158Smillert#); 688b39c5158Smillert#$a[1] = \$a[0]; 689b39c5158SmillertEOT 690b39c5158Smillert 691b39c5158SmillertTEST q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dump;); 692b39c5158SmillertTEST q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dumpxs;) 693b39c5158Smillert if $XS; 694b39c5158Smillert} 695b39c5158Smillert 696b39c5158Smillert{ 697b39c5158Smillert $a = \\\\\'foo'; 698b39c5158Smillert $b = $$$a; 699b39c5158Smillert 700b39c5158Smillert############# 145 701b39c5158Smillert## 702b39c5158Smillert $WANT = <<'EOT'; 703b39c5158Smillert#$a = \\\\\'foo'; 704b39c5158Smillert#$b = ${${$a}}; 705b39c5158SmillertEOT 706b39c5158Smillert 707b39c5158SmillertTEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;); 708b39c5158SmillertTEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;) 709b39c5158Smillert if $XS; 710b39c5158Smillert} 711b39c5158Smillert 712b39c5158Smillert{ 713b39c5158Smillert $a = [{ a => \$b }, { b => undef }]; 714b39c5158Smillert $b = [{ c => \$b }, { d => \$a }]; 715b39c5158Smillert 716b39c5158Smillert############# 151 717b39c5158Smillert## 718b39c5158Smillert $WANT = <<'EOT'; 719b39c5158Smillert#$a = [ 720b39c5158Smillert# { 721b39c5158Smillert# a => \[ 722b39c5158Smillert# { 723b39c5158Smillert# c => do{my $o} 724b39c5158Smillert# }, 725b39c5158Smillert# { 726b39c5158Smillert# d => \[] 727b39c5158Smillert# } 728b39c5158Smillert# ] 729b39c5158Smillert# }, 730b39c5158Smillert# { 731b39c5158Smillert# b => undef 732b39c5158Smillert# } 733b39c5158Smillert#]; 734b39c5158Smillert#${$a->[0]{a}}->[0]->{c} = $a->[0]{a}; 735b39c5158Smillert#${${$a->[0]{a}}->[1]->{d}} = $a; 736b39c5158Smillert#$b = ${$a->[0]{a}}; 737b39c5158SmillertEOT 738b39c5158Smillert 739b39c5158SmillertTEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;); 740b39c5158SmillertTEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;) 741b39c5158Smillert if $XS; 742b39c5158Smillert} 743b39c5158Smillert 744b39c5158Smillert{ 745b39c5158Smillert $a = [[[[\\\\\'foo']]]]; 746b39c5158Smillert $b = $a->[0][0]; 747b39c5158Smillert $c = $${$b->[0][0]}; 748b39c5158Smillert 749b39c5158Smillert############# 157 750b39c5158Smillert## 751b39c5158Smillert $WANT = <<'EOT'; 752b39c5158Smillert#$a = [ 753b39c5158Smillert# [ 754b39c5158Smillert# [ 755b39c5158Smillert# [ 756b39c5158Smillert# \\\\\'foo' 757b39c5158Smillert# ] 758b39c5158Smillert# ] 759b39c5158Smillert# ] 760b39c5158Smillert#]; 761b39c5158Smillert#$b = $a->[0][0]; 762b39c5158Smillert#$c = ${${$a->[0][0][0][0]}}; 763b39c5158SmillertEOT 764b39c5158Smillert 765b39c5158SmillertTEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dump;); 766b39c5158SmillertTEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dumpxs;) 767b39c5158Smillert if $XS; 768b39c5158Smillert} 769b39c5158Smillert 770b39c5158Smillert{ 771b39c5158Smillert $f = "pearl"; 772b39c5158Smillert $e = [ $f ]; 773b39c5158Smillert $d = { 'e' => $e }; 774b39c5158Smillert $c = [ $d ]; 775b39c5158Smillert $b = { 'c' => $c }; 776b39c5158Smillert $a = { 'b' => $b }; 777b39c5158Smillert 778b39c5158Smillert############# 163 779b39c5158Smillert## 780b39c5158Smillert $WANT = <<'EOT'; 781b39c5158Smillert#$a = { 782b39c5158Smillert# b => { 783b39c5158Smillert# c => [ 784b39c5158Smillert# { 785b39c5158Smillert# e => 'ARRAY(0xdeadbeef)' 786b39c5158Smillert# } 787b39c5158Smillert# ] 788b39c5158Smillert# } 789b39c5158Smillert#}; 790b39c5158Smillert#$b = $a->{b}; 791b39c5158Smillert#$c = $a->{b}{c}; 792b39c5158SmillertEOT 793b39c5158Smillert 794b39c5158SmillertTEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dump;); 795b39c5158SmillertTEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dumpxs;) 796b39c5158Smillert if $XS; 797b39c5158Smillert 798b39c5158Smillert############# 169 799b39c5158Smillert## 800b39c5158Smillert $WANT = <<'EOT'; 801b39c5158Smillert#$a = { 802b39c5158Smillert# b => 'HASH(0xdeadbeef)' 803b39c5158Smillert#}; 804b39c5158Smillert#$b = $a->{b}; 805b39c5158Smillert#$c = [ 806b39c5158Smillert# 'HASH(0xdeadbeef)' 807b39c5158Smillert#]; 808b39c5158SmillertEOT 809b39c5158Smillert 810b39c5158SmillertTEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dump;); 811b39c5158SmillertTEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dumpxs;) 812b39c5158Smillert if $XS; 813b39c5158Smillert} 814b39c5158Smillert 815b39c5158Smillert{ 816b39c5158Smillert $a = \$a; 817b39c5158Smillert $b = [$a]; 818b39c5158Smillert 819b39c5158Smillert############# 175 820b39c5158Smillert## 821b39c5158Smillert $WANT = <<'EOT'; 822b39c5158Smillert#$b = [ 823b39c5158Smillert# \$b->[0] 824b39c5158Smillert#]; 825b39c5158SmillertEOT 826b39c5158Smillert 827b39c5158SmillertTEST q(Data::Dumper->new([$b],['b'])->Purity(0)->Dump;); 828b39c5158SmillertTEST q(Data::Dumper->new([$b],['b'])->Purity(0)->Dumpxs;) 829b39c5158Smillert if $XS; 830b39c5158Smillert 831b39c5158Smillert############# 181 832b39c5158Smillert## 833b39c5158Smillert $WANT = <<'EOT'; 834b39c5158Smillert#$b = [ 835b39c5158Smillert# \do{my $o} 836b39c5158Smillert#]; 837b39c5158Smillert#${$b->[0]} = $b->[0]; 838b39c5158SmillertEOT 839b39c5158Smillert 840b39c5158Smillert 841b39c5158SmillertTEST q(Data::Dumper->new([$b],['b'])->Purity(1)->Dump;); 842b39c5158SmillertTEST q(Data::Dumper->new([$b],['b'])->Purity(1)->Dumpxs;) 843b39c5158Smillert if $XS; 844b39c5158Smillert} 845b39c5158Smillert 846b39c5158Smillert{ 847b39c5158Smillert $a = "\x{09c10}"; 848b39c5158Smillert############# 187 849b39c5158Smillert## XS code was adding an extra \0 850b39c5158Smillert $WANT = <<'EOT'; 851b39c5158Smillert#$a = "\x{9c10}"; 852b39c5158SmillertEOT 853b39c5158Smillert 854b39c5158Smillert if($] >= 5.007) { 855b39c5158Smillert TEST q(Data::Dumper->Dump([$a], ['a'])), "\\x{9c10}"; 856b39c5158Smillert } else { 857b39c5158Smillert SKIP_TEST "Incomplete support for UTF-8 in old perls"; 858b39c5158Smillert } 859b39c5158Smillert TEST q(Data::Dumper->Dumpxs([$a], ['a'])), "XS \\x{9c10}" 860b39c5158Smillert if $XS; 861b39c5158Smillert} 862b39c5158Smillert 863b39c5158Smillert{ 864b39c5158Smillert $i = 0; 865b39c5158Smillert $a = { map { ("$_$_$_", ++$i) } 'I'..'Q' }; 866b39c5158Smillert 867b39c5158Smillert############# 193 868b39c5158Smillert## 869b39c5158Smillert $WANT = <<'EOT'; 870b39c5158Smillert#$VAR1 = { 871b39c5158Smillert# III => 1, 872b39c5158Smillert# JJJ => 2, 873b39c5158Smillert# KKK => 3, 874b39c5158Smillert# LLL => 4, 875b39c5158Smillert# MMM => 5, 876b39c5158Smillert# NNN => 6, 877b39c5158Smillert# OOO => 7, 878b39c5158Smillert# PPP => 8, 879b39c5158Smillert# QQQ => 9 880b39c5158Smillert#}; 881b39c5158SmillertEOT 882b39c5158Smillert 883b39c5158SmillertTEST q(Data::Dumper->new([$a])->Dump;); 884b39c5158SmillertTEST q(Data::Dumper->new([$a])->Dumpxs;) 885b39c5158Smillert if $XS; 886b39c5158Smillert} 887b39c5158Smillert 888b39c5158Smillert{ 889b39c5158Smillert $i = 5; 890b39c5158Smillert $c = { map { (++$i, "$_$_$_") } 'I'..'Q' }; 891b39c5158Smillert local $Data::Dumper::Sortkeys = \&sort199; 892b39c5158Smillert sub sort199 { 893b39c5158Smillert my $hash = shift; 894b39c5158Smillert return [ sort { $b <=> $a } keys %$hash ]; 895b39c5158Smillert } 896b39c5158Smillert 897b39c5158Smillert############# 199 898b39c5158Smillert## 899b39c5158Smillert $WANT = <<'EOT'; 900b39c5158Smillert#$VAR1 = { 901b39c5158Smillert# 14 => 'QQQ', 902b39c5158Smillert# 13 => 'PPP', 903b39c5158Smillert# 12 => 'OOO', 904b39c5158Smillert# 11 => 'NNN', 905b39c5158Smillert# 10 => 'MMM', 906b39c5158Smillert# 9 => 'LLL', 907b39c5158Smillert# 8 => 'KKK', 908b39c5158Smillert# 7 => 'JJJ', 909b39c5158Smillert# 6 => 'III' 910b39c5158Smillert#}; 911b39c5158SmillertEOT 912b39c5158Smillert 913b39c5158Smillert# perl code does keys and values as numbers if possible 914b39c5158SmillertTEST q(Data::Dumper->new([$c])->Dump;); 915b39c5158Smillert# XS code always does them as strings 916b39c5158Smillert$WANT =~ s/ (\d+)/ '$1'/gs; 917b39c5158SmillertTEST q(Data::Dumper->new([$c])->Dumpxs;) 918b39c5158Smillert if $XS; 919b39c5158Smillert} 920b39c5158Smillert 921b39c5158Smillert{ 922b39c5158Smillert $i = 5; 923b39c5158Smillert $c = { map { (++$i, "$_$_$_") } 'I'..'Q' }; 924b39c5158Smillert $d = { reverse %$c }; 925b39c5158Smillert local $Data::Dumper::Sortkeys = \&sort205; 926b39c5158Smillert sub sort205 { 927b39c5158Smillert my $hash = shift; 928b39c5158Smillert return [ 929b39c5158Smillert $hash eq $c ? (sort { $a <=> $b } keys %$hash) 930b39c5158Smillert : (reverse sort keys %$hash) 931b39c5158Smillert ]; 932b39c5158Smillert } 933b39c5158Smillert 934b39c5158Smillert############# 205 935b39c5158Smillert## 936b39c5158Smillert $WANT = <<'EOT'; 937b39c5158Smillert#$VAR1 = [ 938b39c5158Smillert# { 939b39c5158Smillert# 6 => 'III', 940b39c5158Smillert# 7 => 'JJJ', 941b39c5158Smillert# 8 => 'KKK', 942b39c5158Smillert# 9 => 'LLL', 943b39c5158Smillert# 10 => 'MMM', 944b39c5158Smillert# 11 => 'NNN', 945b39c5158Smillert# 12 => 'OOO', 946b39c5158Smillert# 13 => 'PPP', 947b39c5158Smillert# 14 => 'QQQ' 948b39c5158Smillert# }, 949b39c5158Smillert# { 950b39c5158Smillert# QQQ => 14, 951b39c5158Smillert# PPP => 13, 952b39c5158Smillert# OOO => 12, 953b39c5158Smillert# NNN => 11, 954b39c5158Smillert# MMM => 10, 955b39c5158Smillert# LLL => 9, 956b39c5158Smillert# KKK => 8, 957b39c5158Smillert# JJJ => 7, 958b39c5158Smillert# III => 6 959b39c5158Smillert# } 960b39c5158Smillert#]; 961b39c5158SmillertEOT 962b39c5158Smillert 963b39c5158SmillertTEST q(Data::Dumper->new([[$c, $d]])->Dump;); 964b39c5158Smillert$WANT =~ s/ (\d+)/ '$1'/gs; 965b39c5158SmillertTEST q(Data::Dumper->new([[$c, $d]])->Dumpxs;) 966b39c5158Smillert if $XS; 967b39c5158Smillert} 968b39c5158Smillert 969b39c5158Smillert{ 970b39c5158Smillert local $Data::Dumper::Deparse = 1; 971b39c5158Smillert local $Data::Dumper::Indent = 2; 972b39c5158Smillert 973b39c5158Smillert############# 211 974b39c5158Smillert## 975b39c5158Smillert $WANT = <<'EOT'; 976b39c5158Smillert#$VAR1 = { 977b39c5158Smillert# foo => sub { 978b39c5158Smillert# print 'foo'; 979b39c5158Smillert# } 980b39c5158Smillert# }; 981b39c5158SmillertEOT 982b39c5158Smillert 983b39c5158Smillert if(" $Config{'extensions'} " !~ m[ B ]) { 984b39c5158Smillert SKIP_TEST "Perl configured without B module"; 985b39c5158Smillert } else { 986b39c5158Smillert TEST q(Data::Dumper->new([{ foo => sub { print "foo"; } }])->Dump); 987b39c5158Smillert } 988b39c5158Smillert} 989b39c5158Smillert 990b39c5158Smillert############# 214 991b39c5158Smillert## 992b39c5158Smillert 993b39c5158Smillert# This is messy. 994b39c5158Smillert# The controls (bare numbers) are stored either as integers or floating point. 995b39c5158Smillert# [depending on whether the tokeniser sees things like ".". 996b39c5158Smillert# The peephole optimiser only runs for constant folding, not single constants, 997b39c5158Smillert# so I already have some NVs, some IVs 998b39c5158Smillert# The string versions are not. They are all PV 999b39c5158Smillert 1000b39c5158Smillert# This is arguably all far too chummy with the implementation, but I really 1001b39c5158Smillert# want to ensure that we don't go wrong when flags on scalars get as side 1002b39c5158Smillert# effects of reading them. 1003b39c5158Smillert 1004b39c5158Smillert# These tests are actually testing the precise output of the current 1005b39c5158Smillert# implementation, so will most likely fail if the implementation changes, 1006b39c5158Smillert# even if the new implementation produces different but correct results. 1007b39c5158Smillert# It would be nice to test for wrong answers, but I can't see how to do that, 1008b39c5158Smillert# so instead I'm checking for unexpected answers. (ie -2 becoming "-2" is not 1009b39c5158Smillert# wrong, but I can't see an easy, reliable way to code that knowledge) 1010b39c5158Smillert 1011b39c5158Smillert# Numbers (seen by the tokeniser as numbers, stored as numbers. 1012b39c5158Smillert @numbers = 1013b39c5158Smillert ( 1014b39c5158Smillert 0, +1, -2, 3.0, +4.0, -5.0, 6.5, +7.5, -8.5, 1015b39c5158Smillert 9, +10, -11, 12.0, +13.0, -14.0, 15.5, +16.25, -17.75, 1016b39c5158Smillert ); 1017b39c5158Smillert# Strings 1018b39c5158Smillert @strings = 1019b39c5158Smillert ( 1020b39c5158Smillert "0", "+1", "-2", "3.0", "+4.0", "-5.0", "6.5", "+7.5", "-8.5", " 9", 1021b39c5158Smillert " +10", " -11", " 12.0", " +13.0", " -14.0", " 15.5", " +16.25", " -17.75", 1022b39c5158Smillert ); 1023b39c5158Smillert 1024b39c5158Smillert# The perl code always does things the same way for numbers. 1025b39c5158Smillert $WANT_PL_N = <<'EOT'; 1026b39c5158Smillert#$VAR1 = 0; 1027b39c5158Smillert#$VAR2 = 1; 1028b39c5158Smillert#$VAR3 = -2; 1029b39c5158Smillert#$VAR4 = 3; 1030b39c5158Smillert#$VAR5 = 4; 1031b39c5158Smillert#$VAR6 = -5; 1032b39c5158Smillert#$VAR7 = '6.5'; 1033b39c5158Smillert#$VAR8 = '7.5'; 1034b39c5158Smillert#$VAR9 = '-8.5'; 1035b39c5158Smillert#$VAR10 = 9; 1036b39c5158Smillert#$VAR11 = 10; 1037b39c5158Smillert#$VAR12 = -11; 1038b39c5158Smillert#$VAR13 = 12; 1039b39c5158Smillert#$VAR14 = 13; 1040b39c5158Smillert#$VAR15 = -14; 1041b39c5158Smillert#$VAR16 = '15.5'; 1042b39c5158Smillert#$VAR17 = '16.25'; 1043b39c5158Smillert#$VAR18 = '-17.75'; 1044b39c5158SmillertEOT 1045b39c5158Smillert# The perl code knows that 0 and -2 stringify exactly back to the strings, 1046b39c5158Smillert# so it dumps them as numbers, not strings. 1047b39c5158Smillert $WANT_PL_S = <<'EOT'; 1048b39c5158Smillert#$VAR1 = 0; 1049b39c5158Smillert#$VAR2 = '+1'; 1050b39c5158Smillert#$VAR3 = -2; 1051b39c5158Smillert#$VAR4 = '3.0'; 1052b39c5158Smillert#$VAR5 = '+4.0'; 1053b39c5158Smillert#$VAR6 = '-5.0'; 1054b39c5158Smillert#$VAR7 = '6.5'; 1055b39c5158Smillert#$VAR8 = '+7.5'; 1056b39c5158Smillert#$VAR9 = '-8.5'; 1057b39c5158Smillert#$VAR10 = ' 9'; 1058b39c5158Smillert#$VAR11 = ' +10'; 1059b39c5158Smillert#$VAR12 = ' -11'; 1060b39c5158Smillert#$VAR13 = ' 12.0'; 1061b39c5158Smillert#$VAR14 = ' +13.0'; 1062b39c5158Smillert#$VAR15 = ' -14.0'; 1063b39c5158Smillert#$VAR16 = ' 15.5'; 1064b39c5158Smillert#$VAR17 = ' +16.25'; 1065b39c5158Smillert#$VAR18 = ' -17.75'; 1066b39c5158SmillertEOT 1067b39c5158Smillert 1068b39c5158Smillert# The XS code differs. 1069b39c5158Smillert# These are the numbers as seen by the tokeniser. Constants aren't folded 1070b39c5158Smillert# (which makes IVs where possible) so values the tokeniser thought were 1071b39c5158Smillert# floating point are stored as NVs. The XS code outputs these as strings, 1072b39c5158Smillert# but as it has converted them from NVs, leading + signs will not be there. 1073b39c5158Smillert $WANT_XS_N = <<'EOT'; 1074b39c5158Smillert#$VAR1 = 0; 1075b39c5158Smillert#$VAR2 = 1; 1076b39c5158Smillert#$VAR3 = -2; 1077b39c5158Smillert#$VAR4 = '3'; 1078b39c5158Smillert#$VAR5 = '4'; 1079b39c5158Smillert#$VAR6 = '-5'; 1080b39c5158Smillert#$VAR7 = '6.5'; 1081b39c5158Smillert#$VAR8 = '7.5'; 1082b39c5158Smillert#$VAR9 = '-8.5'; 1083b39c5158Smillert#$VAR10 = 9; 1084b39c5158Smillert#$VAR11 = 10; 1085b39c5158Smillert#$VAR12 = -11; 1086b39c5158Smillert#$VAR13 = '12'; 1087b39c5158Smillert#$VAR14 = '13'; 1088b39c5158Smillert#$VAR15 = '-14'; 1089b39c5158Smillert#$VAR16 = '15.5'; 1090b39c5158Smillert#$VAR17 = '16.25'; 1091b39c5158Smillert#$VAR18 = '-17.75'; 1092b39c5158SmillertEOT 1093b39c5158Smillert 1094b39c5158Smillert# These are the strings as seen by the tokeniser. The XS code will output 1095b39c5158Smillert# these for all cases except where the scalar has been used in integer context 1096b39c5158Smillert $WANT_XS_S = <<'EOT'; 1097b39c5158Smillert#$VAR1 = '0'; 1098b39c5158Smillert#$VAR2 = '+1'; 1099b39c5158Smillert#$VAR3 = '-2'; 1100b39c5158Smillert#$VAR4 = '3.0'; 1101b39c5158Smillert#$VAR5 = '+4.0'; 1102b39c5158Smillert#$VAR6 = '-5.0'; 1103b39c5158Smillert#$VAR7 = '6.5'; 1104b39c5158Smillert#$VAR8 = '+7.5'; 1105b39c5158Smillert#$VAR9 = '-8.5'; 1106b39c5158Smillert#$VAR10 = ' 9'; 1107b39c5158Smillert#$VAR11 = ' +10'; 1108b39c5158Smillert#$VAR12 = ' -11'; 1109b39c5158Smillert#$VAR13 = ' 12.0'; 1110b39c5158Smillert#$VAR14 = ' +13.0'; 1111b39c5158Smillert#$VAR15 = ' -14.0'; 1112b39c5158Smillert#$VAR16 = ' 15.5'; 1113b39c5158Smillert#$VAR17 = ' +16.25'; 1114b39c5158Smillert#$VAR18 = ' -17.75'; 1115b39c5158SmillertEOT 1116b39c5158Smillert 1117b39c5158Smillert# These are the numbers as IV-ized by & 1118b39c5158Smillert# These will differ from WANT_XS_N because now IV flags will be set on all 1119b39c5158Smillert# values that were actually integer, and the XS code will then output these 1120b39c5158Smillert# as numbers not strings. 1121b39c5158Smillert $WANT_XS_I = <<'EOT'; 1122b39c5158Smillert#$VAR1 = 0; 1123b39c5158Smillert#$VAR2 = 1; 1124b39c5158Smillert#$VAR3 = -2; 1125b39c5158Smillert#$VAR4 = 3; 1126b39c5158Smillert#$VAR5 = 4; 1127b39c5158Smillert#$VAR6 = -5; 1128b39c5158Smillert#$VAR7 = '6.5'; 1129b39c5158Smillert#$VAR8 = '7.5'; 1130b39c5158Smillert#$VAR9 = '-8.5'; 1131b39c5158Smillert#$VAR10 = 9; 1132b39c5158Smillert#$VAR11 = 10; 1133b39c5158Smillert#$VAR12 = -11; 1134b39c5158Smillert#$VAR13 = 12; 1135b39c5158Smillert#$VAR14 = 13; 1136b39c5158Smillert#$VAR15 = -14; 1137b39c5158Smillert#$VAR16 = '15.5'; 1138b39c5158Smillert#$VAR17 = '16.25'; 1139b39c5158Smillert#$VAR18 = '-17.75'; 1140b39c5158SmillertEOT 1141b39c5158Smillert 1142b39c5158Smillert# Some of these tests will be redundant. 1143b39c5158Smillert@numbers_s = @numbers_i = @numbers_is = @numbers_n = @numbers_ns = @numbers_ni 1144b39c5158Smillert = @numbers_nis = @numbers; 1145b39c5158Smillert@strings_s = @strings_i = @strings_is = @strings_n = @strings_ns = @strings_ni 1146b39c5158Smillert = @strings_nis = @strings; 1147b39c5158Smillert# Use them in an integer context 1148b39c5158Smillertforeach (@numbers_i, @numbers_ni, @numbers_nis, @numbers_is, 1149b39c5158Smillert @strings_i, @strings_ni, @strings_nis, @strings_is) { 1150b39c5158Smillert my $b = sprintf "%d", $_; 1151b39c5158Smillert} 1152b39c5158Smillert# Use them in a floating point context 1153b39c5158Smillertforeach (@numbers_n, @numbers_ni, @numbers_nis, @numbers_ns, 1154b39c5158Smillert @strings_n, @strings_ni, @strings_nis, @strings_ns) { 1155b39c5158Smillert my $b = sprintf "%e", $_; 1156b39c5158Smillert} 1157b39c5158Smillert# Use them in a string context 1158b39c5158Smillertforeach (@numbers_s, @numbers_is, @numbers_nis, @numbers_ns, 1159b39c5158Smillert @strings_s, @strings_is, @strings_nis, @strings_ns) { 1160b39c5158Smillert my $b = sprintf "%s", $_; 1161b39c5158Smillert} 1162b39c5158Smillert 1163b39c5158Smillert# use Devel::Peek; Dump ($_) foreach @vanilla_c; 1164b39c5158Smillert 1165b39c5158Smillert$WANT=$WANT_PL_N; 1166b39c5158SmillertTEST q(Data::Dumper->new(\@numbers)->Dump), 'Numbers'; 1167b39c5158SmillertTEST q(Data::Dumper->new(\@numbers_s)->Dump), 'Numbers PV'; 1168b39c5158SmillertTEST q(Data::Dumper->new(\@numbers_i)->Dump), 'Numbers IV'; 1169b39c5158SmillertTEST q(Data::Dumper->new(\@numbers_is)->Dump), 'Numbers IV,PV'; 1170b39c5158SmillertTEST q(Data::Dumper->new(\@numbers_n)->Dump), 'Numbers NV'; 1171b39c5158SmillertTEST q(Data::Dumper->new(\@numbers_ns)->Dump), 'Numbers NV,PV'; 1172b39c5158SmillertTEST q(Data::Dumper->new(\@numbers_ni)->Dump), 'Numbers NV,IV'; 1173b39c5158SmillertTEST q(Data::Dumper->new(\@numbers_nis)->Dump), 'Numbers NV,IV,PV'; 1174b39c5158Smillert$WANT=$WANT_PL_S; 1175b39c5158SmillertTEST q(Data::Dumper->new(\@strings)->Dump), 'Strings'; 1176b39c5158SmillertTEST q(Data::Dumper->new(\@strings_s)->Dump), 'Strings PV'; 1177b39c5158SmillertTEST q(Data::Dumper->new(\@strings_i)->Dump), 'Strings IV'; 1178b39c5158SmillertTEST q(Data::Dumper->new(\@strings_is)->Dump), 'Strings IV,PV'; 1179b39c5158SmillertTEST q(Data::Dumper->new(\@strings_n)->Dump), 'Strings NV'; 1180b39c5158SmillertTEST q(Data::Dumper->new(\@strings_ns)->Dump), 'Strings NV,PV'; 1181b39c5158SmillertTEST q(Data::Dumper->new(\@strings_ni)->Dump), 'Strings NV,IV'; 1182b39c5158SmillertTEST q(Data::Dumper->new(\@strings_nis)->Dump), 'Strings NV,IV,PV'; 1183b39c5158Smillertif ($XS) { 1184b39c5158Smillert my $nv_preserves_uv = defined $Config{d_nv_preserves_uv}; 1185b39c5158Smillert my $nv_preserves_uv_4bits = exists($Config{nv_preserves_uv_bits}) && $Config{nv_preserves_uv_bits} >= 4; 1186b39c5158Smillert $WANT=$WANT_XS_N; 1187b39c5158Smillert TEST q(Data::Dumper->new(\@numbers)->Dumpxs), 'XS Numbers'; 1188b39c5158Smillert TEST q(Data::Dumper->new(\@numbers_s)->Dumpxs), 'XS Numbers PV'; 1189b39c5158Smillert if ($nv_preserves_uv || $nv_preserves_uv_4bits) { 1190b39c5158Smillert $WANT=$WANT_XS_I; 1191b39c5158Smillert TEST q(Data::Dumper->new(\@numbers_i)->Dumpxs), 'XS Numbers IV'; 1192b39c5158Smillert TEST q(Data::Dumper->new(\@numbers_is)->Dumpxs), 'XS Numbers IV,PV'; 1193b39c5158Smillert } else { 1194b39c5158Smillert SKIP_TEST "NV does not preserve 4bits"; 1195b39c5158Smillert SKIP_TEST "NV does not preserve 4bits"; 1196b39c5158Smillert } 1197b39c5158Smillert $WANT=$WANT_XS_N; 1198b39c5158Smillert TEST q(Data::Dumper->new(\@numbers_n)->Dumpxs), 'XS Numbers NV'; 1199b39c5158Smillert TEST q(Data::Dumper->new(\@numbers_ns)->Dumpxs), 'XS Numbers NV,PV'; 1200b39c5158Smillert if ($nv_preserves_uv || $nv_preserves_uv_4bits) { 1201b39c5158Smillert $WANT=$WANT_XS_I; 1202b39c5158Smillert TEST q(Data::Dumper->new(\@numbers_ni)->Dumpxs), 'XS Numbers NV,IV'; 1203b39c5158Smillert TEST q(Data::Dumper->new(\@numbers_nis)->Dumpxs), 'XS Numbers NV,IV,PV'; 1204b39c5158Smillert } else { 1205b39c5158Smillert SKIP_TEST "NV does not preserve 4bits"; 1206b39c5158Smillert SKIP_TEST "NV does not preserve 4bits"; 1207b39c5158Smillert } 1208b39c5158Smillert 1209b39c5158Smillert $WANT=$WANT_XS_S; 1210b39c5158Smillert TEST q(Data::Dumper->new(\@strings)->Dumpxs), 'XS Strings'; 1211b39c5158Smillert TEST q(Data::Dumper->new(\@strings_s)->Dumpxs), 'XS Strings PV'; 1212b39c5158Smillert # This one used to really mess up. New code actually emulates the .pm code 1213b39c5158Smillert $WANT=$WANT_PL_S; 1214b39c5158Smillert TEST q(Data::Dumper->new(\@strings_i)->Dumpxs), 'XS Strings IV'; 1215b39c5158Smillert TEST q(Data::Dumper->new(\@strings_is)->Dumpxs), 'XS Strings IV,PV'; 1216b39c5158Smillert if ($nv_preserves_uv || $nv_preserves_uv_4bits) { 1217b39c5158Smillert $WANT=$WANT_XS_S; 1218b39c5158Smillert TEST q(Data::Dumper->new(\@strings_n)->Dumpxs), 'XS Strings NV'; 1219b39c5158Smillert TEST q(Data::Dumper->new(\@strings_ns)->Dumpxs), 'XS Strings NV,PV'; 1220b39c5158Smillert } else { 1221b39c5158Smillert SKIP_TEST "NV does not preserve 4bits"; 1222b39c5158Smillert SKIP_TEST "NV does not preserve 4bits"; 1223b39c5158Smillert } 1224b39c5158Smillert # This one used to really mess up. New code actually emulates the .pm code 1225b39c5158Smillert $WANT=$WANT_PL_S; 1226b39c5158Smillert TEST q(Data::Dumper->new(\@strings_ni)->Dumpxs), 'XS Strings NV,IV'; 1227b39c5158Smillert TEST q(Data::Dumper->new(\@strings_nis)->Dumpxs), 'XS Strings NV,IV,PV'; 1228b39c5158Smillert} 1229b39c5158Smillert 1230b39c5158Smillert{ 1231b39c5158Smillert $a = "1\n"; 1232b39c5158Smillert############# 310 1233b39c5158Smillert## Perl code was using /...$/ and hence missing the \n. 1234b39c5158Smillert $WANT = <<'EOT'; 1235b39c5158Smillertmy $VAR1 = '42 1236b39c5158Smillert'; 1237b39c5158SmillertEOT 1238b39c5158Smillert 1239b39c5158Smillert # Can't pad with # as the output has an embedded newline. 1240b39c5158Smillert local $Data::Dumper::Pad = "my "; 1241b39c5158Smillert TEST q(Data::Dumper->Dump(["42\n"])), "number with trailing newline"; 1242b39c5158Smillert TEST q(Data::Dumper->Dumpxs(["42\n"])), "XS number with trailing newline" 1243b39c5158Smillert if $XS; 1244b39c5158Smillert} 1245b39c5158Smillert 1246b39c5158Smillert{ 1247b39c5158Smillert @a = ( 1248b39c5158Smillert 999999999, 1249b39c5158Smillert 1000000000, 1250b39c5158Smillert 9999999999, 1251b39c5158Smillert 10000000000, 1252b39c5158Smillert -999999999, 1253b39c5158Smillert -1000000000, 1254b39c5158Smillert -9999999999, 1255b39c5158Smillert -10000000000, 1256b39c5158Smillert 4294967295, 1257b39c5158Smillert 4294967296, 1258b39c5158Smillert -2147483648, 1259b39c5158Smillert -2147483649, 1260b39c5158Smillert ); 1261b39c5158Smillert############# 316 1262b39c5158Smillert## Perl code flips over at 10 digits. 1263b39c5158Smillert $WANT = <<'EOT'; 1264b39c5158Smillert#$VAR1 = 999999999; 1265b39c5158Smillert#$VAR2 = '1000000000'; 1266b39c5158Smillert#$VAR3 = '9999999999'; 1267b39c5158Smillert#$VAR4 = '10000000000'; 1268b39c5158Smillert#$VAR5 = -999999999; 1269b39c5158Smillert#$VAR6 = '-1000000000'; 1270b39c5158Smillert#$VAR7 = '-9999999999'; 1271b39c5158Smillert#$VAR8 = '-10000000000'; 1272b39c5158Smillert#$VAR9 = '4294967295'; 1273b39c5158Smillert#$VAR10 = '4294967296'; 1274b39c5158Smillert#$VAR11 = '-2147483648'; 1275b39c5158Smillert#$VAR12 = '-2147483649'; 1276b39c5158SmillertEOT 1277b39c5158Smillert 1278b39c5158Smillert TEST q(Data::Dumper->Dump(\@a)), "long integers"; 1279b39c5158Smillert 1280b39c5158Smillert if ($XS) { 1281b39c5158Smillert## XS code flips over at 11 characters ("-" is a char) or larger than int. 1282b39c5158Smillert if (~0 == 0xFFFFFFFF) { 1283b39c5158Smillert # 32 bit system 1284b39c5158Smillert $WANT = <<'EOT'; 1285b39c5158Smillert#$VAR1 = 999999999; 1286b39c5158Smillert#$VAR2 = 1000000000; 1287b39c5158Smillert#$VAR3 = '9999999999'; 1288b39c5158Smillert#$VAR4 = '10000000000'; 1289b39c5158Smillert#$VAR5 = -999999999; 1290b39c5158Smillert#$VAR6 = '-1000000000'; 1291b39c5158Smillert#$VAR7 = '-9999999999'; 1292b39c5158Smillert#$VAR8 = '-10000000000'; 1293b39c5158Smillert#$VAR9 = 4294967295; 1294b39c5158Smillert#$VAR10 = '4294967296'; 1295b39c5158Smillert#$VAR11 = '-2147483648'; 1296b39c5158Smillert#$VAR12 = '-2147483649'; 1297b39c5158SmillertEOT 1298b39c5158Smillert } else { 1299b39c5158Smillert $WANT = <<'EOT'; 1300b39c5158Smillert#$VAR1 = 999999999; 1301b39c5158Smillert#$VAR2 = 1000000000; 1302b39c5158Smillert#$VAR3 = 9999999999; 1303b39c5158Smillert#$VAR4 = '10000000000'; 1304b39c5158Smillert#$VAR5 = -999999999; 1305b39c5158Smillert#$VAR6 = '-1000000000'; 1306b39c5158Smillert#$VAR7 = '-9999999999'; 1307b39c5158Smillert#$VAR8 = '-10000000000'; 1308b39c5158Smillert#$VAR9 = 4294967295; 1309b39c5158Smillert#$VAR10 = 4294967296; 1310b39c5158Smillert#$VAR11 = '-2147483648'; 1311b39c5158Smillert#$VAR12 = '-2147483649'; 1312b39c5158SmillertEOT 1313b39c5158Smillert } 1314b39c5158Smillert TEST q(Data::Dumper->Dumpxs(\@a)), "XS long integers"; 1315b39c5158Smillert } 1316b39c5158Smillert} 1317b39c5158Smillert 1318b39c5158Smillert#XXX} 1319b39c5158Smillert{ 1320b39c5158Smillert if ($Is_ebcdic) { 1321b39c5158Smillert $b = "Bad. XS didn't escape dollar sign"; 1322b39c5158Smillert############# 322 1323b39c5158Smillert $WANT = <<"EOT"; # Careful. This is '' string written inside '' here doc 1324b39c5158Smillert#\$VAR1 = '\$b\"\@\\\\\xB1'; 1325b39c5158SmillertEOT 1326b39c5158Smillert $a = "\$b\"\@\\\xB1\x{100}"; 1327b39c5158Smillert chop $a; 1328b39c5158Smillert TEST q(Data::Dumper->Dump([$a])), "utf8 flag with \" and \$"; 1329b39c5158Smillert if ($XS) { 1330b39c5158Smillert $WANT = <<'EOT'; # While this is "" string written inside "" here doc 1331b39c5158Smillert#$VAR1 = "\$b\"\@\\\x{b1}"; 1332b39c5158SmillertEOT 1333b39c5158Smillert TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with \" and \$"; 1334b39c5158Smillert } 1335b39c5158Smillert } else { 1336b39c5158Smillert $b = "Bad. XS didn't escape dollar sign"; 1337b39c5158Smillert############# 322 1338b39c5158Smillert $WANT = <<"EOT"; # Careful. This is '' string written inside '' here doc 1339b39c5158Smillert#\$VAR1 = '\$b\"\@\\\\\xA3'; 1340b39c5158SmillertEOT 1341b39c5158Smillert 1342b39c5158Smillert $a = "\$b\"\@\\\xA3\x{100}"; 1343b39c5158Smillert chop $a; 1344b39c5158Smillert TEST q(Data::Dumper->Dump([$a])), "utf8 flag with \" and \$"; 1345b39c5158Smillert if ($XS) { 1346b39c5158Smillert $WANT = <<'EOT'; # While this is "" string written inside "" here doc 1347b39c5158Smillert#$VAR1 = "\$b\"\@\\\x{a3}"; 1348b39c5158SmillertEOT 1349b39c5158Smillert TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with \" and \$"; 1350b39c5158Smillert } 1351b39c5158Smillert } 1352b39c5158Smillert # XS used to produce "$b\"' which is 4 chars, not 3. [ie wrongly qq(\$b\\\")] 1353b39c5158Smillert############# 328 1354b39c5158Smillert $WANT = <<'EOT'; 1355b39c5158Smillert#$VAR1 = '$b"'; 1356b39c5158SmillertEOT 1357b39c5158Smillert 1358b39c5158Smillert $a = "\$b\"\x{100}"; 1359b39c5158Smillert chop $a; 1360b39c5158Smillert TEST q(Data::Dumper->Dump([$a])), "utf8 flag with \" and \$"; 1361b39c5158Smillert if ($XS) { 1362b39c5158Smillert TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with \" and \$"; 1363b39c5158Smillert } 1364b39c5158Smillert 1365b39c5158Smillert 1366b39c5158Smillert # XS used to produce 'D'oh!' which is well, D'oh! 1367b39c5158Smillert # Andreas found this one, which in turn discovered the previous two. 1368b39c5158Smillert############# 334 1369b39c5158Smillert $WANT = <<'EOT'; 1370b39c5158Smillert#$VAR1 = 'D\'oh!'; 1371b39c5158SmillertEOT 1372b39c5158Smillert 1373b39c5158Smillert $a = "D'oh!\x{100}"; 1374b39c5158Smillert chop $a; 1375b39c5158Smillert TEST q(Data::Dumper->Dump([$a])), "utf8 flag with '"; 1376b39c5158Smillert if ($XS) { 1377b39c5158Smillert TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with '"; 1378b39c5158Smillert } 1379b39c5158Smillert} 1380b39c5158Smillert 1381b39c5158Smillert# Jarkko found that -Mutf8 caused some tests to fail. Turns out that there 1382b39c5158Smillert# was an otherwise untested code path in the XS for utf8 hash keys with purity 1383b39c5158Smillert# 1 1384b39c5158Smillert 1385b39c5158Smillert{ 1386b39c5158Smillert $WANT = <<'EOT'; 1387b39c5158Smillert#$ping = \*::ping; 1388b39c5158Smillert#*::ping = \5; 1389b39c5158Smillert#*::ping = { 1390b39c5158Smillert# "\x{decaf}\x{decaf}\x{decaf}\x{decaf}" => do{my $o} 1391b39c5158Smillert#}; 1392b39c5158Smillert#*::ping{HASH}->{"\x{decaf}\x{decaf}\x{decaf}\x{decaf}"} = *::ping{SCALAR}; 1393b39c5158Smillert#%pong = %{*::ping{HASH}}; 1394b39c5158SmillertEOT 1395b39c5158Smillert local $Data::Dumper::Purity = 1; 1396b39c5158Smillert local $Data::Dumper::Sortkeys; 1397b39c5158Smillert $ping = 5; 1398b39c5158Smillert %ping = (chr (0xDECAF) x 4 =>\$ping); 1399b39c5158Smillert for $Data::Dumper::Sortkeys (0, 1) { 1400b39c5158Smillert if($] >= 5.007) { 1401b39c5158Smillert TEST q(Data::Dumper->Dump([\\*ping, \\%ping], ['*ping', '*pong'])); 1402b39c5158Smillert TEST q(Data::Dumper->Dumpxs([\\*ping, \\%ping], ['*ping', '*pong'])) if $XS; 1403b39c5158Smillert } else { 1404b39c5158Smillert SKIP_TEST "Incomplete support for UTF-8 in old perls"; 1405b39c5158Smillert SKIP_TEST "Incomplete support for UTF-8 in old perls"; 1406b39c5158Smillert } 1407b39c5158Smillert } 1408b39c5158Smillert} 1409b39c5158Smillert 1410b39c5158Smillert# XS for quotekeys==0 was not being defensive enough against utf8 flagged 1411b39c5158Smillert# scalars 1412b39c5158Smillert 1413b39c5158Smillert{ 1414b39c5158Smillert $WANT = <<'EOT'; 1415b39c5158Smillert#$VAR1 = { 1416b39c5158Smillert# perl => 'rocks' 1417b39c5158Smillert#}; 1418b39c5158SmillertEOT 1419b39c5158Smillert local $Data::Dumper::Quotekeys = 0; 1420b39c5158Smillert my $k = 'perl' . chr 256; 1421b39c5158Smillert chop $k; 1422b39c5158Smillert %foo = ($k => 'rocks'); 1423b39c5158Smillert 1424b39c5158Smillert TEST q(Data::Dumper->Dump([\\%foo])), "quotekeys == 0 for utf8 flagged ASCII"; 1425b39c5158Smillert TEST q(Data::Dumper->Dumpxs([\\%foo])), 1426b39c5158Smillert "XS quotekeys == 0 for utf8 flagged ASCII" if $XS; 1427b39c5158Smillert} 1428b39c5158Smillert############# 358 1429b39c5158Smillert{ 1430b39c5158Smillert $WANT = <<'EOT'; 1431b39c5158Smillert#$VAR1 = [ 1432b39c5158Smillert# undef, 1433b39c5158Smillert# undef, 1434b39c5158Smillert# 1 1435b39c5158Smillert#]; 1436b39c5158SmillertEOT 1437b39c5158Smillert @foo = (); 1438b39c5158Smillert $foo[2] = 1; 1439b39c5158Smillert TEST q(Data::Dumper->Dump([\@foo])), 'Richard Clamp, Message-Id: <20030104005247.GA27685@mirth.demon.co.uk>'; 1440b39c5158Smillert TEST q(Data::Dumper->Dumpxs([\@foo])) if $XS; 1441b39c5158Smillert} 1442b39c5158Smillert 1443898184e3Ssthen############# 364 1444898184e3Ssthen# Make sure $obj->Dumpxs returns the right thing in list context. This was 1445898184e3Ssthen# broken by the initial attempt to fix [perl #74170]. 1446898184e3Ssthen$WANT = <<'EOT'; 1447898184e3Ssthen#$VAR1 = []; 1448898184e3SsthenEOT 1449898184e3SsthenTEST q(join " ", new Data::Dumper [[]],[] =>->Dumpxs), 1450898184e3Ssthen '$obj->Dumpxs in list context' 1451898184e3Ssthen if $XS; 1452b39c5158Smillert 1453898184e3Ssthen############# 366 1454898184e3Ssthen{ 1455898184e3Ssthen $WANT = <<'EOT'; 1456898184e3Ssthen#$VAR1 = [ 1457898184e3Ssthen# "\0\1\2\3\4\5\6\a\b\t\n\13\f\r\16\17\20\21\22\23\24\25\26\27\30\31\32\e\34\35\36\37 !\"#\$%&'()*+,-./0123456789:;<=>?\@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\177\200\201\202\203\204\205\206\207\210\211\212\213\214\215\216\217\220\221\222\223\224\225\226\227\230\231\232\233\234\235\236\237\240\241\242\243\244\245\246\247\250\251\252\253\254\255\256\257\260\261\262\263\264\265\266\267\270\271\272\273\274\275\276\277\300\301\302\303\304\305\306\307\310\311\312\313\314\315\316\317\320\321\322\323\324\325\326\327\330\331\332\333\334\335\336\337\340\341\342\343\344\345\346\347\350\351\352\353\354\355\356\357\360\361\362\363\364\365\366\367\370\371\372\373\374\375\376\377" 1458898184e3Ssthen#]; 1459898184e3SsthenEOT 1460898184e3Ssthen 1461898184e3Ssthen $foo = [ join "", map chr, 0..255 ]; 1462898184e3Ssthen local $Data::Dumper::Useqq = 1; 1463898184e3Ssthen TEST q(Dumper($foo)), 'All latin1 characters'; 1464898184e3Ssthen for (1..3) { print "not ok " . (++$TNUM) . " # TODO NYI\n" if $XS } # TEST q(Data::Dumper::DumperX($foo)) if $XS; 1465898184e3Ssthen} 1466898184e3Ssthen 1467898184e3Ssthen############# 372 1468898184e3Ssthen{ 1469898184e3Ssthen $WANT = <<'EOT'; 1470898184e3Ssthen#$VAR1 = [ 1471898184e3Ssthen# "\0\1\2\3\4\5\6\a\b\t\n\13\f\r\16\17\20\21\22\23\24\25\26\27\30\31\32\e\34\35\36\37 !\"#\$%&'()*+,-./0123456789:;<=>?\@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\177\x{80}\x{81}\x{82}\x{83}\x{84}\x{85}\x{86}\x{87}\x{88}\x{89}\x{8a}\x{8b}\x{8c}\x{8d}\x{8e}\x{8f}\x{90}\x{91}\x{92}\x{93}\x{94}\x{95}\x{96}\x{97}\x{98}\x{99}\x{9a}\x{9b}\x{9c}\x{9d}\x{9e}\x{9f}\x{a0}\x{a1}\x{a2}\x{a3}\x{a4}\x{a5}\x{a6}\x{a7}\x{a8}\x{a9}\x{aa}\x{ab}\x{ac}\x{ad}\x{ae}\x{af}\x{b0}\x{b1}\x{b2}\x{b3}\x{b4}\x{b5}\x{b6}\x{b7}\x{b8}\x{b9}\x{ba}\x{bb}\x{bc}\x{bd}\x{be}\x{bf}\x{c0}\x{c1}\x{c2}\x{c3}\x{c4}\x{c5}\x{c6}\x{c7}\x{c8}\x{c9}\x{ca}\x{cb}\x{cc}\x{cd}\x{ce}\x{cf}\x{d0}\x{d1}\x{d2}\x{d3}\x{d4}\x{d5}\x{d6}\x{d7}\x{d8}\x{d9}\x{da}\x{db}\x{dc}\x{dd}\x{de}\x{df}\x{e0}\x{e1}\x{e2}\x{e3}\x{e4}\x{e5}\x{e6}\x{e7}\x{e8}\x{e9}\x{ea}\x{eb}\x{ec}\x{ed}\x{ee}\x{ef}\x{f0}\x{f1}\x{f2}\x{f3}\x{f4}\x{f5}\x{f6}\x{f7}\x{f8}\x{f9}\x{fa}\x{fb}\x{fc}\x{fd}\x{fe}\x{ff}\x{20ac}" 1472898184e3Ssthen#]; 1473898184e3SsthenEOT 1474898184e3Ssthen 1475898184e3Ssthen $foo = [ join "", map chr, 0..255, 0x20ac ]; 1476898184e3Ssthen local $Data::Dumper::Useqq = 1; 1477898184e3Ssthen if ($] < 5.007) { 1478898184e3Ssthen print "not ok " . (++$TNUM) . " # TODO - fails under 5.6\n" for 1..3; 1479898184e3Ssthen } 1480898184e3Ssthen else { 1481898184e3Ssthen TEST q(Dumper($foo)), 1482898184e3Ssthen 'All latin1 characters with utf8 flag including a wide character'; 1483898184e3Ssthen } 1484898184e3Ssthen for (1..3) { print "not ok " . (++$TNUM) . " # TODO NYI\n" if $XS } # TEST q(Data::Dumper::DumperX($foo)) if $XS; 1485898184e3Ssthen} 1486898184e3Ssthen 1487898184e3Ssthen############# 378 1488898184e3Ssthen{ 1489898184e3Ssthen # If XS cannot load, the pure-Perl version cannot deparse vstrings with 1490898184e3Ssthen # underscores properly. In 5.8.0, vstrings are just strings. 1491*91f110e0Safresh1 my $no_vstrings = <<'NOVSTRINGS'; 1492898184e3Ssthen#$a = \'ABC'; 1493898184e3Ssthen#$b = \'ABC'; 1494898184e3Ssthen#$c = \'ABC'; 1495898184e3Ssthen#$d = \'ABC'; 1496*91f110e0Safresh1NOVSTRINGS 1497*91f110e0Safresh1 my $vstrings_corr = <<'VSTRINGS_CORRECT'; 1498*91f110e0Safresh1#$a = \v65.66.67; 1499*91f110e0Safresh1#$b = \v65.66.067; 1500*91f110e0Safresh1#$c = \v65.66.6_7; 1501*91f110e0Safresh1#$d = \'ABC'; 1502*91f110e0Safresh1VSTRINGS_CORRECT 1503*91f110e0Safresh1 $WANT = $] <= 5.0080001 1504*91f110e0Safresh1 ? $no_vstrings 1505*91f110e0Safresh1 : $vstrings_corr; 1506*91f110e0Safresh1 1507898184e3Ssthen @::_v = ( 1508898184e3Ssthen \v65.66.67, 1509898184e3Ssthen \($] < 5.007 ? v65.66.67 : eval 'v65.66.067'), 1510898184e3Ssthen \v65.66.6_7, 1511898184e3Ssthen \~v190.189.188 1512898184e3Ssthen ); 1513*91f110e0Safresh1 if ($] >= 5.010) { 1514898184e3Ssthen TEST q(Data::Dumper->Dump(\@::_v, [qw(a b c d)])), 'vstrings'; 1515898184e3Ssthen TEST q(Data::Dumper->Dumpxs(\@::_v, [qw(a b c d)])), 'xs vstrings' 1516898184e3Ssthen if $XS; 1517898184e3Ssthen } 1518*91f110e0Safresh1 else { # Skip tests before 5.10. vstrings considered funny before 1519*91f110e0Safresh1 SKIP_TEST "vstrings considered funny before 5.10.0"; 1520*91f110e0Safresh1 SKIP_TEST "vstrings considered funny before 5.10.0 (XS)" 1521*91f110e0Safresh1 if $XS; 1522*91f110e0Safresh1 } 1523*91f110e0Safresh1} 1524898184e3Ssthen 1525898184e3Ssthen############# 384 1526898184e3Ssthen{ 1527898184e3Ssthen # [perl #107372] blessed overloaded globs 1528898184e3Ssthen $WANT = <<'EOW'; 1529898184e3Ssthen#$VAR1 = bless( \*::finkle, 'overtest' ); 1530898184e3SsthenEOW 1531898184e3Ssthen { 1532898184e3Ssthen package overtest; 1533898184e3Ssthen use overload fallback=>1, q\""\=>sub{"oaoaa"}; 1534898184e3Ssthen } 1535898184e3Ssthen TEST q(Data::Dumper->Dump([bless \*finkle, "overtest"])), 1536898184e3Ssthen 'blessed overloaded globs'; 1537898184e3Ssthen TEST q(Data::Dumper->Dumpxs([\*finkle])), 'blessed overloaded globs (xs)' 1538898184e3Ssthen if $XS; 1539898184e3Ssthen} 1540