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