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