Make hv_notallowed a static as suggested by Nicholas Clark;

and synchronize the nomenclature to talk about restricted
(not fixed) hashes.

p4raw-id: //depot/perl@15758

6 files changed, 70 insertions, 54 deletions

diff --git a/embed.fnc b/embed.fnc
index a5b29c2cdf..d1a8185e58 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -994,6 +994,7 @@ s	|SV**	|hv_store_flags	|HV* tb|const char* key|I32 klen|SV* val \
 				|U32 hash|int flags
 s	|SV**	|hv_fetch_flags	|HV* tb|const char* key|I32 klen|I32 lval \
                                 |int flags
+s	|void	|hv_notallowed	|int flags|const char *key|I32 klen|const char *msg
 #endif
 
 #if defined(PERL_IN_MG_C) || defined(PERL_DECL_PROT)
diff --git a/embed.h b/embed.h
index 6d0049fab3..3dc9e1f12a 100644
--- a/embed.h
+++ b/embed.h
@@ -922,8 +922,13 @@
 #define more_he			S_more_he
 #define new_he			S_new_he
 #define del_he			S_del_he
-#define save_hek		S_save_hek
+#define save_hek_flags		S_save_hek_flags
 #define hv_magic_check		S_hv_magic_check
+#define unshare_hek_or_pvn	S_unshare_hek_or_pvn
+#define share_hek_flags		S_share_hek_flags
+#define hv_store_flags		S_hv_store_flags
+#define hv_fetch_flags		S_hv_fetch_flags
+#define hv_notallowed		S_hv_notallowed
 #endif
 #if defined(PERL_IN_MG_C) || defined(PERL_DECL_PROT)
 #define save_magic		S_save_magic
@@ -2471,8 +2476,13 @@
 #define more_he()		S_more_he(aTHX)
 #define new_he()		S_new_he(aTHX)
 #define del_he(a)		S_del_he(aTHX_ a)
-#define save_hek(a,b,c)		S_save_hek(aTHX_ a,b,c)
+#define save_hek_flags(a,b,c,d)	S_save_hek_flags(aTHX_ a,b,c,d)
 #define hv_magic_check(a,b,c)	S_hv_magic_check(aTHX_ a,b,c)
+#define unshare_hek_or_pvn(a,b,c,d)	S_unshare_hek_or_pvn(aTHX_ a,b,c,d)
+#define share_hek_flags(a,b,c,d)	S_share_hek_flags(aTHX_ a,b,c,d)
+#define hv_store_flags(a,b,c,d,e,f)	S_hv_store_flags(aTHX_ a,b,c,d,e,f)
+#define hv_fetch_flags(a,b,c,d,e)	S_hv_fetch_flags(aTHX_ a,b,c,d,e)
+#define hv_notallowed(a,b,c,d)	S_hv_notallowed(aTHX_ a,b,c,d)
 #endif
 #if defined(PERL_IN_MG_C) || defined(PERL_DECL_PROT)
 #define save_magic(a,b)		S_save_magic(aTHX_ a,b)
diff --git a/hv.c b/hv.c
index d9f640bb7e..dd9353dc66 100644
--- a/hv.c
+++ b/hv.c
@@ -121,10 +121,10 @@ Perl_he_dup(pTHX_ HE *e, bool shared, CLONE_PARAMS* param)
 #endif	/* USE_ITHREADS */
 
 static void
