3 # testsuite for Data::Dumper
8 unshift @INC, '../lib' if -d '../lib';
13 my $Is_ebcdic = defined($Config{'ebcdic'}) && $Config{'ebcdic'} eq 'define';
15 $Data::Dumper::Pad = "#";
25 $t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g
26 if ($WANT =~ /deadbeef/);
28 # these data need massaging with non ascii character sets
29 # because of hashing order differences
30 $WANT = join("\n",sort(split(/\n/,$WANT)));
32 $t = join("\n",sort(split(/\n/,$t)));
35 print( ($t eq $WANT and not $@) ? "ok $TNUM\n"
36 : "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n");
40 print $@ ? "not ok $TNUM\n# \$@ says: $@\n" : "ok $TNUM\n";
44 $t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g
45 if ($WANT =~ /deadbeef/);
47 # here too there are hashing order differences
48 $WANT = join("\n",sort(split(/\n/,$WANT)));
50 $t = join("\n",sort(split(/\n/,$t)));
53 print( ($t eq $WANT and not $@) ? "ok $TNUM\n"
54 : "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n");
57 if (defined &Data::Dumper::Dumpxs) {
58 print "### XS extension loaded, will run XS tests\n";
62 print "### XS extensions not loaded, will NOT run XS tests\n";
97 TEST q(Data::Dumper->Dump([$a,$b,$c], [qw(a b c)]));
98 TEST q(Data::Dumper->Dumpxs([$a,$b,$c], [qw(a b c)])) if $XS;
121 $Data::Dumper::Purity = 1; # fill in the holes for eval
122 TEST q(Data::Dumper->Dump([$a, $b], [qw(*a b)])); # print as @a
123 TEST q(Data::Dumper->Dumpxs([$a, $b], [qw(*a b)])) if $XS;
141 #$b{'c'} = $b{'a'}[2];
145 TEST q(Data::Dumper->Dump([$b, $a], [qw(*b a)])); # print as %b
146 TEST q(Data::Dumper->Dumpxs([$b, $a], [qw(*b a)])) if $XS;
161 #$a->[1]{'b'} = $a->[1];
167 $Data::Dumper::Indent = 1;
169 $d = Data::Dumper->new([$a,$b], [qw(a b)]);
170 $d->Seen({'*c' => $c});
175 $d = Data::Dumper->new([$a,$b], [qw(a b)]);
176 $d->Seen({'*c' => $c});
204 $d->Purity(0)->Quotekeys(0);
205 TEST q( $d->Reset; $d->Dump );
207 TEST q( $d->Reset; $d->Dumpxs ) if $XS;
223 #$VAR1->[1]{'a'} = $VAR1;
224 #$VAR1->[1]{'b'} = $VAR1->[1];
225 #$VAR1->[2] = $VAR1->[1]{'c'};
229 TEST q(Data::Dumper::DumperX($a)) if $XS;
248 local $Data::Dumper::Purity = 0;
249 local $Data::Dumper::Quotekeys = 0;
250 local $Data::Dumper::Terse = 1;
252 TEST q(Data::Dumper::DumperX($a)) if $XS;
260 # "abc\0'\efg" => "mno\0"
264 $foo = { "abc\000\'\efg" => "mno\000" };
266 local $Data::Dumper::Useqq = 1;
267 TEST q(Dumper($foo));
272 # 'abc\0\\'\efg' => 'mno\0'
277 local $Data::Dumper::Useqq = 1;
278 TEST q(Data::Dumper::DumperX($foo)) if $XS; # cheat
291 %foo = (a=>1,b=>\$foo,c=>\@foo);
313 #*::foo{ARRAY}->[1] = $foo;
314 #*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
315 #*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY};
316 #*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2];
317 #*::foo = *::foo{ARRAY}->[2];
318 #@bar = @{*::foo{ARRAY}};
319 #%baz = %{*::foo{ARRAY}->[2]};
322 $Data::Dumper::Purity = 1;
323 $Data::Dumper::Indent = 3;
324 TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz']));
325 TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])) if $XS;
342 #*::foo{ARRAY}->[1] = $foo;
343 #*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
344 #*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY};
345 #*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2];
346 #*::foo = *::foo{ARRAY}->[2];
347 #$bar = *::foo{ARRAY};
348 #$baz = *::foo{ARRAY}->[2];
351 $Data::Dumper::Indent = 1;
352 TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz']));
353 TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])) if $XS;
371 #*::foo{HASH}->{'b'} = *::foo{SCALAR};
372 #*::foo{HASH}->{'c'} = \@bar;
373 #*::foo{HASH}->{'d'} = *::foo{HASH};
374 #$bar[2] = *::foo{HASH};
375 #%baz = %{*::foo{HASH}};
379 TEST q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo']));
380 TEST q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo'])) if $XS;
398 #*::foo{HASH}->{'b'} = *::foo{SCALAR};
399 #*::foo{HASH}->{'c'} = $bar;
400 #*::foo{HASH}->{'d'} = *::foo{HASH};
401 #$bar->[2] = *::foo{HASH};
402 #$baz = *::foo{HASH};
406 TEST q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo']));
407 TEST q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo'])) if $XS;
426 $Data::Dumper::Purity = 0;
427 $Data::Dumper::Quotekeys = 0;
428 TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz']));
429 TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])) if $XS;
448 TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz']));
449 TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])) if $XS;
457 @dogs = ( 'Fido', 'Wags' );
464 $mutts = $mutts; # avoid warning
474 # ${$kennels{First}},
475 # ${$kennels{Second}},
482 $d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts],
483 [qw(*kennels *dogs *mutts)] );
488 $d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts],
489 [qw(*kennels *dogs *mutts)] );
497 #%kennels = %kennels;
503 TEST q($d->Dumpxs) if $XS;
513 # ${$kennels{First}},
514 # ${$kennels{Second}},
521 TEST q($d->Reset; $d->Dump);
523 TEST q($d->Reset; $d->Dumpxs);
533 # First => \$dogs[0],
534 # Second => \$dogs[1]
537 #%kennels = %{$dogs[2]};
538 #%mutts = %{$dogs[2]};
542 $d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts],
543 [qw(*dogs *kennels *mutts)] );
548 $d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts],
549 [qw(*dogs *kennels *mutts)] );
556 TEST q($d->Reset->Dump);
558 TEST q($d->Reset->Dumpxs);
579 $d = Data::Dumper->new( [\@dogs, \%kennel], [qw(*dogs *kennels)] );
580 $d->Deepcopy(1)->Dump;
583 TEST q($d->Reset->Dumpxs);
590 sub z { print "foo\n" }
602 TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dump;);
603 TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dumpxs;)
615 TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dump;);
616 TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dumpxs;)
628 TEST q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dump;);
629 TEST q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dumpxs;)
648 TEST q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dump;);
649 TEST q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dumpxs;)
664 TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;);
665 TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;)
670 $a = [{ a => \$b }, { b => undef }];
671 $b = [{ c => \$b }, { d => \$a }];
691 #${$a->[0]{a}}->[0]->{c} = $a->[0]{a};
692 #${${$a->[0]{a}}->[1]->{d}} = $a;
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 = [[[[\\\\\'foo']]]];
719 #$c = ${${$a->[0][0][0][0]}};
722 TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dump;);
723 TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dumpxs;)
742 # e => 'ARRAY(0xdeadbeef)'
751 TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dump;);
752 TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dumpxs;)
759 # b => 'HASH(0xdeadbeef)'
767 TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dump;);
768 TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dumpxs;)