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