3 # testsuite for Data::Dumper
7 require Config; import Config;
8 if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
9 print "1..0 # Skip: Data::Dumper was not built\n";
14 # Since Perl 5.8.1 because otherwise hash ordering is really random.
15 local $Data::Dumper::Sortkeys = 1;
19 my $Is_ebcdic = defined($Config{'ebcdic'}) && $Config{'ebcdic'} eq 'define';
21 $Data::Dumper::Pad = "#";
32 $t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g
33 if ($WANT =~ /deadbeef/);
35 # these data need massaging with non ascii character sets
36 # because of hashing order differences
37 $WANT = join("\n",sort(split(/\n/,$WANT)));
39 $t = join("\n",sort(split(/\n/,$t)));
42 $name = $name ? " - $name" : '';
43 print( ($t eq $WANT and not $@) ? "ok $TNUM$name\n"
44 : "not ok $TNUM$name\n--Expected--\n$WANT\n--Got--\n$@$t\n");
47 if ($Is_ebcdic) { # EBCDIC.
48 if ($TNUM == 311 || $TNUM == 314) {
56 print $@ ? "not ok $TNUM\n# \$@ says: $@\n" : "ok $TNUM\n";
60 $t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g
61 if ($WANT =~ /deadbeef/);
63 # here too there are hashing order differences
64 $WANT = join("\n",sort(split(/\n/,$WANT)));
66 $t = join("\n",sort(split(/\n/,$t)));
69 print( ($t eq $WANT and not $@) ? "ok $TNUM\n"
70 : "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n");
75 ++$TNUM; print "ok $TNUM # skip $reason\n";
76 ++$TNUM; print "ok $TNUM # skip $reason\n";
77 ++$TNUM; print "ok $TNUM # skip $reason\n";
80 # Force Data::Dumper::Dump to use perl. We test Dumpxs explicitly by calling
81 # it direct. Out here it lets us knobble the next if to test that the perl
82 # only tests do work (and count correctly)
83 $Data::Dumper::Useperl = 1;
84 if (defined &Data::Dumper::Dumpxs) {
85 print "### XS extension loaded, will run XS tests\n";
89 print "### XS extensions not loaded, will NOT run XS tests\n";
125 TEST q(Data::Dumper->Dump([$a,$b,$c], [qw(a b), 6]));
126 TEST q(Data::Dumper->Dumpxs([$a,$b,$c], [qw(a b), 6])) if $XS;
149 $Data::Dumper::Purity = 1; # fill in the holes for eval
150 TEST q(Data::Dumper->Dump([$a, $b], [qw(*a b)])); # print as @a
151 TEST q(Data::Dumper->Dumpxs([$a, $b], [qw(*a b)])) if $XS;
169 #$b{'c'} = $b{'a'}[2];
173 TEST q(Data::Dumper->Dump([$b, $a], [qw(*b a)])); # print as %b
174 TEST q(Data::Dumper->Dumpxs([$b, $a], [qw(*b a)])) if $XS;
189 #$a->[1]{'b'} = $a->[1];
195 $Data::Dumper::Indent = 1;
197 $d = Data::Dumper->new([$a,$b], [qw(a b)]);
198 $d->Seen({'*c' => $c});
203 $d = Data::Dumper->new([$a,$b], [qw(a b)]);
204 $d->Seen({'*c' => $c});
232 $d->Purity(0)->Quotekeys(0);
233 TEST q( $d->Reset; $d->Dump );
235 TEST q( $d->Reset; $d->Dumpxs ) if $XS;
251 #$VAR1->[1]{'a'} = $VAR1;
252 #$VAR1->[1]{'b'} = $VAR1->[1];
253 #$VAR1->[2] = $VAR1->[1]{'c'};
257 TEST q(Data::Dumper::DumperX($a)) if $XS;
276 local $Data::Dumper::Purity = 0;
277 local $Data::Dumper::Quotekeys = 0;
278 local $Data::Dumper::Terse = 1;
280 TEST q(Data::Dumper::DumperX($a)) if $XS;
288 # "abc\0'\efg" => "mno\0",
293 $foo = { "abc\000\'\efg" => "mno\000",
297 local $Data::Dumper::Useqq = 1;
298 TEST q(Dumper($foo));
303 # 'abc\0\\'\efg' => 'mno\0',
309 local $Data::Dumper::Useqq = 1;
310 TEST q(Data::Dumper::DumperX($foo)) if $XS; # cheat
323 %foo = (a=>1,b=>\$foo,c=>\@foo);
345 #*::foo{ARRAY}->[1] = $foo;
346 #*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
347 #*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY};
348 #*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2];
349 #*::foo = *::foo{ARRAY}->[2];
350 #@bar = @{*::foo{ARRAY}};
351 #%baz = %{*::foo{ARRAY}->[2]};
354 $Data::Dumper::Purity = 1;
355 $Data::Dumper::Indent = 3;
356 TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz']));
357 TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])) if $XS;
374 #*::foo{ARRAY}->[1] = $foo;
375 #*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
376 #*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY};
377 #*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2];
378 #*::foo = *::foo{ARRAY}->[2];
379 #$bar = *::foo{ARRAY};
380 #$baz = *::foo{ARRAY}->[2];
383 $Data::Dumper::Indent = 1;
384 TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz']));
385 TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])) if $XS;
403 #*::foo{HASH}->{'b'} = *::foo{SCALAR};
404 #*::foo{HASH}->{'c'} = \@bar;
405 #*::foo{HASH}->{'d'} = *::foo{HASH};
406 #$bar[2] = *::foo{HASH};
407 #%baz = %{*::foo{HASH}};
411 TEST q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo']));
412 TEST q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo'])) if $XS;
430 #*::foo{HASH}->{'b'} = *::foo{SCALAR};
431 #*::foo{HASH}->{'c'} = $bar;
432 #*::foo{HASH}->{'d'} = *::foo{HASH};
433 #$bar->[2] = *::foo{HASH};
434 #$baz = *::foo{HASH};
438 TEST q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo']));
439 TEST q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo'])) if $XS;
458 $Data::Dumper::Purity = 0;
459 $Data::Dumper::Quotekeys = 0;
460 TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz']));
461 TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])) if $XS;
480 TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz']));
481 TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])) if $XS;
489 @dogs = ( 'Fido', 'Wags' );
496 $mutts = $mutts; # avoid warning
506 # ${$kennels{First}},
507 # ${$kennels{Second}},
514 $d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts],
515 [qw(*kennels *dogs *mutts)] );
520 $d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts],
521 [qw(*kennels *dogs *mutts)] );
529 #%kennels = %kennels;
535 TEST q($d->Dumpxs) if $XS;
545 # ${$kennels{First}},
546 # ${$kennels{Second}},
553 TEST q($d->Reset; $d->Dump);
555 TEST q($d->Reset; $d->Dumpxs);
565 # First => \$dogs[0],
566 # Second => \$dogs[1]
569 #%kennels = %{$dogs[2]};
570 #%mutts = %{$dogs[2]};
574 $d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts],
575 [qw(*dogs *kennels *mutts)] );
580 $d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts],
581 [qw(*dogs *kennels *mutts)] );
588 TEST q($d->Reset->Dump);
590 TEST q($d->Reset->Dumpxs);
611 $d = Data::Dumper->new( [\@dogs, \%kennel], [qw(*dogs *kennels)] );
612 $d->Deepcopy(1)->Dump;
615 TEST q($d->Reset->Dumpxs);
622 sub z { print "foo\n" }
634 TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dump;);
635 TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dumpxs;)
647 TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dump;);
648 TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dumpxs;)
660 TEST q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dump;);
661 TEST q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dumpxs;)
680 TEST q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dump;);
681 TEST q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dumpxs;)
696 TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;);
697 TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;)
702 $a = [{ a => \$b }, { b => undef }];
703 $b = [{ c => \$b }, { d => \$a }];
723 #${$a->[0]{a}}->[0]->{c} = $a->[0]{a};
724 #${${$a->[0]{a}}->[1]->{d}} = $a;
728 TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;);
729 TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;)
734 $a = [[[[\\\\\'foo']]]];
751 #$c = ${${$a->[0][0][0][0]}};
754 TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dump;);
755 TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dumpxs;)
774 # e => 'ARRAY(0xdeadbeef)'
783 TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dump;);
784 TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dumpxs;)
791 # b => 'HASH(0xdeadbeef)'
799 TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dump;);
800 TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dumpxs;)
816 TEST q(Data::Dumper->new([$b],['b'])->Purity(0)->Dump;);
817 TEST q(Data::Dumper->new([$b],['b'])->Purity(0)->Dumpxs;)
826 #${$b->[0]} = $b->[0];
830 TEST q(Data::Dumper->new([$b],['b'])->Purity(1)->Dump;);
831 TEST q(Data::Dumper->new([$b],['b'])->Purity(1)->Dumpxs;)
838 ## XS code was adding an extra \0
844 TEST q(Data::Dumper->Dump([$a], ['a'])), "\\x{9c10}";
846 SKIP_TEST "Incomplete support for UTF-8 in old perls";
848 TEST q(Data::Dumper->Dumpxs([$a], ['a'])), "XS \\x{9c10}"
854 $a = { map { ("$_$_$_", ++$i) } 'I'..'Q' };
872 TEST q(Data::Dumper->new([$a])->Dump;);
873 TEST q(Data::Dumper->new([$a])->Dumpxs;)
879 $c = { map { (++$i, "$_$_$_") } 'I'..'Q' };
880 local $Data::Dumper::Sortkeys = \&sort199;
883 return [ sort { $b <=> $a } keys %$hash ];
902 # perl code does keys and values as numbers if possible
903 TEST q(Data::Dumper->new([$c])->Dump;);
904 # XS code always does them as strings
905 $WANT =~ s/ (\d+)/ '$1'/gs;
906 TEST q(Data::Dumper->new([$c])->Dumpxs;)
912 $c = { map { (++$i, "$_$_$_") } 'I'..'Q' };
913 $d = { reverse %$c };
914 local $Data::Dumper::Sortkeys = \&sort205;
918 $hash eq $c ? (sort { $a <=> $b } keys %$hash)
919 : (reverse sort keys %$hash)
952 TEST q(Data::Dumper->new([[$c, $d]])->Dump;);
953 $WANT =~ s/ (\d+)/ '$1'/gs;
954 TEST q(Data::Dumper->new([[$c, $d]])->Dumpxs;)
959 local $Data::Dumper::Deparse = 1;
960 local $Data::Dumper::Indent = 2;
972 if(" $Config{'extensions'} " !~ m[ B ]) {
973 SKIP_TEST "Perl configured without B module";
975 TEST q(Data::Dumper->new([{ foo => sub { print "foo"; } }])->Dump);
983 # The controls (bare numbers) are stored either as integers or floating point.
984 # [depending on whether the tokeniser sees things like ".".
985 # The peephole optimiser only runs for constant folding, not single constants,
986 # so I already have some NVs, some IVs
987 # The string versions are not. They are all PV
989 # This is arguably all far too chummy with the implementation, but I really
990 # want to ensure that we don't go wrong when flags on scalars get as side
991 # effects of reading them.
993 # These tests are actually testing the precise output of the current
994 # implementation, so will most likely fail if the implementation changes,
995 # even if the new implementation produces different but correct results.
996 # It would be nice to test for wrong answers, but I can't see how to do that,
997 # so instead I'm checking for unexpected answers. (ie -2 becoming "-2" is not
998 # wrong, but I can't see an easy, reliable way to code that knowledge)
1000 # Numbers (seen by the tokeniser as numbers, stored as numbers.
1003 0, +1, -2, 3.0, +4.0, -5.0, 6.5, +7.5, -8.5,
1004 9, +10, -11, 12.0, +13.0, -14.0, 15.5, +16.25, -17.75,
1009 "0", "+1", "-2", "3.0", "+4.0", "-5.0", "6.5", "+7.5", "-8.5", " 9",
1010 " +10", " -11", " 12.0", " +13.0", " -14.0", " 15.5", " +16.25", " -17.75",
1013 # The perl code always does things the same way for numbers.
1014 $WANT_PL_N = <<'EOT';
1034 # The perl code knows that 0 and -2 stringify exactly back to the strings,
1035 # so it dumps them as numbers, not strings.
1036 $WANT_PL_S = <<'EOT';
1053 #$VAR17 = ' +16.25';
1054 #$VAR18 = ' -17.75';
1057 # The XS code differs.
1058 # These are the numbers as seen by the tokeniser. Constants aren't folded
1059 # (which makes IVs where possible) so values the tokeniser thought were
1060 # floating point are stored as NVs. The XS code outputs these as strings,
1061 # but as it has converted them from NVs, leading + signs will not be there.
1062 $WANT_XS_N = <<'EOT';
1083 # These are the strings as seen by the tokeniser. The XS code will output
1084 # these for all cases except where the scalar has been used in integer context
1085 $WANT_XS_S = <<'EOT';
1102 #$VAR17 = ' +16.25';
1103 #$VAR18 = ' -17.75';
1106 # These are the numbers as IV-ized by &
1107 # These will differ from WANT_XS_N because now IV flags will be set on all
1108 # values that were actually integer, and the XS code will then output these
1109 # as numbers not strings.
1110 $WANT_XS_I = <<'EOT';
1131 # Some of these tests will be redundant.
1132 @numbers_s = @numbers_i = @numbers_is = @numbers_n = @numbers_ns = @numbers_ni
1133 = @numbers_nis = @numbers;
1134 @strings_s = @strings_i = @strings_is = @strings_n = @strings_ns = @strings_ni
1135 = @strings_nis = @strings;
1136 # Use them in an integer context
1137 foreach (@numbers_i, @numbers_ni, @numbers_nis, @numbers_is,
1138 @strings_i, @strings_ni, @strings_nis, @strings_is) {
1139 my $b = sprintf "%d", $_;
1141 # Use them in a floating point context
1142 foreach (@numbers_n, @numbers_ni, @numbers_nis, @numbers_ns,
1143 @strings_n, @strings_ni, @strings_nis, @strings_ns) {
1144 my $b = sprintf "%e", $_;
1146 # Use them in a string context
1147 foreach (@numbers_s, @numbers_is, @numbers_nis, @numbers_ns,
1148 @strings_s, @strings_is, @strings_nis, @strings_ns) {
1149 my $b = sprintf "%s", $_;
1152 # use Devel::Peek; Dump ($_) foreach @vanilla_c;
1155 TEST q(Data::Dumper->new(\@numbers)->Dump), 'Numbers';
1156 TEST q(Data::Dumper->new(\@numbers_s)->Dump), 'Numbers PV';
1157 TEST q(Data::Dumper->new(\@numbers_i)->Dump), 'Numbers IV';
1158 TEST q(Data::Dumper->new(\@numbers_is)->Dump), 'Numbers IV,PV';
1159 TEST q(Data::Dumper->new(\@numbers_n)->Dump), 'Numbers NV';
1160 TEST q(Data::Dumper->new(\@numbers_ns)->Dump), 'Numbers NV,PV';
1161 TEST q(Data::Dumper->new(\@numbers_ni)->Dump), 'Numbers NV,IV';
1162 TEST q(Data::Dumper->new(\@numbers_nis)->Dump), 'Numbers NV,IV,PV';
1164 TEST q(Data::Dumper->new(\@strings)->Dump), 'Strings';
1165 TEST q(Data::Dumper->new(\@strings_s)->Dump), 'Strings PV';
1166 TEST q(Data::Dumper->new(\@strings_i)->Dump), 'Strings IV';
1167 TEST q(Data::Dumper->new(\@strings_is)->Dump), 'Strings IV,PV';
1168 TEST q(Data::Dumper->new(\@strings_n)->Dump), 'Strings NV';
1169 TEST q(Data::Dumper->new(\@strings_ns)->Dump), 'Strings NV,PV';
1170 TEST q(Data::Dumper->new(\@strings_ni)->Dump), 'Strings NV,IV';
1171 TEST q(Data::Dumper->new(\@strings_nis)->Dump), 'Strings NV,IV,PV';
1173 my $nv_preserves_uv = defined $Config{d_nv_preserves_uv};
1174 my $nv_preserves_uv_4bits = exists($Config{nv_preserves_uv_bits}) && $Config{nv_preserves_uv_bits} >= 4;
1176 TEST q(Data::Dumper->new(\@numbers)->Dumpxs), 'XS Numbers';
1177 TEST q(Data::Dumper->new(\@numbers_s)->Dumpxs), 'XS Numbers PV';
1178 if ($nv_preserves_uv || $nv_preserves_uv_4bits) {
1180 TEST q(Data::Dumper->new(\@numbers_i)->Dumpxs), 'XS Numbers IV';
1181 TEST q(Data::Dumper->new(\@numbers_is)->Dumpxs), 'XS Numbers IV,PV';
1183 SKIP_TEST "NV does not preserve 4bits";
1184 SKIP_TEST "NV does not preserve 4bits";
1187 TEST q(Data::Dumper->new(\@numbers_n)->Dumpxs), 'XS Numbers NV';
1188 TEST q(Data::Dumper->new(\@numbers_ns)->Dumpxs), 'XS Numbers NV,PV';
1189 if ($nv_preserves_uv || $nv_preserves_uv_4bits) {
1191 TEST q(Data::Dumper->new(\@numbers_ni)->Dumpxs), 'XS Numbers NV,IV';
1192 TEST q(Data::Dumper->new(\@numbers_nis)->Dumpxs), 'XS Numbers NV,IV,PV';
1194 SKIP_TEST "NV does not preserve 4bits";
1195 SKIP_TEST "NV does not preserve 4bits";
1199 TEST q(Data::Dumper->new(\@strings)->Dumpxs), 'XS Strings';
1200 TEST q(Data::Dumper->new(\@strings_s)->Dumpxs), 'XS Strings PV';
1201 # This one used to really mess up. New code actually emulates the .pm code
1203 TEST q(Data::Dumper->new(\@strings_i)->Dumpxs), 'XS Strings IV';
1204 TEST q(Data::Dumper->new(\@strings_is)->Dumpxs), 'XS Strings IV,PV';
1205 if ($nv_preserves_uv || $nv_preserves_uv_4bits) {
1207 TEST q(Data::Dumper->new(\@strings_n)->Dumpxs), 'XS Strings NV';
1208 TEST q(Data::Dumper->new(\@strings_ns)->Dumpxs), 'XS Strings NV,PV';
1210 SKIP_TEST "NV does not preserve 4bits";
1211 SKIP_TEST "NV does not preserve 4bits";
1213 # This one used to really mess up. New code actually emulates the .pm code
1215 TEST q(Data::Dumper->new(\@strings_ni)->Dumpxs), 'XS Strings NV,IV';
1216 TEST q(Data::Dumper->new(\@strings_nis)->Dumpxs), 'XS Strings NV,IV,PV';
1222 ## Perl code was using /...$/ and hence missing the \n.
1228 # Can't pad with # as the output has an embedded newline.
1229 local $Data::Dumper::Pad = "my ";
1230 TEST q(Data::Dumper->Dump(["42\n"])), "number with trailing newline";
1231 TEST q(Data::Dumper->Dumpxs(["42\n"])), "XS number with trailing newline"
1251 ## Perl code flips over at 10 digits.
1254 #$VAR2 = '1000000000';
1255 #$VAR3 = '9999999999';
1256 #$VAR4 = '10000000000';
1257 #$VAR5 = -999999999;
1258 #$VAR6 = '-1000000000';
1259 #$VAR7 = '-9999999999';
1260 #$VAR8 = '-10000000000';
1261 #$VAR9 = '4294967295';
1262 #$VAR10 = '4294967296';
1263 #$VAR11 = '-2147483648';
1264 #$VAR12 = '-2147483649';
1267 TEST q(Data::Dumper->Dump(\@a)), "long integers";
1270 ## XS code flips over at 11 characters ("-" is a char) or larger than int.
1271 if (~0 == 0xFFFFFFFF) {
1275 #$VAR2 = 1000000000;
1276 #$VAR3 = '9999999999';
1277 #$VAR4 = '10000000000';
1278 #$VAR5 = -999999999;
1279 #$VAR6 = '-1000000000';
1280 #$VAR7 = '-9999999999';
1281 #$VAR8 = '-10000000000';
1282 #$VAR9 = 4294967295;
1283 #$VAR10 = '4294967296';
1284 #$VAR11 = '-2147483648';
1285 #$VAR12 = '-2147483649';
1290 #$VAR2 = 1000000000;
1291 #$VAR3 = 9999999999;
1292 #$VAR4 = '10000000000';
1293 #$VAR5 = -999999999;
1294 #$VAR6 = '-1000000000';
1295 #$VAR7 = '-9999999999';
1296 #$VAR8 = '-10000000000';
1297 #$VAR9 = 4294967295;
1298 #$VAR10 = 4294967296;
1299 #$VAR11 = '-2147483648';
1300 #$VAR12 = '-2147483649';
1303 TEST q(Data::Dumper->Dumpxs(\@a)), "XS long integers";
1310 $b = "Bad. XS didn't escape dollar sign";
1312 $WANT = <<"EOT"; # Careful. This is '' string written inside '' here doc
1313 #\$VAR1 = '\$b\"\@\\\\\xB1';
1315 $a = "\$b\"\@\\\xB1\x{100}";
1317 TEST q(Data::Dumper->Dump([$a])), "utf8 flag with \" and \$";
1319 $WANT = <<'EOT'; # While this is "" string written inside "" here doc
1320 #$VAR1 = "\$b\"\@\\\x{b1}";
1322 TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with \" and \$";
1325 $b = "Bad. XS didn't escape dollar sign";
1327 $WANT = <<"EOT"; # Careful. This is '' string written inside '' here doc
1328 #\$VAR1 = '\$b\"\@\\\\\xA3';
1331 $a = "\$b\"\@\\\xA3\x{100}";
1333 TEST q(Data::Dumper->Dump([$a])), "utf8 flag with \" and \$";
1335 $WANT = <<'EOT'; # While this is "" string written inside "" here doc
1336 #$VAR1 = "\$b\"\@\\\x{a3}";
1338 TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with \" and \$";
1341 # XS used to produce "$b\"' which is 4 chars, not 3. [ie wrongly qq(\$b\\\")]
1347 $a = "\$b\"\x{100}";
1349 TEST q(Data::Dumper->Dump([$a])), "utf8 flag with \" and \$";
1351 TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with \" and \$";
1355 # XS used to produce 'D'oh!' which is well, D'oh!
1356 # Andreas found this one, which in turn discovered the previous two.
1362 $a = "D'oh!\x{100}";
1364 TEST q(Data::Dumper->Dump([$a])), "utf8 flag with '";
1366 TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with '";
1370 # Jarkko found that -Mutf8 caused some tests to fail. Turns out that there
1371 # was an otherwise untested code path in the XS for utf8 hash keys with purity
1379 # "\x{decaf}\x{decaf}\x{decaf}\x{decaf}" => do{my $o}
1381 #*::ping{HASH}->{"\x{decaf}\x{decaf}\x{decaf}\x{decaf}"} = *::ping{SCALAR};
1382 #%pong = %{*::ping{HASH}};
1384 local $Data::Dumper::Purity = 1;
1385 local $Data::Dumper::Sortkeys;
1387 %ping = (chr (0xDECAF) x 4 =>\$ping);
1388 for $Data::Dumper::Sortkeys (0, 1) {
1390 TEST q(Data::Dumper->Dump([\\*ping, \\%ping], ['*ping', '*pong']));
1391 TEST q(Data::Dumper->Dumpxs([\\*ping, \\%ping], ['*ping', '*pong'])) if $XS;
1393 SKIP_TEST "Incomplete support for UTF-8 in old perls";
1394 SKIP_TEST "Incomplete support for UTF-8 in old perls";
1399 # XS for quotekeys==0 was not being defensive enough against utf8 flagged
1408 local $Data::Dumper::Quotekeys = 0;
1409 my $k = 'perl' . chr 256;
1411 %foo = ($k => 'rocks');
1413 TEST q(Data::Dumper->Dump([\\%foo])), "quotekeys == 0 for utf8 flagged ASCII";
1414 TEST q(Data::Dumper->Dumpxs([\\%foo])),
1415 "XS quotekeys == 0 for utf8 flagged ASCII" if $XS;
1428 TEST q(Data::Dumper->Dump([\@foo])), 'Richard Clamp, Message-Id: <20030104005247.GA27685@mirth.demon.co.uk>';
1429 TEST q(Data::Dumper->Dumpxs([\@foo])) if $XS;