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