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