This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
add Data-Dumper, up patchlevel to 71, various misc tweaks to
[perl5.git] / t / lib / dumper.t
CommitLineData
823edd99
GS
1#!./perl -w
2#
3# testsuite for Data::Dumper
4#
5
6BEGIN {
7 chdir 't' if -d 't';
8 @INC = '../lib' if -d '../lib';
9}
10
11use Data::Dumper;
12
13$Data::Dumper::Pad = "#";
14my $TMAX;
15my $XS;
16my $TNUM = 0;
17my $WANT = '';
18
19sub TEST {
20 my $string = shift;
21 my $t = eval $string;
22 ++$TNUM;
23 print( ($t eq $WANT and not $@) ? "ok $TNUM\n"
24 : "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n");
25
26 ++$TNUM;
27 eval "$t";
28 print $@ ? "not ok $TNUM\n# \$@ says: $@\n" : "ok $TNUM\n";
29
30 $t = eval $string;
31 ++$TNUM;
32 print( ($t eq $WANT and not $@) ? "ok $TNUM\n"
33 : "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n");
34}
35
36if (defined &Data::Dumper::Dumpxs) {
37 print "### XS extension loaded, will run XS tests\n";
38 $TMAX = 138; $XS = 1;
39}
40else {
41 print "### XS extensions not loaded, will NOT run XS tests\n";
42 $TMAX = 69; $XS = 0;
43}
44
45print "1..$TMAX\n";
46
47#############
48#############
49
50@c = ('c');
51$c = \@c;
52$b = {};
53$a = [1, $b, $c];
54$b->{a} = $a;
55$b->{b} = $a->[1];
56$b->{c} = $a->[2];
57
58############# 1
59##
60$WANT = <<'EOT';
61#$a = [
62# 1,
63# {
64# 'a' => $a,
65# 'b' => $a->[1],
66# 'c' => [
67# 'c'
68# ]
69# },
70# $a->[1]{'c'}
71# ];
72#$b = $a->[1];
73#$c = $a->[1]{'c'};
74EOT
75
76TEST q(Data::Dumper->Dump([$a,$b,$c], [qw(a b c)]));
77TEST q(Data::Dumper->Dumpxs([$a,$b,$c], [qw(a b c)])) if $XS;
78
79
80############# 7
81##
82$WANT = <<'EOT';
83#@a = (
84# 1,
85# {
86# 'a' => [],
87# 'b' => {},
88# 'c' => [
89# 'c'
90# ]
91# },
92# []
93# );
94#$a[1]{'a'} = \@a;
95#$a[1]{'b'} = $a[1];
96#$a[2] = $a[1]{'c'};
97#$b = $a[1];
98EOT
99
100$Data::Dumper::Purity = 1; # fill in the holes for eval
101TEST q(Data::Dumper->Dump([$a, $b], [qw(*a b)])); # print as @a
102TEST q(Data::Dumper->Dumpxs([$a, $b], [qw(*a b)])) if $XS;
103
104############# 13
105##
106$WANT = <<'EOT';
107#%b = (
108# 'a' => [
109# 1,
110# {},
111# [
112# 'c'
113# ]
114# ],
115# 'b' => {},
116# 'c' => []
117# );
118#$b{'a'}[1] = \%b;
119#$b{'b'} = \%b;
120#$b{'c'} = $b{'a'}[2];
121#$a = $b{'a'};
122EOT
123
124TEST q(Data::Dumper->Dump([$b, $a], [qw(*b a)])); # print as %b
125TEST q(Data::Dumper->Dumpxs([$b, $a], [qw(*b a)])) if $XS;
126
127############# 19
128##
129$WANT = <<'EOT';
130#$a = [
131# 1,
132# {
133# 'a' => [],
134# 'b' => {},
135# 'c' => []
136# },
137# []
138#];
139#$a->[1]{'a'} = $a;
140#$a->[1]{'b'} = $a->[1];
141#$a->[1]{'c'} = \@c;
142#$a->[2] = \@c;
143#$b = $a->[1];
144EOT
145
146$Data::Dumper::Indent = 1;
147TEST q(
148 $d = Data::Dumper->new([$a,$b], [qw(a b)]);
149 $d->Seen({'*c' => $c});
150 $d->Dump;
151 );
152if ($XS) {
153 TEST q(
154 $d = Data::Dumper->new([$a,$b], [qw(a b)]);
155 $d->Seen({'*c' => $c});
156 $d->Dumpxs;
157 );
158}
159
160
161############# 25
162##
163$WANT = <<'EOT';
164#$a = [
165# #0
166# 1,
167# #1
168# {
169# a => $a,
170# b => $a->[1],
171# c => [
172# #0
173# 'c'
174# ]
175# },
176# #2
177# $a->[1]{c}
178# ];
179#$b = $a->[1];
180EOT
181
182$d->Indent(3);
183$d->Purity(0)->Quotekeys(0);
184TEST q( $d->Reset; $d->Dump );
185
186TEST q( $d->Reset; $d->Dumpxs ) if $XS;
187
188############# 31
189##
190$WANT = <<'EOT';
191#$VAR1 = [
192# 1,
193# {
194# 'a' => [],
195# 'b' => {},
196# 'c' => [
197# 'c'
198# ]
199# },
200# []
201#];
202#$VAR1->[1]{'a'} = $VAR1;
203#$VAR1->[1]{'b'} = $VAR1->[1];
204#$VAR1->[2] = $VAR1->[1]{'c'};
205EOT
206
207TEST q(Dumper($a));
208TEST q(Data::Dumper::DumperX($a)) if $XS;
209
210############# 37
211##
212$WANT = <<'EOT';
213#[
214# 1,
215# {
216# a => $VAR1,
217# b => $VAR1->[1],
218# c => [
219# 'c'
220# ]
221# },
222# $VAR1->[1]{c}
223#]
224EOT
225
226{
227 local $Data::Dumper::Purity = 0;
228 local $Data::Dumper::Quotekeys = 0;
229 local $Data::Dumper::Terse = 1;
230 TEST q(Dumper($a));
231 TEST q(Data::Dumper::DumperX($a)) if $XS;
232}
233
234
235############# 43
236##
237$WANT = <<'EOT';
238#$VAR1 = {
239# "abc\000\efg" => "mno\000"
240#};
241EOT
242
243$foo = { "abc\000\efg" => "mno\000" };
244{
245 local $Data::Dumper::Useqq = 1;
246 TEST q(Dumper($foo));
247}
248
249 $WANT = <<"EOT";
250#\$VAR1 = {
251# 'abc\000\efg' => 'mno\000'
252#};
253EOT
254
255 {
256 local $Data::Dumper::Useqq = 1;
257 TEST q(Data::Dumper::DumperX($foo)) if $XS; # cheat
258 }
259
260
261
262#############
263#############
264
265{
266 package main;
267 use Data::Dumper;
268 $foo = 5;
269 @foo = (10,\*foo);
270 %foo = (a=>1,b=>\$foo,c=>\@foo);
271 $foo{d} = \%foo;
272 $foo[2] = \%foo;
273
274############# 49
275##
276 $WANT = <<'EOT';
277#$foo = \*::foo;
278#*::foo = \5;
279#*::foo = [
280# #0
281# 10,
282# #1
283# '',
284# #2
285# {
286# 'a' => 1,
287# 'b' => '',
288# 'c' => [],
289# 'd' => {}
290# }
291# ];
292#*::foo{ARRAY}->[1] = $foo;
293#*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
294#*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY};
295#*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2];
296#*::foo = *::foo{ARRAY}->[2];
297#@bar = @{*::foo{ARRAY}};
298#%baz = %{*::foo{ARRAY}->[2]};
299EOT
300
301 $Data::Dumper::Purity = 1;
302 $Data::Dumper::Indent = 3;
303 TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz']));
304 TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])) if $XS;
305
306############# 55
307##
308 $WANT = <<'EOT';
309#$foo = \*::foo;
310#*::foo = \5;
311#*::foo = [
312# 10,
313# '',
314# {
315# 'a' => 1,
316# 'b' => '',
317# 'c' => [],
318# 'd' => {}
319# }
320#];
321#*::foo{ARRAY}->[1] = $foo;
322#*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
323#*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY};
324#*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2];
325#*::foo = *::foo{ARRAY}->[2];
326#$bar = *::foo{ARRAY};
327#$baz = *::foo{ARRAY}->[2];
328EOT
329
330 $Data::Dumper::Indent = 1;
331 TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz']));
332 TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])) if $XS;
333
334############# 61
335##
336 $WANT = <<'EOT';
337#@bar = (
338# 10,
339# \*::foo,
340# {}
341#);
342#*::foo = \5;
343#*::foo = \@bar;
344#*::foo = {
345# 'a' => 1,
346# 'b' => '',
347# 'c' => [],
348# 'd' => {}
349#};
350#*::foo{HASH}->{'b'} = *::foo{SCALAR};
351#*::foo{HASH}->{'c'} = \@bar;
352#*::foo{HASH}->{'d'} = *::foo{HASH};
353#$bar[2] = *::foo{HASH};
354#%baz = %{*::foo{HASH}};
355#$foo = $bar[1];
356EOT
357
358 TEST q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo']));
359 TEST q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo'])) if $XS;
360
361############# 67
362##
363 $WANT = <<'EOT';
364#$bar = [
365# 10,
366# \*::foo,
367# {}
368#];
369#*::foo = \5;
370#*::foo = $bar;
371#*::foo = {
372# 'a' => 1,
373# 'b' => '',
374# 'c' => [],
375# 'd' => {}
376#};
377#*::foo{HASH}->{'b'} = *::foo{SCALAR};
378#*::foo{HASH}->{'c'} = $bar;
379#*::foo{HASH}->{'d'} = *::foo{HASH};
380#$bar->[2] = *::foo{HASH};
381#$baz = *::foo{HASH};
382#$foo = $bar->[1];
383EOT
384
385 TEST q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo']));
386 TEST q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo'])) if $XS;
387
388############# 73
389##
390 $WANT = <<'EOT';
391#$foo = \*::foo;
392#@bar = (
393# 10,
394# $foo,
395# {
396# a => 1,
397# b => \5,
398# c => \@bar,
399# d => $bar[2]
400# }
401#);
402#%baz = %{$bar[2]};
403EOT
404
405 $Data::Dumper::Purity = 0;
406 $Data::Dumper::Quotekeys = 0;
407 TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz']));
408 TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])) if $XS;
409
410############# 79
411##
412 $WANT = <<'EOT';
413#$foo = \*::foo;
414#$bar = [
415# 10,
416# $foo,
417# {
418# a => 1,
419# b => \5,
420# c => $bar,
421# d => $bar->[2]
422# }
423#];
424#$baz = $bar->[2];
425EOT
426
427 TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz']));
428 TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])) if $XS;
429
430}
431
432#############
433#############
434{
435 package main;
436 @dogs = ( 'Fido', 'Wags' );
437 %kennel = (
438 First => \$dogs[0],
439 Second => \$dogs[1],
440 );
441 $dogs[2] = \%kennel;
442 $mutts = \%kennel;
443 $mutts = $mutts; # avoid warning
444
445############# 85
446##
447 $WANT = <<'EOT';
448#%kennels = (
449# First => \'Fido',
450# Second => \'Wags'
451#);
452#@dogs = (
453# $kennels{First},
454# $kennels{Second},
455# \%kennels
456#);
457#%mutts = %kennels;
458EOT
459
460 TEST q(
461 $d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts],
462 [qw(*kennels *dogs *mutts)] );
463 $d->Dump;
464 );
465 if ($XS) {
466 TEST q(
467 $d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts],
468 [qw(*kennels *dogs *mutts)] );
469 $d->Dumpxs;
470 );
471 }
472
473############# 91
474##
475 $WANT = <<'EOT';
476#%kennels = %kennels;
477#@dogs = @dogs;
478#%mutts = %kennels;
479EOT
480
481 TEST q($d->Dump);
482 TEST q($d->Dumpxs) if $XS;
483
484############# 97
485##
486 $WANT = <<'EOT';
487#%kennels = (
488# First => \'Fido',
489# Second => \'Wags'
490#);
491#@dogs = (
492# $kennels{First},
493# $kennels{Second},
494# \%kennels
495#);
496#%mutts = %kennels;
497EOT
498
499
500 TEST q($d->Reset; $d->Dump);
501 if ($XS) {
502 TEST q($d->Reset; $d->Dumpxs);
503 }
504
505############# 103
506##
507 $WANT = <<'EOT';
508#@dogs = (
509# 'Fido',
510# 'Wags',
511# {
512# First => \$dogs[0],
513# Second => \$dogs[1]
514# }
515#);
516#%kennels = %{$dogs[2]};
517#%mutts = %{$dogs[2]};
518EOT
519
520 TEST q(
521 $d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts],
522 [qw(*dogs *kennels *mutts)] );
523 $d->Dump;
524 );
525 if ($XS) {
526 TEST q(
527 $d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts],
528 [qw(*dogs *kennels *mutts)] );
529 $d->Dumpxs;
530 );
531 }
532
533############# 109
534##
535 TEST q($d->Reset->Dump);
536 if ($XS) {
537 TEST q($d->Reset->Dumpxs);
538 }
539
540############# 115
541##
542 $WANT = <<'EOT';
543#@dogs = (
544# 'Fido',
545# 'Wags',
546# {
547# First => \'Fido',
548# Second => \'Wags'
549# }
550#);
551#%kennels = (
552# First => \'Fido',
553# Second => \'Wags'
554#);
555EOT
556
557 TEST q(
558 $d = Data::Dumper->new( [\@dogs, \%kennel], [qw(*dogs *kennels)] );
559 $d->Deepcopy(1)->Dump;
560 );
561 if ($XS) {
562 TEST q($d->Reset->Dumpxs);
563 }
564
565}
566
567{
568
569sub a { print "foo\n" }
570$c = [ \&a ];
571
572############# 121
573##
574 $WANT = <<'EOT';
575#$a = $b;
576#$c = [
577# $b
578#];
579EOT
580
581TEST q(Data::Dumper->new([\&a,$c],['a','c'])->Seen({'b' => \&a})->Dump;);
582TEST q(Data::Dumper->new([\&a,$c],['a','c'])->Seen({'b' => \&a})->Dumpxs;)
583 if $XS;
584
585############# 127
586##
587 $WANT = <<'EOT';
588#$a = \&b;
589#$c = [
590# \&b
591#];
592EOT
593
594TEST q(Data::Dumper->new([\&a,$c],['a','c'])->Seen({'*b' => \&a})->Dump;);
595TEST q(Data::Dumper->new([\&a,$c],['a','c'])->Seen({'*b' => \&a})->Dumpxs;)
596 if $XS;
597
598############# 133
599##
600 $WANT = <<'EOT';
601#*a = \&b;
602#@c = (
603# \&b
604#);
605EOT
606
607TEST q(Data::Dumper->new([\&a,$c],['*a','*c'])->Seen({'*b' => \&a})->Dump;);
608TEST q(Data::Dumper->new([\&a,$c],['*a','*c'])->Seen({'*b' => \&a})->Dumpxs;)
609 if $XS;
610
611}