4 # Copyright 2002, Larry Wall.
6 # You may redistribute only under the same terms as Perl 5, as specified
7 # in the README file that comes with the distribution.
13 @INC = ('.', '../lib', '../ext/Storable/t');
15 if ($Config::Config{'extensions'} !~ /\bStorable\b/) {
16 print "1..0 # Skip: Storable was not built\n";
20 unless (eval "require Hash::Util") {
21 if ($@ =~ /Can\'t locate Hash\/Util\.pm in \@INC/) {
22 print "1..0 # Skip: No Hash::Util\n";
34 use Storable qw(dclone);
35 use Hash::Util qw(lock_hash unlock_value);
39 my %hash = (question => '?', answer => 42, extra => 'junk', undef => undef);
41 unlock_value %hash, 'answer';
42 unlock_value %hash, 'extra';
43 delete $hash{'extra'};
47 package Restrict_Test;
50 return (undef, $_[0]);
57 my $copy = dclone $hash;
59 my @in_keys = sort keys %$hash;
60 my @out_keys = sort keys %$copy;
61 unless (ok ++$test, "@in_keys" eq "@out_keys") {
62 print "# Failed: keys mis-match after deep clone.\n";
63 print "# Original keys: @in_keys\n";
64 print "# Copy's keys: @out_keys\n";
67 # $copy = $hash; # used in initial debug of the tests
69 ok ++$test, Internals::SvREADONLY(%$copy), "cloned hash restricted?";
71 ok ++$test, Internals::SvREADONLY($copy->{question}),
72 "key 'question' not locked in copy?";
74 ok ++$test, !Internals::SvREADONLY($copy->{answer}),
75 "key 'answer' not locked in copy?";
77 eval { $copy->{extra} = 15 } ;
78 unless (ok ++$test, !$@, "Can assign to reserved key 'extra'?") {
81 print "# \$\@: $diag\n";
84 eval { $copy->{nono} = 7 } ;
85 ok ++$test, $@, "Can not assign to invalid key 'nono'?";
87 ok ++$test, exists $copy->{undef},
90 ok ++$test, !defined $copy->{undef},
91 "value for key 'undef' is undefined";
94 for $Storable::canonical (0, 1) {
95 print "# \$Storable::canonical = $Storable::canonical\n";
98 # bless {}, "Restrict_Test";