Don't leak in hv_common when croaking about PL_strtab

hv_common can perform read-only actions on PL_strtab, but not write actions.
The code that detects this and croaks had been just after the allocation of
a new HE *, and hence was leaking it. Re-order the code to avoid the leak.

The leak usually wasn't noticeable as HEs are allocated from arenas, and
arenas are correctly freed during full destruction. However, building with
-DPURIFY replaces arenas with individual allocations, making this leak
visible. It's unlikely to have been hit by any production code, but it was
causing leaks during the regression tests.

Also change embed.fnc so that S_new_HE's prototype is not declared under
-DPURIFY, as the static function itself is not defined in this case. This
fixes a compiler warning.

1 files changed, 8 insertions, 4 deletions

diff --git a/hv.c b/hv.c
index c7c12cb6e1..be5c1a251f 100644
--- a/hv.c
+++ b/hv.c
@@ -824,12 +824,13 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 
     oentry = &(HvARRAY(hv))[hash & (I32) xhv->xhv_max];
 
-    entry = new_HE();
     /* share_hek_flags will do the free for us.  This might be considered
        bad API design.  */
-    if (HvSHAREKEYS(hv))
+    if (LIKELY(HvSHAREKEYS(hv))) {
+        entry = new_HE();
         HeKEY_hek(entry) = share_hek_flags(key, klen, hash, flags);
-    else if (hv == PL_strtab) {
+    }
+    else if (UNLIKELY(hv == PL_strtab)) {
         /* PL_strtab is usually the only hash without HvSHAREKEYS, so putting
            this test here is cheap  */
         if (flags & HVhek_FREEKEY)
@@ -837,8 +838,11 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
         Perl_croak(aTHX_ S_strtab_error,
                    action & HV_FETCH_LVALUE ? "fetch" : "store");
     }
-    else                                       /* gotta do the real thing */
+    else {
+        /* gotta do the real thing */
+        entry = new_HE();
         HeKEY_hek(entry) = save_hek_flags(key, klen, hash, flags);
+    }
     HeVAL(entry) = val;
 
 #ifdef PERL_HASH_RANDOMIZE_KEYS