-Perl_hv_notallowed(pTHX_ int flags, const char *key, I32 klen,
-		   const char *msg)
+S_hv_notallowed(pTHX_ int flags, const char *key, I32 klen,
+		const char *msg)
 {
-    SV *sv = sv_newmortal();
+    SV *sv = sv_newmortal(), *esv = sv_newmortal();
     if (!(flags & HVhek_FREEKEY)) {
 	sv_setpvn(sv, key, klen);
     }
@@ -136,7 +136,8 @@ Perl_hv_notallowed(pTHX_ int flags, const char *key, I32 klen,
     if (flags & HVhek_UTF8) {
 	SvUTF8_on(sv);
     }
-    Perl_croak(aTHX_ msg, sv);
+    Perl_sv_setpvf(aTHX_ esv, "Attempt to %s a restricted hash", msg);
+    Perl_croak(aTHX_ SvPVX(esv), sv);
 }
 
 /* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot
@@ -305,9 +306,9 @@ S_hv_fetch_flags(pTHX_ HV *hv, const char *key, I32 klen, I32 lval, int flags)
     }
 #endif
     if (!entry && SvREADONLY(hv)) {
-	Perl_hv_notallowed(aTHX_ flags, key, klen,
-                 "Attempt to access disallowed key '%"SVf"' in a fixed hash"
-                           );
+	S_hv_notallowed(aTHX_ flags, key, klen,
+			"access disallowed key '%"SVf"' in"
+			);
     }
     if (lval) {		/* gonna assign to this, so it better be there */
 	sv = NEWSV(61,0);
@@ -458,9 +459,9 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
     }
 #endif
     if (!entry && SvREADONLY(hv)) {
-	Perl_hv_notallowed(aTHX_ flags, key, klen,
-                 "Attempt to access disallowed key '%"SVf"' in a fixed hash"
-                           );
+	S_hv_notallowed(aTHX_ flags, key, klen,
+			"access disallowed key '%"SVf"' in"
+			);
     }
     if (flags & HVhek_FREEKEY)
 	Safefree(key);
@@ -621,9 +622,9 @@ S_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val,
     }
 
     if (SvREADONLY(hv)) {
-	Perl_hv_notallowed(aTHX_ flags, key, klen,
-                 "Attempt to access disallowed key '%"SVf"' to a fixed hash"
-                           );
+	S_hv_notallowed(aTHX_ flags, key, klen,
+			"access disallowed key '%"SVf"' to"
+			);
     }
 
     entry = new_HE();
@@ -768,9 +769,9 @@ Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash)
     }
 
     if (SvREADONLY(hv)) {
-	Perl_hv_notallowed(aTHX_ flags, key, klen,
-                 "Attempt to access disallowed key '%"SVf"' to a fixed hash"
-                           );
+	S_hv_notallowed(aTHX_ flags, key, klen,
+			"access disallowed key '%"SVf"' to"
+			);
     }
 
     entry = new_HE();
@@ -903,9 +904,9 @@ Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen, I32 flags)
 	    }
 	}
 	else if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
-	    Perl_hv_notallowed(aTHX_ k_flags, key, klen,
-                   "Attempt to delete readonly key '%"SVf"' from a fixed hash"
-                               );
+	    S_hv_notallowed(aTHX_ k_flags, key, klen,
+			    "delete readonly key '%"SVf"' from"
+			    );
 	}
 
 	if (flags & G_DISCARD)
@@ -941,9 +942,9 @@ Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen, I32 flags)
 	return sv;
     }
     if (SvREADONLY(hv)) {
-	Perl_hv_notallowed(aTHX_ k_flags, key, klen,
-               "Attempt to access disallowed key '%"SVf"' from a fixed hash"
-                           );
+	S_hv_notallowed(aTHX_ k_flags, key, klen,
+			"access disallowed key '%"SVf"' from"
+			);
     }
 
     if (k_flags & HVhek_FREEKEY)
@@ -1059,9 +1060,9 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
            return Nullsv;
 	}
 	else if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
-	    Perl_hv_notallowed(aTHX_ k_flags, key, klen,
-                   "Attempt to delete readonly key '%"SVf"' from a fixed hash"
-                               );
+	    S_hv_notallowed(aTHX_ k_flags, key, klen,
+			    "delete readonly key '%"SVf"' from"
+			    );
 	}
 
 	if (flags & G_DISCARD)
@@ -1097,9 +1098,9 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
 	return sv;
     }
     if (SvREADONLY(hv)) {
-        Perl_hv_notallowed(aTHX_ k_flags, key, klen,
-            "Attempt to delete disallowed key '%"SVf"' from a fixed hash"
-           );
+        S_hv_notallowed(aTHX_ k_flags, key, klen,
+			"delete disallowed key '%"SVf"' from"
+			);
     }
 
     if (k_flags & HVhek_FREEKEY)
