3 # Copyright 2002, Larry Wall.
5 # You may redistribute only under the same terms as Perl 5, as specified
6 # in the README file that comes with the distribution.
12 @INC = ('.', '../lib', '../ext/Storable/t');
14 if ($Config::Config{'extensions'} !~ /\bStorable\b/) {
15 print "1..0 # Skip: Storable was not built\n";
20 print "1..0 # Skip: No Hash::Util pre 5.005\n";
22 # And doing this seems on 5.004 seems to create bogus warnings about
23 # unitialized variables, or coredumps in Perl_pp_padsv
24 } elsif (!eval "require Hash::Util") {
25 if ($@ =~ /Can\'t locate Hash\/Util\.pm in \@INC/s) {
26 print "1..0 # Skip: No Hash::Util:\n";
38 use Storable qw(dclone freeze thaw);
39 use Hash::Util qw(lock_hash unlock_value);
43 my %hash = (question => '?', answer => 42, extra => 'junk', undef => undef);
45 unlock_value %hash, 'answer';
46 unlock_value %hash, 'extra';
47 delete $hash{'extra'};
51 package Restrict_Test;
54 return (undef, $_[0]);
60 my $temp = freeze $_[0];
67 my $copy = &$cloner($hash);
69 my @in_keys = sort keys %$hash;
70 my @out_keys = sort keys %$copy;
71 unless (ok ++$test, "@in_keys" eq "@out_keys") {
72 print "# Failed: keys mis-match after deep clone.\n";
73 print "# Original keys: @in_keys\n";
74 print "# Copy's keys: @out_keys\n";
77 # $copy = $hash; # used in initial debug of the tests
79 ok ++$test, Internals::SvREADONLY(%$copy), "cloned hash restricted?";
81 ok ++$test, Internals::SvREADONLY($copy->{question}),
82 "key 'question' not locked in copy?";
84 ok ++$test, !Internals::SvREADONLY($copy->{answer}),
85 "key 'answer' not locked in copy?";
87 eval { $copy->{extra} = 15 } ;
88 unless (ok ++$test, !$@, "Can assign to reserved key 'extra'?") {
91 print "# \$\@: $diag\n";
94 eval { $copy->{nono} = 7 } ;
95 ok ++$test, $@, "Can not assign to invalid key 'nono'?";
97 ok ++$test, exists $copy->{undef},
100 ok ++$test, !defined $copy->{undef},
101 "value for key 'undef' is undefined";
104 for $Storable::canonical (0, 1) {
105 for my $cloner (\&dclone, \&freeze_thaw) {
106 print "# \$Storable::canonical = $Storable::canonical\n";
107 testit (\%hash, $cloner);
109 # bless {}, "Restrict_Test";
112 $hash2{"k$_"} = "v$_" for 0..16;
115 unlock_value %hash2, "k$_";
116 delete $hash2{"k$_"};
118 my $copy = &$cloner(\%hash2);
122 eval { $copy->{$k} = undef } ;
123 unless (ok ++$test, !$@, "Can assign to reserved key '$k'?") {
125 $diag =~ s/\n.*\z//s;
126 print "# \$\@: $diag\n";