diff options
Diffstat (limited to 'ext/Storable/t/canonical.t')
| -rw-r--r-- | ext/Storable/t/canonical.t | 153 |
1 files changed, 153 insertions, 0 deletions
diff --git a/ext/Storable/t/canonical.t b/ext/Storable/t/canonical.t new file mode 100644 index 0000000000..b55669b653 --- /dev/null +++ b/ext/Storable/t/canonical.t @@ -0,0 +1,153 @@ +#!./perl + +# $Id: canonical.t,v 1.0 2000/09/01 19:40:41 ram Exp $ +# +# Copyright (c) 1995-2000, Raphael Manfredi +# +# You may redistribute only under the same terms as Perl 5, as specified +# in the README file that comes with the distribution. +# +# $Log: canonical.t,v $ +# Revision 1.0 2000/09/01 19:40:41 ram +# Baseline for first official release. +# + +sub BEGIN { + chdir('t') if -d 't'; + @INC = '.'; + push @INC, '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bStorable\b/) { + print "1..0 # Skip: Storable was not built\n"; + exit 0; + } +} + + +use Storable qw(freeze thaw dclone); +use vars qw($debugging $verbose); + +print "1..8\n"; + +sub ok { + my($testno, $ok) = @_; + print "not " unless $ok; + print "ok $testno\n"; +} + + +# Uncomment the folowing line to get a dump of the constructed data structure +# (you may want to reduce the size of the hashes too) +# $debugging = 1; + +$hashsize = 100; +$maxhash2size = 100; +$maxarraysize = 100; + +# Use MD5 if its available to make random string keys + +eval { require "MD5.pm" }; +$gotmd5 = !$@; + +# Use Data::Dumper if debugging and it is available to create an ASCII dump + +if ($debugging) { + eval { require "Data/Dumper.pm" }; + $gotdd = !$@; +} + +@fixed_strings = ("January", "February", "March", "April", "May", "June", + "July", "August", "September", "October", "November", "December" ); + +# Build some arbitrarily complex data structure starting with a top level hash +# (deeper levels contain scalars, references to hashes or references to arrays); + +for (my $i = 0; $i < $hashsize; $i++) { + my($k) = int(rand(1_000_000)); + $k = MD5->hexhash($k) if $gotmd5 and int(rand(2)); + $a1{$k} = { key => "$k", value => $i }; + + # A third of the elements are references to further hashes + + if (int(rand(1.5))) { + my($hash2) = {}; + my($hash2size) = int(rand($maxhash2size)); + while ($hash2size--) { + my($k2) = $k . $i . int(rand(100)); + $hash2->{$k2} = $fixed_strings[rand(int(@fixed_strings))]; + } + $a1{$k}->{value} = $hash2; + } + + # A further third are references to arrays + + elsif (int(rand(2))) { + my($arr_ref) = []; + my($arraysize) = int(rand($maxarraysize)); + while ($arraysize--) { + push(@$arr_ref, $fixed_strings[rand(int(@fixed_strings))]); + } + $a1{$k}->{value} = $arr_ref; + } +} + + +print STDERR Data::Dumper::Dumper(\%a1) if ($verbose and $gotdd); + + +# Copy the hash, element by element in order of the keys + +foreach $k (sort keys %a1) { + $a2{$k} = { key => "$k", value => $a1{$k}->{value} }; +} + +# Deep clone the hash + +$a3 = dclone(\%a1); + +# In canonical mode the frozen representation of each of the hashes +# should be identical + +$Storable::canonical = 1; + +$x1 = freeze(\%a1); +$x2 = freeze(\%a2); +$x3 = freeze($a3); + +ok 1, (length($x1) > $hashsize); # sanity check +ok 2, length($x1) == length($x2); # idem +ok 3, $x1 eq $x2; +ok 4, $x1 eq $x3; + +# In normal mode it is exceedingly unlikely that the frozen +# representaions of all the hashes will be the same (normally the hash +# elements are frozen in the order they are stored internally, +# i.e. pseudo-randomly). + +$Storable::canonical = 0; + +$x1 = freeze(\%a1); +$x2 = freeze(\%a2); +$x3 = freeze($a3); + + +# Two out of three the same may be a coincidence, all three the same +# is much, much more unlikely. Still it could happen, so this test +# may report a false negative. + +ok 5, ($x1 ne $x2) || ($x1 ne $x3); + + +# Ensure refs to "undef" values are properly shared +# Same test as in t/dclone.t to ensure the "canonical" code is also correct + +my $hash; +push @{$$hash{''}}, \$$hash{a}; +ok 6, $$hash{''}[0] == \$$hash{a}; + +my $cloned = dclone(dclone($hash)); +ok 7, $$cloned{''}[0] == \$$cloned{a}; + +$$cloned{a} = "blah"; +ok 8, $$cloned{''}[0] == \$$cloned{a}; + |