@@ -1619,7 +1620,7 @@ Perl_hv_clear(pTHX_ HV *hv)
 	return;
 
     if(SvREADONLY(hv)) {
-        Perl_croak(aTHX_ "Attempt to clear a fixed hash");
+        Perl_croak(aTHX_ "Attempt to clear a restricted hash");
     }
 
     xhv = (XPVHV*)SvANY(hv);
diff --git a/lib/Hash/Util.t b/lib/Hash/Util.t
index 0fe3128172..1046e32c54 100644
--- a/lib/Hash/Util.t
+++ b/lib/Hash/Util.t
@@ -23,7 +23,7 @@ foreach my $func (@Exported_Funcs) {
 my %hash = (foo => 42, bar => 23, locked => 'yep');
 lock_keys(%hash);
 eval { $hash{baz} = 99; };
-like( $@, qr/^Attempt to access disallowed key 'baz' in a fixed hash/,
+like( $@, qr/^Attempt to access disallowed key 'baz' in a restricted hash/,
                                                        'lock_keys()');
 is( $hash{bar}, 23 );
 ok( !exists $hash{baz} );
@@ -34,18 +34,18 @@ $hash{bar} = 69;
 is( $hash{bar}, 69 );
 
 eval { () = $hash{i_dont_exist} };
-like( $@, qr/^Attempt to access disallowed key 'i_dont_exist' in a fixed hash/ );
+like( $@, qr/^Attempt to access disallowed key 'i_dont_exist' in a restricted hash/ );
 
 lock_value(%hash, 'locked');
 eval { print "# oops" if $hash{four} };
-like( $@, qr/^Attempt to access disallowed key 'four' in a fixed hash/ );
+like( $@, qr/^Attempt to access disallowed key 'four' in a restricted hash/ );
 
 eval { $hash{"\x{2323}"} = 3 };
-like( $@, qr/^Attempt to access disallowed key '(.*)' in a fixed hash/,
+like( $@, qr/^Attempt to access disallowed key '(.*)' in a restricted hash/,
                                                'wide hex key' );
 
 eval { delete $hash{locked} };
-like( $@, qr/^Attempt to delete readonly key 'locked' from a fixed hash/,
+like( $@, qr/^Attempt to delete readonly key 'locked' from a restricted hash/,
                                            'trying to delete a locked key' );
 eval { $hash{locked} = 42; };
 like( $@, qr/^Modification of a read-only value attempted/,
@@ -53,7 +53,7 @@ like( $@, qr/^Modification of a read-only value attempted/,
 is( $hash{locked}, 'yep' );
 
 eval { delete $hash{I_dont_exist} };
-like( $@, qr/^Attempt to delete disallowed key 'I_dont_exist' from a fixed hash/,
+like( $@, qr/^Attempt to delete disallowed key 'I_dont_exist' from a restricted hash/,
                              'trying to delete a key that doesnt exist' );
 
 ok( !exists $hash{I_dont_exist} );
@@ -81,7 +81,7 @@ TODO: {
     lock_keys(%hash);
     lock_value(%hash, 'locked');
     eval { %hash = ( wubble => 42 ) };  # we know this will bomb
-    like( $@, qr/^Attempt to clear a fixed hash/ );
+    like( $@, qr/^Attempt to clear a restricted hash/ );
 
     eval { unlock_value(%hash, 'locked') }; # but this shouldn't
     is( $@, '', 'unlock_value() after denied assignment' );
@@ -97,7 +97,7 @@ TODO: {
     lock_value(%hash, 'RO');
 
     eval { %hash = (KEY => 1) };
-    like( $@, qr/^Attempt to clear a fixed hash/ );
+    like( $@, qr/^Attempt to clear a restricted hash/ );
 }
 
 # TODO:  This should be allowed but it might require putting extra
@@ -106,7 +106,7 @@ TODO: {
     my %hash = (KEY => 1, RO => 2);
     lock_keys(%hash);
     eval { %hash = (KEY => 1, RO => 2) };
-    like( $@, qr/^Attempt to clear a fixed hash/ );
+    like( $@, qr/^Attempt to clear a restricted hash/ );
 }
 
 
@@ -118,7 +118,7 @@ TODO: {
     $hash{foo} = 42;
     is( keys %hash, 1 );
     eval { $hash{wibble} = 42 };
-    like( $@, qr/^Attempt to access disallowed key 'wibble' in a fixed hash/,
+    like( $@, qr/^Attempt to access disallowed key 'wibble' in a restricted hash/,
                         '  locked');
 
     unlock_keys(%hash);
@@ -137,7 +137,7 @@ TODO: {
     is( $@, '' );
 
     eval { $hash{wibble} = 23 };
-    like( $@, qr/^Attempt to access disallowed key 'wibble' in a fixed hash/, '  locked' );
+    like( $@, qr/^Attempt to access disallowed key 'wibble' in a restricted hash/, '  locked' );
 }
 
 
@@ -167,4 +167,4 @@ TODO: {
 
 lock_keys(%ENV);
 eval { () = $ENV{I_DONT_EXIST} };
-like( $@, qr/^Attempt to access disallowed key 'I_DONT_EXIST' in a fixed hash/,   'locked %ENV');
+like( $@, qr/^Attempt to access disallowed key 'I_DONT_EXIST' in a restricted hash/,   'locked %ENV');
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 6bcd87a46e..f22aa80f75 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -1,4 +1,3 @@
-//depot/perl/pod/perldiag.pod#272 - edit change 14824 (text)
 =head1 NAME
 
 perldiag - various Perl diagnostics
@@ -183,26 +182,26 @@ spots.  This is now heavily deprecated.
 must either both be scalars or both be lists.  Otherwise Perl won't
 know which context to supply to the right side.
 
-=item Attempt to access disallowed key '%s' in a fixed hash
+=item Attempt to access disallowed key '%s' in a restricted hash
 
 (F) The failing code has attempted to get or set a key which is not in
-the current set of allowed keys of a fixed hash.
+the current set of allowed keys of a restricted hash.
 
-=item Attempt to clear a fixed hash
+=item Attempt to clear a restricted hash
 
-(F) It is currently not allowed to clear a fixed hash, even if the
+(F) It is currently not allowed to clear a restricted hash, even if the
 new hash would contain the same keys as before.  This may change in
 the future.
 
-=item Attempt to delete readonly key '%s' from a fixed hash
+=item Attempt to delete readonly key '%s' from a restricted hash
 
 (F) The failing code attempted to delete a key whose value has been
-declared readonly from a fixed hash.
+declared readonly from a restricted hash.
 
-=item Attempt to delete disallowed key '%s' from a fixed hash
+=item Attempt to delete disallowed key '%s' from a restricted hash
 
-(F) The failing code attempted to delete from a fixed hash a key which
-is not in its key set.
+(F) The failing code attempted to delete from a restricted hash a key
+which is not in its key set.
 
 =item Attempt to bless into a reference
 
diff --git a/proto.h b/proto.h
index 7b41013807..3bd1a61c02 100644
--- a/proto.h
+++ b/proto.h
@@ -1033,8 +1033,13 @@ STATIC void	S_hfreeentries(pTHX_ HV *hv);
 STATIC void	S_more_he(pTHX);
 STATIC HE*	S_new_he(pTHX);
 STATIC void	S_del_he(pTHX_ HE *p);
-STATIC HEK*	S_save_hek(pTHX_ const char *str, I32 len, U32 hash);
+STATIC HEK*	S_save_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags);
 STATIC void	S_hv_magic_check(pTHX_ HV *hv, bool *needs_copy, bool *needs_store);
+STATIC void	S_unshare_hek_or_pvn(pTHX_ HEK* hek, const char* sv, I32 len, U32 hash);
+STATIC HEK*	S_share_hek_flags(pTHX_ const char* sv, I32 len, U32 hash, int flags);
+STATIC SV**	S_hv_store_flags(pTHX_ HV* tb, const char* key, I32 klen, SV* val, U32 hash, int flags);
+STATIC SV**	S_hv_fetch_flags(pTHX_ HV* tb, const char* key, I32 klen, I32 lval, int flags);
+STATIC void	S_hv_notallowed(pTHX_ int flags, const char *key, I32 klen, const char *msg);
 #endif
 
 #if defined(PERL_IN_MG_C) || defined(PERL_DECL_PROT)