Don’t double-free hint hash if copying dies

In this horrendous piece of code, the attempt to clone GvHV(PL_hintgv)
in save_hints dies because the NEXTKEY method cannot be found.  But
that happens while GvHV(PL_hintgv) still points to the old value.  So
the old hash gets freed in the new scope (when it unwinds due to the
error in trying to find NEXTKEY) and then gets freed in the outer
scope, too, resulting in the dreaded ‘Attempt to free unrefer-
enced scalar’.

    package namespace::clean::_TieHintHash;

    sub TIEHASH  { bless[] }
    sub STORE    { $_[0][0]{$_[1]} = $_[2] }
    sub FETCH    { $_[0][0]{$_[1]} }
    sub FIRSTKEY { my $a = scalar keys %{$_[0][0]}; each %{$_[0][0]} }
  # Intentionally commented out:
  #  sub NEXTKEY  { each %{$_[0][0]} }

    package main;

    BEGIN {
	$^H{foo} = "bar"; # activate localisation magic
	tie( %^H, 'namespace::clean::_TieHintHash' ); # sabotage %^H
	$^H{foo} = "bar"; # create an element in the tied hash
    }
    { ; } # clone the tied hint hash

The solution is to set GvHV(PL_hintgv) to NULL when copying it.

1 files changed, 4 insertions, 2 deletions

diff --git a/scope.c b/scope.c
index 53bc9dfaf1..fbd92a9e1d 100644
--- a/scope.c
+++ b/scope.c
@@ -594,8 +594,10 @@ Perl_save_hints(pTHX)
     dVAR;
     COPHH *save_cophh = cophh_copy(CopHINTHASH_get(&PL_compiling));
     if (PL_hints & HINT_LOCALIZE_HH) {
-	save_pushptri32ptr(GvHV(PL_hintgv), PL_hints, save_cophh, SAVEt_HINTS);
-	GvHV(PL_hintgv) = hv_copy_hints_hv(GvHV(PL_hintgv));
+	HV *oldhh = GvHV(PL_hintgv);
+	save_pushptri32ptr(oldhh, PL_hints, save_cophh, SAVEt_HINTS);
+	GvHV(PL_hintgv) = NULL; /* in case copying dies */
+	GvHV(PL_hintgv) = hv_copy_hints_hv(oldhh);
     } else {
 	save_pushi32ptr(PL_hints, save_cophh, SAVEt_HINTS);
     }