This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix a Storable test to work in 5.8.9-
[perl5.git] / dist / Storable / t / restrict.t
index d2b1836..65dac6f 100644 (file)
@@ -20,7 +20,7 @@ sub BEGIN {
            print "1..0 # Skip: No Hash::Util pre 5.005\n";
            exit 0;
            # And doing this seems on 5.004 seems to create bogus warnings about
            print "1..0 # Skip: No Hash::Util pre 5.005\n";
            exit 0;
            # And doing this seems on 5.004 seems to create bogus warnings about
-           # unitialized variables, or coredumps in Perl_pp_padsv
+           # uninitialized variables, or coredumps in Perl_pp_padsv
        } elsif (!eval "require Hash::Util") {
             if ($@ =~ /Can\'t locate Hash\/Util\.pm in \@INC/s) {
                 print "1..0 # Skip: No Hash::Util:\n";
        } elsif (!eval "require Hash::Util") {
             if ($@ =~ /Can\'t locate Hash\/Util\.pm in \@INC/s) {
                 print "1..0 # Skip: No Hash::Util:\n";
@@ -35,8 +35,8 @@ sub BEGIN {
 
 
 use Storable qw(dclone freeze thaw);
 
 
 use Storable qw(dclone freeze thaw);
-use Hash::Util qw(lock_hash unlock_value);
-use Test::More tests => 100;
+use Hash::Util qw(lock_hash unlock_value lock_keys);
+use Test::More tests => 104;
 
 my %hash = (question => '?', answer => 42, extra => 'junk', undef => undef);
 lock_hash %hash;
 
 my %hash = (question => '?', answer => 42, extra => 'junk', undef => undef);
 lock_hash %hash;
@@ -91,7 +91,7 @@ sub testit {
 
 for $Storable::canonical (0, 1) {
   for my $cloner (\&dclone, \&freeze_thaw) {
 
 for $Storable::canonical (0, 1) {
   for my $cloner (\&dclone, \&freeze_thaw) {
-    note("\$Storable::canonical = $Storable::canonical");
+    print "# \$Storable::canonical = $Storable::canonical\n";
     testit (\%hash, $cloner);
     my $object = \%hash;
     # bless {}, "Restrict_Test";
     testit (\%hash, $cloner);
     my $object = \%hash;
     # bless {}, "Restrict_Test";
@@ -110,5 +110,11 @@ for $Storable::canonical (0, 1) {
       eval { $copy->{$k} = undef } ;
       is($@, '', "Can assign to reserved key '$k'?");
     }
       eval { $copy->{$k} = undef } ;
       is($@, '', "Can assign to reserved key '$k'?");
     }
+
+    my %hv;
+    $hv{a} = __PACKAGE__;
+    lock_keys %hv;
+    my $hv2 = &$cloner(\%hv);
+    ok eval { $$hv2{a} = 70 }, 'COWs do not become read-only';
   }
 }
   }
 }