[perl #114864] Make UNIVERSAL::DESTROY changes invalidate caches

Commit 8c34e50d inadvertently caused DESTROY caches not to be
reset when UNIVERSAL::DESTROY changes.  Normally, a change to
a method will cause mro_method_changed_in to be called on all
subclasses, but mro.c cheats for UNIVERSAL and just does
++PL_sub_generation.  So clearing the DESTROY cache explicitly
in mro_method_changed_in is clearly not enough.

(cherry picked from commit c716b3beb77406159d18fd52251821fee641f9fc)

3 files changed, 24 insertions, 2 deletions

diff --git a/hv.h b/hv.h
index 2eea4779c1..be7717d3d5 100644
--- a/hv.h
+++ b/hv.h
@@ -81,6 +81,7 @@ struct mro_meta {
     U32     pkg_gen;         /* Bumps when local methods/@ISA change */
     const struct mro_alg *mro_which; /* which mro alg is in use? */
     HV      *isa;            /* Everything this class @ISA */
+    U32     destroy_gen;     /* Generation number of DESTROY cache */
 };
 
 #define MRO_GET_PRIVATE_DATA(smeta, which)		   \
diff --git a/sv.c b/sv.c
index 3736ba83e1..5f3fad3e0d 100644
--- a/sv.c
+++ b/sv.c
@@ -6442,14 +6442,21 @@ S_curse(pTHX_ SV * const sv, const bool check_refcnt) {
 	  assert(SvTYPE(stash) == SVt_PVHV);
 	  if (HvNAME(stash)) {
 	    CV* destructor = NULL;
+	    assert (SvOOK(stash));
 	    if (!SvOBJECT(stash)) destructor = (CV *)SvSTASH(stash);
-	    if (!destructor) {
+	    if (!destructor || HvMROMETA(stash)->destroy_gen
+				!= PL_sub_generation)
+	    {
 		GV * const gv =
 		    gv_fetchmeth_autoload(stash, "DESTROY", 7, 0);
 		if (gv) destructor = GvCV(gv);
 		if (!SvOBJECT(stash))
+		{
 		    SvSTASH(stash) =
 			destructor ? (HV *)destructor : ((HV *)0)+1;
+		    HvAUX(stash)->xhv_mro_meta->destroy_gen =
+			PL_sub_generation;
+		}
 	    }
 	    assert(!destructor || destructor == ((CV *)0)+1
 		|| SvTYPE(destructor) == SVt_PVCV);
diff --git a/t/mro/basic.t b/t/mro/basic.t
index ab34fc2567..be49f9ab1f 100644
--- a/t/mro/basic.t
+++ b/t/mro/basic.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-BEGIN { require q(./test.pl); } plan(tests => 59);
+BEGIN { require q(./test.pl); } plan(tests => 60);
 
 require mro;
 
@@ -370,3 +370,17 @@ is(eval { MRO_N->testfunc() }, 123);
     }
     is "il"->can("tomatoes"), "puree", 'local *ISA=[] unwinding';
 }
+
+# Changes to UNIVERSAL::DESTROY should not leave stale DESTROY caches
+# (part of #114864)
+our $destroy_output;
+sub UNIVERSAL::DESTROY { $destroy_output = "old" }
+my $x = bless[];
+undef $x; # cache the DESTROY method
+undef *UNIVERSAL::DESTROY;
+*UNIVERSAL::DESTROY = sub { $destroy_output = "new" };
+$x = bless[];
+undef $x; # should use the new DESTROY
+is $destroy_output, "new",
+    'Changes to UNIVERSAL::DESTROY invalidate DESTROY caches';
+undef *UNIVERSAL::DESTROY;