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