1#!./perl -w
2# t/purity_deepcopy_maxdepth.t - Test Purity(), Deepcopy(),
3# Maxdepth() and recursive structures
4
5use strict;
6use warnings;
7
8use Data::Dumper;
9use Test::More tests => 22;
10use lib qw( ./t/lib );
11use Testing qw( _dumptostr );
12
13my ($a, $b, $c, @d);
14my ($d, $e, $f);
15
16note("\$Data::Dumper::Purity and Purity()");
17
18{
19    my ($obj, %dumps, $purity);
20
21    # Adapted from example in Dumper.pm POD:
22    @d = ('c');
23    $c = \@d;
24    $b = {};
25    $a = [1, $b, $c];
26    $b->{a} = $a;
27    $b->{b} = $a->[1];
28    $b->{c} = $a->[2];
29
30    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
31    $dumps{'noprev'} = _dumptostr($obj);
32
33    note("Discrepancy between Dumpxs() and Dumpperl() behavior with respect to \$Data::Dumper::Purity = undef");
34    local $Data::Dumper::Useperl = 1;
35    $purity = undef;
36    local $Data::Dumper::Purity = $purity;
37    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
38    $dumps{'ddpundef'} = _dumptostr($obj);
39
40    $purity = 0;
41    local $Data::Dumper::Purity = $purity;
42    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
43    $dumps{'ddpzero'} = _dumptostr($obj);
44
45    is($dumps{'noprev'}, $dumps{'ddpundef'},
46        "No previous Purity setting equivalent to \$Data::Dumper::Purity = undef");
47
48    is($dumps{'noprev'}, $dumps{'ddpzero'},
49        "No previous Purity setting equivalent to \$Data::Dumper::Purity = 0");
50}
51
52{
53    my ($obj, %dumps, $purity);
54
55    @d = ('c');
56    $c = \@d;
57    $b = {};
58    $a = [1, $b, $c];
59    $b->{a} = $a;
60    $b->{b} = $a->[1];
61    $b->{c} = $a->[2];
62
63    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
64    $dumps{'noprev'} = _dumptostr($obj);
65
66    $purity = 0;
67    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
68    $obj->Purity($purity);
69    $dumps{'objzero'} = _dumptostr($obj);
70
71    is($dumps{'noprev'}, $dumps{'objzero'},
72        "No previous Purity setting equivalent to Purity(0)");
73}
74
75{
76    my ($obj, %dumps, $purity);
77
78    @d = ('c');
79    $c = \@d;
80    $b = {};
81    $a = [1, $b, $c];
82    $b->{a} = $a;
83    $b->{b} = $a->[1];
84    $b->{c} = $a->[2];
85
86    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
87    $dumps{'noprev'} = _dumptostr($obj);
88
89    $purity = 1;
90    local $Data::Dumper::Purity = $purity;
91    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
92    $dumps{'ddpone'} = _dumptostr($obj);
93
94    isnt($dumps{'noprev'}, $dumps{'ddpone'},
95        "No previous Purity setting different from \$Data::Dumper::Purity = 1");
96}
97
98{
99    my ($obj, %dumps, $purity);
100
101    @d = ('c');
102    $c = \@d;
103    $b = {};
104    $a = [1, $b, $c];
105    $b->{a} = $a;
106    $b->{b} = $a->[1];
107    $b->{c} = $a->[2];
108
109    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
110    $dumps{'noprev'} = _dumptostr($obj);
111
112    $purity = 1;
113    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
114    $obj->Purity(1);
115    $dumps{'objone'} = _dumptostr($obj);
116
117    isnt($dumps{'noprev'}, $dumps{'objone'},
118        "No previous Purity setting different from Purity(0)");
119}
120
121{
122    my ($obj, %dumps, $purity);
123
124    @d = ('c');
125    $c = \@d;
126    $b = {};
127    $a = [1, $b, $c];
128    $b->{a} = $a;
129    $b->{b} = $a->[1];
130    $b->{c} = $a->[2];
131
132    $purity = 1;
133    local $Data::Dumper::Purity = $purity;
134    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
135    $dumps{'ddpone'} = _dumptostr($obj);
136    local $Data::Dumper::Purity = undef;
137
138    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
139    $obj->Purity(1);
140    $dumps{'objone'} = _dumptostr($obj);
141
142    is($dumps{'ddpone'}, $dumps{'objone'},
143        "\$Data::Dumper::Purity = 1 and Purity(1) are equivalent");
144}
145
146note("\$Data::Dumper::Deepcopy and Deepcopy()");
147
148{
149    my ($obj, %dumps, $deepcopy);
150
151    # Adapted from example in Dumper.pm POD:
152    @d = ('c');
153    $c = \@d;
154    $b = {};
155    $a = [1, $b, $c];
156    $b->{a} = $a;
157    $b->{b} = $a->[1];
158    $b->{c} = $a->[2];
159
160    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
161    $dumps{'noprev'} = _dumptostr($obj);
162
163    $deepcopy = undef;
164    local $Data::Dumper::Deepcopy = $deepcopy;
165    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
166    $dumps{'dddundef'} = _dumptostr($obj);
167
168    $deepcopy = 0;
169    local $Data::Dumper::Deepcopy = $deepcopy;
170    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
171    $dumps{'dddzero'} = _dumptostr($obj);
172
173    is($dumps{'noprev'}, $dumps{'dddundef'},
174        "No previous Deepcopy setting equivalent to \$Data::Dumper::Deepcopy = undef");
175
176    is($dumps{'noprev'}, $dumps{'dddzero'},
177        "No previous Deepcopy setting equivalent to \$Data::Dumper::Deepcopy = 0");
178}
179
180{
181    my ($obj, %dumps, $deepcopy);
182
183    @d = ('c');
184    $c = \@d;
185    $b = {};
186    $a = [1, $b, $c];
187    $b->{a} = $a;
188    $b->{b} = $a->[1];
189    $b->{c} = $a->[2];
190
191    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
192    $dumps{'noprev'} = _dumptostr($obj);
193
194    $deepcopy = 0;
195    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
196    $obj->Deepcopy($deepcopy);
197    $dumps{'objzero'} = _dumptostr($obj);
198
199    is($dumps{'noprev'}, $dumps{'objzero'},
200        "No previous Deepcopy setting equivalent to Deepcopy(0)");
201
202    $deepcopy = undef;
203    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
204    $obj->Deepcopy($deepcopy);
205    $dumps{'objundef'} = _dumptostr($obj);
206
207    is($dumps{'noprev'}, $dumps{'objundef'},
208        "No previous Deepcopy setting equivalent to Deepcopy(undef)");
209}
210
211{
212    my ($obj, %dumps, $deepcopy);
213
214    @d = ('c');
215    $c = \@d;
216    $b = {};
217    $a = [1, $b, $c];
218    $b->{a} = $a;
219    $b->{b} = $a->[1];
220    $b->{c} = $a->[2];
221
222    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
223    $dumps{'noprev'} = _dumptostr($obj);
224
225    $deepcopy = 1;
226    local $Data::Dumper::Deepcopy = $deepcopy;
227    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
228    $dumps{'dddone'} = _dumptostr($obj);
229
230    isnt($dumps{'noprev'}, $dumps{'dddone'},
231        "No previous Deepcopy setting different from \$Data::Dumper::Deepcopy = 1");
232}
233
234{
235    my ($obj, %dumps, $deepcopy);
236
237    @d = ('c');
238    $c = \@d;
239    $b = {};
240    $a = [1, $b, $c];
241    $b->{a} = $a;
242    $b->{b} = $a->[1];
243    $b->{c} = $a->[2];
244
245    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
246    $dumps{'noprev'} = _dumptostr($obj);
247
248    $deepcopy = 1;
249    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
250    $obj->Deepcopy(1);
251    $dumps{'objone'} = _dumptostr($obj);
252
253    isnt($dumps{'noprev'}, $dumps{'objone'},
254        "No previous Deepcopy setting different from Deepcopy(0)");
255}
256
257{
258    my ($obj, %dumps, $deepcopy);
259
260    @d = ('c');
261    $c = \@d;
262    $b = {};
263    $a = [1, $b, $c];
264    $b->{a} = $a;
265    $b->{b} = $a->[1];
266    $b->{c} = $a->[2];
267
268    $deepcopy = 1;
269    local $Data::Dumper::Deepcopy = $deepcopy;
270    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
271    $dumps{'dddone'} = _dumptostr($obj);
272    local $Data::Dumper::Deepcopy = undef;
273
274    $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
275    $obj->Deepcopy(1);
276    $dumps{'objone'} = _dumptostr($obj);
277
278    is($dumps{'dddone'}, $dumps{'objone'},
279        "\$Data::Dumper::Deepcopy = 1 and Deepcopy(1) are equivalent");
280}
281
282note("\$Data::Dumper::Maxdepth and Maxdepth()");
283
284{
285    # Adapted from Dumper.pm POD
286
287    my ($obj, %dumps, $maxdepth);
288
289    $a = "pearl";
290    $b = [ $a ];
291    $c = { 'b' => $b };
292    $d = [ $c ];
293    $e = { 'd' => $d };
294    $f = { 'e' => $e };
295
296    note("Discrepancy between Dumpxs() and Dumpperl() behavior with respect to \$Data::Dumper::Maxdepth = undef");
297    local $Data::Dumper::Useperl = 1;
298
299    $obj = Data::Dumper->new([$f], [qw(f)]);
300    $dumps{'noprev'} = _dumptostr($obj);
301
302    $Data::Dumper::Maxdepth = undef;
303    $obj = Data::Dumper->new([$f], [qw(f)]);
304    $dumps{'ddmundef'} = _dumptostr($obj);
305
306    $maxdepth = 3;
307    local $Data::Dumper::Maxdepth = $maxdepth;
308    $obj = Data::Dumper->new([$f], [qw(f)]);
309    $dumps{'ddm'} = _dumptostr($obj);
310
311    is($dumps{'noprev'}, $dumps{'ddmundef'},
312        "No previous Maxdepth setting equivalent to \$Data::Dumper::Maxdepth = undef");
313
314    like($dumps{'noprev'}, qr/$a/s,
315        "Without Maxdepth, got output from deepest level");
316
317    isnt($dumps{'noprev'}, $dumps{'ddm'},
318        "No previous Maxdepth setting differs from setting a shallow Maxdepth");
319
320    unlike($dumps{'ddm'}, qr/$a/s,
321        "With Maxdepth, did not get output from deepest level");
322}
323
324{
325    # Adapted from Dumper.pm POD
326
327    my ($obj, %dumps, $maxdepth);
328
329    $a = "pearl";
330    $b = [ $a ];
331    $c = { 'b' => $b };
332    $d = [ $c ];
333    $e = { 'd' => $d };
334    $f = { 'e' => $e };
335
336    note("Discrepancy between Dumpxs() and Dumpperl() behavior with respect to \$Data::Dumper::Maxdepth = undef");
337    local $Data::Dumper::Useperl = 1;
338
339    $obj = Data::Dumper->new([$f], [qw(f)]);
340    $dumps{'noprev'} = _dumptostr($obj);
341
342    $obj = Data::Dumper->new([$f], [qw(f)]);
343    $obj->Maxdepth();
344    $dumps{'maxdepthempty'} = _dumptostr($obj);
345
346    is($dumps{'noprev'}, $dumps{'maxdepthempty'},
347        "No previous Maxdepth setting equivalent to Maxdepth() with no argument");
348
349    $maxdepth = 3;
350    $obj = Data::Dumper->new([$f], [qw(f)]);
351    $obj->Maxdepth($maxdepth);
352    $dumps{'maxdepthset'} = _dumptostr($obj);
353
354    isnt($dumps{'noprev'}, $dumps{'maxdepthset'},
355        "No previous Maxdepth setting differs from Maxdepth() with shallow depth");
356
357    local $Data::Dumper::Maxdepth = 3;
358    $obj = Data::Dumper->new([$f], [qw(f)]);
359    $dumps{'ddmset'} = _dumptostr($obj);
360
361    is($dumps{'maxdepthset'}, $dumps{'ddmset'},
362        "Maxdepth set and \$Data::Dumper::Maxdepth are equivalent");
363}
364
365{
366    my ($obj, %dumps);
367
368    my $warning = '';
369    local $SIG{__WARN__} = sub { $warning = $_[0] };
370
371    local $Data::Dumper::Deparse = 0;
372    local $Data::Dumper::Purity  = 1;
373    local $Data::Dumper::Useperl = 1;
374    sub hello { print "Hello world\n"; }
375    $obj = Data::Dumper->new( [ \&hello ] );
376    $dumps{'ddsksub'} = _dumptostr($obj);
377    like($warning, qr/^Encountered CODE ref, using dummy placeholder/,
378        "Got expected warning: dummy placeholder under Purity = 1");
379}
380
381{
382    my ($obj, %dumps);
383
384    my $warning = '';
385    local $SIG{__WARN__} = sub { $warning = $_[0] };
386
387    local $Data::Dumper::Deparse = 0;
388    local $Data::Dumper::Useperl = 1;
389    sub jello { print "Jello world\n"; }
390    $obj = Data::Dumper->new( [ \&hello ] );
391    $dumps{'ddsksub'} = _dumptostr($obj);
392    ok(! $warning, "Encountered CODE ref, but no Purity, hence no warning");
393}
394