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