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