[perl #112444] Don’t leak %^H autovivified by destructor

More precisely, don’t let a hint hash autovivified by a destructor
during scope exit leak to outer scopes.

GvHV(PL_hintgv) (aka *^H{HASH}) must be set to null before the hash in
it is freed on scope exit.  Otherwise destructors will see %^H with a
refcount of zero, and might try to iterate over a hash that is in the
process of being freed.  Bad things then happen.  Commit 2653c1e3b1
took care of this.

Now, if GvHV(PL_hintgv) is null when destructors are called, those
destructors might end up autovivifying it.  The code in scope.c that
handles hints when a scope is left (SAVEt_HINTS in Perl_leave_scope)
would then end up leaving that new autovivified %^H in place when the
scope exited, if the outer scope did not have HINT_LOCALIZE_HH set
(meaning %^H was unused).

That in itself would not be so much of a problem, if it were not for
the fact that %^H is magicalised by the scope-handling code, not when
it is autovivified (see also bug #112458).  Hence, subsequent changes
to %^H would not magically set the HINT_LOCALIZE_HH hint bit, which
bit is checked all over the place to see whether %^H is in use.  This,
in turn, would cause hints subsequently added to %^H to leak to
outer scopes.

This commit fixes that by repeatedly freeing GvHV(PL_hintgv).  If a
destructor autovivifies it again, it just causes another iteration of
the while loop.  This does mean a destructor could autovivify %^H and
cause the new %^H itself to trigger a destructor, resulting in infi-
nite loops.  But then that is that own code’s fault.

This originally came up because commit 2653c1e3b1 also caused des-
tructors that try to add new free magic to %^H to add it to a new
autovivified %^H instead of the existing %^H that was being freed.
This caused the nextgen module to fail its tests, because it uses
B::Hooks::EndOfScope to register a sub to be called on scope exit, and
it does this from a destructor itself called during scope exit.  If
the autovivified %^H leaks to an outer scope, the second destructor is
not called.

1 files changed, 32 insertions, 2 deletions

diff --git a/t/comp/hints.t b/t/comp/hints.t
index d22b15e9d1..a857755a4a 100644
--- a/t/comp/hints.t
+++ b/t/comp/hints.t
@@ -6,7 +6,7 @@ BEGIN {
     @INC = qw(. ../lib);
 }
 
-BEGIN { print "1..30\n"; }
+BEGIN { print "1..31\n"; }
 BEGIN {
     print "not " if exists $^H{foo};
     print "ok 1 - \$^H{foo} doesn't exist initially\n";
@@ -238,6 +238,36 @@ print "ok 26 - no crash when cloning a tied hint hash\n";
 }
 
 
+# [perl #112444]
+# A destructor called while %^H is freed should not be able to stop %^H
+# from being magical (due to *^H{HASH} being undef).
+{
+    BEGIN {
+	# Make sure %^H is clear and not localised, to begin with
+	%^H = ();
+	$^H = 0;
+    }
+    DESTROY { %^H }
+    {
+	{
+	    BEGIN {
+		$^H{foom} = bless[];
+	    }
+	} # scope exit triggers destructor, which autovivifies a non-
+	  # magical %^H
+	BEGIN {
+	    # Here we have the %^H created by DESTROY, which is
+	    # not localised
+	    $^H{112444} = 'baz';
+	}
+    } # %^H leaks on scope exit
+    BEGIN { @keez = keys %^H }
+}
+print "not " if @keez;
+print "ok 30 - %^H does not leak when autovivified in destructor\n";
+print "# keys are: @keez\n" if @keez;
+
+
 # Add new tests above this require, in case it fails.
 require './test.pl';
 
@@ -247,7 +277,7 @@ my $result = runperl(
     stderr => 1
 );
 print "not " if length $result;
-print "ok 30 - double-freeing hints hash\n";
+print "ok 31 - double-freeing hints hash\n";
 print "# got: $result\n" if length $result;
 
 __END__