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