test appears to be ass_u_ming sizeof(long) == sizeof(IV), which
[p5sagit/p5-mst-13.2.git] / ext / Storable / t / canonical.t
CommitLineData
7a6a85bf 1#!./perl
2
9e21b3d0 3# $Id: canonical.t,v 1.0 2000/09/01 19:40:41 ram Exp $
7a6a85bf 4#
5# Copyright (c) 1995-2000, Raphael Manfredi
6#
9e21b3d0 7# You may redistribute only under the same terms as Perl 5, as specified
8# in the README file that comes with the distribution.
7a6a85bf 9#
10# $Log: canonical.t,v $
9e21b3d0 11# Revision 1.0 2000/09/01 19:40:41 ram
12# Baseline for first official release.
7a6a85bf 13#
14
15sub BEGIN {
0c384302 16 if ($ENV{PERL_CORE}){
17 chdir('t') if -d 't';
18 @INC = '.';
19 push @INC, '../lib';
20 }
9f233367 21 require Config; import Config;
0c384302 22 if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
9f233367 23 print "1..0 # Skip: Storable was not built\n";
24 exit 0;
25 }
7a6a85bf 26}
27
28
29use Storable qw(freeze thaw dclone);
30use vars qw($debugging $verbose);
31
32print "1..8\n";
33
34sub 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
51eval { require "MD5.pm" };
52$gotmd5 = !$@;
53
54# Use Data::Dumper if debugging and it is available to create an ASCII dump
55
56if ($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
67for (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
97print STDERR Data::Dumper::Dumper(\%a1) if ($verbose and $gotdd);
98
99
100# Copy the hash, element by element in order of the keys
101
102foreach $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
119ok 1, (length($x1) > $hashsize); # sanity check
120ok 2, length($x1) == length($x2); # idem
121ok 3, $x1 eq $x2;
122ok 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
140ok 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
146my $hash;
147push @{$$hash{''}}, \$$hash{a};
148ok 6, $$hash{''}[0] == \$$hash{a};
149
150my $cloned = dclone(dclone($hash));
151ok 7, $$cloned{''}[0] == \$$cloned{a};
152
153$$cloned{a} = "blah";
154ok 8, $$cloned{''}[0] == \$$cloned{a};
155