[perl #100340] Free hash entries before values on delete

When a hash element is deleted in void context, if the value is freed
before the hash entry, it is possible for a destructor to see the hash
in an inconsistent state--inconsistent in that it contains entries
that are about to be freed, with nothing to indicate that.  So the
destructor itself could free the very same hash entry (e.g., by
freeing the hash), resulting in a double free, panic, or other
unpleasantness.

hv.c

@@ -1062,10 +1062,6 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 	    if (isGV(sv) && isGV_with_GP(sv) && GvCVu(sv)
 	     && HvENAME_get(hv))
 		mro_method_changed_in(hv);
-	    if (d_flags & G_DISCARD) {
-		SvREFCNT_dec(sv);
-		sv = NULL;
-	    }
 	}
 
 	/*
@@ -1093,6 +1089,11 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 	        HvHASKFLAGS_off(hv);
 	}
 
+	if (d_flags & G_DISCARD) {
+	    SvREFCNT_dec(sv);
+	    sv = NULL;
+	}
+
 	if (mro_changes == 1) mro_isa_changed_in(hv);
 	else if (mro_changes == 2)
 	    mro_package_moved(NULL, stash, gv, 1);

t/op/hash.t

@@ -8,7 +8,7 @@ BEGIN {
 
 use strict;
 
-plan tests => 11;
+plan tests => 13;
 
 my %h;
 
@@ -169,6 +169,33 @@ is($destroyed, 1, 'Timely hash destruction with lvalue keys');
     ok $normal_exit, 'freed hash elems are not visible to DESTROY';
 }
 
+# [perl #100340] Similar bug: freeing a hash elem during a delete
+sub guard::DESTROY {
+   ${$_[0]}->();
+};
+*guard = sub (&) {
+   my $callback = shift;
+   return bless \$callback, "guard"
+};
+{
+  my $ok;
+  my %t; %t = (
+    stash => {
+        guard => guard(sub{
+            $ok++;
+            delete $t{stash};
+        }),
+        foo => "bar",
+        bar => "baz",
+    },
+  );
+  ok eval { delete $t{stash}{guard}; # must be in void context
+            1 },
+    'freeing a hash elem from destructor called by delete does not die';
+  diag $@ if $@; # panic: free from wrong pool
+  is $ok, 1, 'the destructor was called';
+}
+
 # Weak references to pad hashes
 SKIP: {
     skip_if_miniperl("No Scalar::Util::weaken under miniperl", 1);