make new Storable tests forgiving of places where not built
[p5sagit/p5-mst-13.2.git] / t / lib / st-canonical.t
CommitLineData
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
15sub BEGIN {
16 chdir('t') if -d 't';
9f233367 17 require Config; import Config;
18 if ($Config{'extensions'} !~ /\bStorable\b/) {
19 print "1..0 # Skip: Storable was not built\n";
20 exit 0;
21 }
7a6a85bf 22 unshift @INC, '../lib';
23}
24
25
26use Storable qw(freeze thaw dclone);
27use vars qw($debugging $verbose);
28
29print "1..8\n";
30
31sub ok {
32 my($testno, $ok) = @_;
33 print "not " unless $ok;
34 print "ok $testno\n";
35}
36
37
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)
40# $debugging = 1;
41
42$hashsize = 100;
43$maxhash2size = 100;
44$maxarraysize = 100;
45
46# Use MD5 if its available to make random string keys
47
48eval { require "MD5.pm" };
49$gotmd5 = !$@;
50
51# Use Data::Dumper if debugging and it is available to create an ASCII dump
52
53if ($debugging) {
54 eval { require "Data/Dumper.pm" };
55 $gotdd = !$@;
56}
57
58@fixed_strings = ("January", "February", "March", "April", "May", "June",
59 "July", "August", "September", "October", "November", "December" );
60
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);
63
64for (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 };
68
69 # A third of the elements are references to further hashes
70
71 if (int(rand(1.5))) {
72 my($hash2) = {};
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))];
77 }
78 $a1{$k}->{value} = $hash2;
79 }
80
81 # A further third are references to arrays
82
83 elsif (int(rand(2))) {
84 my($arr_ref) = [];
85 my($arraysize) = int(rand($maxarraysize));
86 while ($arraysize--) {
87 push(@$arr_ref, $fixed_strings[rand(int(@fixed_strings))]);
88 }
89 $a1{$k}->{value} = $arr_ref;
90 }
91}
92
93
94print STDERR Data::Dumper::Dumper(\%a1) if ($verbose and $gotdd);
95
96
97# Copy the hash, element by element in order of the keys
98
99foreach $k (sort keys %a1) {
100 $a2{$k} = { key => "$k", value => $a1{$k}->{value} };
101}
102
103# Deep clone the hash
104
105$a3 = dclone(\%a1);
106
107# In canonical mode the frozen representation of each of the hashes
108# should be identical
109
110$Storable::canonical = 1;
111
112$x1 = freeze(\%a1);
113$x2 = freeze(\%a2);
114$x3 = freeze($a3);
115
116ok 1, (length($x1) > $hashsize); # sanity check
117ok 2, length($x1) == length($x2); # idem
118ok 3, $x1 eq $x2;
119ok 4, $x1 eq $x3;
120
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).
125
126$Storable::canonical = 0;
127
128$x1 = freeze(\%a1);
129$x2 = freeze(\%a2);
130$x3 = freeze($a3);
131
132
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.
136
137ok 5, ($x1 ne $x2) || ($x1 ne $x3);
138
139
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
142
143my $hash;
144push @{$$hash{''}}, \$$hash{a};
145ok 6, $$hash{''}[0] == \$$hash{a};
146
147my $cloned = dclone(dclone($hash));
148ok 7, $$cloned{''}[0] == \$$cloned{a};
149
150$$cloned{a} = "blah";
151ok 8, $$cloned{''}[0] == \$$cloned{a};
152