Fix bug #24383, where hashes with the :unique attribute weren't

getting made readonly on interpreter clone. Also, remove the
:unique attribute from the hashes in warnings.pm, since they may
later be modified by warnings::register.  Finally, adds tests for
the :unique attribute.

p4raw-id: //depot/perl@22034

diff --git a/ext/threads/t/problems.t b/ext/threads/t/problems.t
index b860ff5..b2b78df 100644 (file)
--- a/ext/threads/t/problems.t
+++ b/ext/threads/t/problems.t
@@ -18,7 +18,7 @@ use threads::shared;
 # call is() from within the DESTROY() function at global destruction time,
 # and parts of Test::* may have already been freed by then
 
-print "1..5\n";
+print "1..8\n";
 
 my $test : shared = 1;
 
@@ -73,4 +73,24 @@ my $not = eval { Config::myconfig() } ? '' : 'not ';
 print "${not}ok $test - Are we able to call Config::myconfig after clone\n";
 $test++;
 
+# bugid 24383 - :unique hashes weren't being made readonly on interpreter
+# clone; check that they are.
+
+our $unique_scalar : unique;
+our @unique_array : unique;
+our %unique_hash : unique;
+threads->new(
+    sub {
+       eval { $unique_scalar = 1 };
+       print $@ =~ /read-only/  ? '' : 'not ', "ok $test - unique_scalar\n";
+       $test++;
+       eval { $unique_array[0] = 1 };
+       print $@ =~ /read-only/  ? '' : 'not ', "ok $test - unique_array\n";
+       $test++;
+       eval { $unique_hash{abc} = 1 };
+       print $@ =~ /disallowed/  ? '' : 'not ', "ok $test - unique_hash\n";
+       $test++;
+    }
+)->join;
+
 1;

diff --git a/lib/warnings.pm b/lib/warnings.pm
index 9e9b3b5..656b7ac 100644 (file)
--- a/lib/warnings.pm
+++ b/lib/warnings.pm
@@ -133,7 +133,7 @@ See L<perlmodlib/Pragmatic Modules> and L<perllexwarn>.
 
 use Carp ();
 
-our %Offsets : unique = (
+our %Offsets = (
 
     # Warnings Categories added in Perl 5.008
 
@@ -190,7 +190,7 @@ our %Offsets : unique = (
     'assertions'       => 94,
   );
 
-our %Bits : unique = (
+our %Bits = (
     'all'              => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55", # [0..47]
     'ambiguous'                => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29]
     'assertions'       => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40", # [47]
@@ -241,7 +241,7 @@ our %Bits : unique = (
     'y2k'              => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [46]
   );
 
-our %DeadBits : unique = (
+our %DeadBits = (
     'all'              => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..47]
     'ambiguous'                => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29]
     'assertions'       => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80", # [47]

diff --git a/sv.c b/sv.c
index ed31344..5efd546 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -10030,7 +10030,7 @@ S_gv_share(pTHX_ SV *sstr, CLONE_PARAMS *param)
         GvHV(gv) = (HV*)sv;
     }
     else {
-        SvREADONLY_on(GvAV(gv));
+        SvREADONLY_on(GvHV(gv));
     }
 
     return sstr; /* he_dup() will SvREFCNT_inc() */

diff --git a/warnings.pl b/warnings.pl
index 7feccb5..df766fe 100644 (file)
--- a/warnings.pl
+++ b/warnings.pl
@@ -414,7 +414,7 @@ while (<DATA>) {
 #$list{'all'} = [ $offset .. 8 * ($warn_size/2) - 1 ] ;
 
 $last_ver = 0;
-print PM "our %Offsets : unique = (\n" ;
+print PM "our %Offsets = (\n" ;
 foreach my $k (sort { $a <=> $b } keys %ValueToName) {
     my ($name, $version) = @{ $ValueToName{$k} };
     $name = lc $name;
@@ -430,7 +430,7 @@ foreach my $k (sort { $a <=> $b } keys %ValueToName) {
 
 print PM "  );\n\n" ;
 
-print PM "our %Bits : unique = (\n" ;
+print PM "our %Bits = (\n" ;
 foreach $k (sort keys  %list) {
 
     my $v = $list{$k} ;
@@ -444,7 +444,7 @@ foreach $k (sort keys  %list) {
 
 print PM "  );\n\n" ;
 
-print PM "our %DeadBits : unique = (\n" ;
+print PM "our %DeadBits = (\n" ;
 foreach $k (sort keys  %list) {
 
     my $v = $list{$k} ;