3 # $Id: canonical.t,v 0.7 2000/08/03 22:04:44 ram Exp $
5 # Copyright (c) 1995-2000, Raphael Manfredi
7 # You may redistribute only under the terms of the Artistic License,
8 # as specified in the README file that comes with the distribution.
10 # $Log: canonical.t,v $
11 # Revision 0.7 2000/08/03 22:04:44 ram
12 # Baseline for second beta release.
17 unshift @INC, '../lib';
18 require Config; import Config;
19 if ($Config{'extensions'} !~ /\bStorable\b/) {
20 print "1..0 # Skip: Storable was not built\n";
26 use Storable qw(freeze thaw dclone);
27 use vars qw($debugging $verbose);
32 my($testno, $ok) = @_;
33 print "not " unless $ok;
38 # Uncomment the folowing line to get a dump of the constructed data structure
39 # (you may want to reduce the size of the hashes too)
46 # Use MD5 if its available to make random string keys
48 eval { require "MD5.pm" };
51 # Use Data::Dumper if debugging and it is available to create an ASCII dump
54 eval { require "Data/Dumper.pm" };
58 @fixed_strings = ("January", "February", "March", "April", "May", "June",
59 "July", "August", "September", "October", "November", "December" );
61 # Build some arbitrarily complex data structure starting with a top level hash
62 # (deeper levels contain scalars, references to hashes or references to arrays);
64 for (my $i = 0; $i < $hashsize; $i++) {
65 my($k) = int(rand(1_000_000));
66 $k = MD5->hexhash($k) if $gotmd5 and int(rand(2));
67 $a1{$k} = { key => "$k", value => $i };
69 # A third of the elements are references to further hashes
73 my($hash2size) = int(rand($maxhash2size));
74 while ($hash2size--) {
75 my($k2) = $k . $i . int(rand(100));
76 $hash2->{$k2} = $fixed_strings[rand(int(@fixed_strings))];
78 $a1{$k}->{value} = $hash2;
81 # A further third are references to arrays
83 elsif (int(rand(2))) {
85 my($arraysize) = int(rand($maxarraysize));
86 while ($arraysize--) {
87 push(@$arr_ref, $fixed_strings[rand(int(@fixed_strings))]);
89 $a1{$k}->{value} = $arr_ref;
94 print STDERR Data::Dumper::Dumper(\%a1) if ($verbose and $gotdd);
97 # Copy the hash, element by element in order of the keys
99 foreach $k (sort keys %a1) {
100 $a2{$k} = { key => "$k", value => $a1{$k}->{value} };
103 # Deep clone the hash
107 # In canonical mode the frozen representation of each of the hashes
108 # should be identical
110 $Storable::canonical = 1;
116 ok 1, (length($x1) > $hashsize); # sanity check
117 ok 2, length($x1) == length($x2); # idem
121 # In normal mode it is exceedingly unlikely that the frozen
122 # representaions of all the hashes will be the same (normally the hash
123 # elements are frozen in the order they are stored internally,
124 # i.e. pseudo-randomly).
126 $Storable::canonical = 0;
133 # Two out of three the same may be a coincidence, all three the same
134 # is much, much more unlikely. Still it could happen, so this test
135 # may report a false negative.
137 ok 5, ($x1 ne $x2) || ($x1 ne $x3);
140 # Ensure refs to "undef" values are properly shared
141 # Same test as in t/dclone.t to ensure the "canonical" code is also correct
144 push @{$$hash{''}}, \$$hash{a};
145 ok 6, $$hash{''}[0] == \$$hash{a};
147 my $cloned = dclone(dclone($hash));
148 ok 7, $$cloned{''}[0] == \$$cloned{a};
150 $$cloned{a} = "blah";
151 ok 8, $$cloned{''}[0] == \$$cloned{a};