1#!./perl 2# 3# Copyright (c) 1995-2000, Raphael Manfredi 4# 5# You may redistribute only under the same terms as Perl 5, as specified 6# in the README file that comes with the distribution. 7# 8 9sub BEGIN { 10 if ($ENV{PERL_CORE}){ 11 chdir('t') if -d 't'; 12 @INC = ('.', '../lib'); 13 } else { 14 unshift @INC, 't'; 15 } 16 require Config; import Config; 17 if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) { 18 print "1..0 # Skip: Storable was not built\n"; 19 exit 0; 20 } 21} 22 23 24use Storable qw(freeze thaw dclone); 25use vars qw($debugging $verbose); 26 27print "1..8\n"; 28 29sub ok { 30 my($testno, $ok) = @_; 31 print "not " unless $ok; 32 print "ok $testno\n"; 33} 34 35 36# Uncomment the folowing line to get a dump of the constructed data structure 37# (you may want to reduce the size of the hashes too) 38# $debugging = 1; 39 40$hashsize = 100; 41$maxhash2size = 100; 42$maxarraysize = 100; 43 44# Use MD5 if its available to make random string keys 45 46eval { require "MD5.pm" }; 47$gotmd5 = !$@; 48 49# Use Data::Dumper if debugging and it is available to create an ASCII dump 50 51if ($debugging) { 52 eval { require "Data/Dumper.pm" }; 53 $gotdd = !$@; 54} 55 56@fixed_strings = ("January", "February", "March", "April", "May", "June", 57 "July", "August", "September", "October", "November", "December" ); 58 59# Build some arbitrarily complex data structure starting with a top level hash 60# (deeper levels contain scalars, references to hashes or references to arrays); 61 62for (my $i = 0; $i < $hashsize; $i++) { 63 my($k) = int(rand(1_000_000)); 64 $k = MD5->hexhash($k) if $gotmd5 and int(rand(2)); 65 $a1{$k} = { key => "$k", "value" => $i }; 66 67 # A third of the elements are references to further hashes 68 69 if (int(rand(1.5))) { 70 my($hash2) = {}; 71 my($hash2size) = int(rand($maxhash2size)); 72 while ($hash2size--) { 73 my($k2) = $k . $i . int(rand(100)); 74 $hash2->{$k2} = $fixed_strings[rand(int(@fixed_strings))]; 75 } 76 $a1{$k}->{value} = $hash2; 77 } 78 79 # A further third are references to arrays 80 81 elsif (int(rand(2))) { 82 my($arr_ref) = []; 83 my($arraysize) = int(rand($maxarraysize)); 84 while ($arraysize--) { 85 push(@$arr_ref, $fixed_strings[rand(int(@fixed_strings))]); 86 } 87 $a1{$k}->{value} = $arr_ref; 88 } 89} 90 91 92print STDERR Data::Dumper::Dumper(\%a1) if ($verbose and $gotdd); 93 94 95# Copy the hash, element by element in order of the keys 96 97foreach $k (sort keys %a1) { 98 $a2{$k} = { key => "$k", "value" => $a1{$k}->{value} }; 99} 100 101# Deep clone the hash 102 103$a3 = dclone(\%a1); 104 105# In canonical mode the frozen representation of each of the hashes 106# should be identical 107 108$Storable::canonical = 1; 109 110$x1 = freeze(\%a1); 111$x2 = freeze(\%a2); 112$x3 = freeze($a3); 113 114ok 1, (length($x1) > $hashsize); # sanity check 115ok 2, length($x1) == length($x2); # idem 116ok 3, $x1 eq $x2; 117ok 4, $x1 eq $x3; 118 119# In normal mode it is exceedingly unlikely that the frozen 120# representaions of all the hashes will be the same (normally the hash 121# elements are frozen in the order they are stored internally, 122# i.e. pseudo-randomly). 123 124$Storable::canonical = 0; 125 126$x1 = freeze(\%a1); 127$x2 = freeze(\%a2); 128$x3 = freeze($a3); 129 130 131# Two out of three the same may be a coincidence, all three the same 132# is much, much more unlikely. Still it could happen, so this test 133# may report a false negative. 134 135ok 5, ($x1 ne $x2) || ($x1 ne $x3); 136 137 138# Ensure refs to "undef" values are properly shared 139# Same test as in t/dclone.t to ensure the "canonical" code is also correct 140 141my $hash; 142push @{$$hash{''}}, \$$hash{a}; 143ok 6, $$hash{''}[0] == \$$hash{a}; 144 145my $cloned = dclone(dclone($hash)); 146ok 7, $$cloned{''}[0] == \$$cloned{a}; 147 148$$cloned{a} = "blah"; 149ok 8, $$cloned{''}[0] == \$$cloned{a}; 150