Commit 29974cc644 for perl

commit 29974cc644cdca03cbdc4d603b6965b0427934bf
Author: Yves Orton <demerphq@gmail.com>
Date:   Thu Nov 5 20:15:55 2026 +0100

    mg: fix deferred element ownership

    Keep a deferred element from freeing the value it is about to use. A
    deferred element is an lvalue alias for an array or hash element that
    may not exist yet. It holds the container and an index or key until it
    can resolve to the element.

    The alias can hold the last reference to its container. If another
    access has since created the element, dropping the container first can
    free that element before we copy it. We now retain the element and
    update the alias before releasing the old container and key. A
    destructor run by either release sees the resolved alias.

    When an array cannot be extended, Perl_vivify_defelem() must release the
    array held by the alias. Leave LvTARG intact until the common release
    path instead of clearing it and losing that reference.

    Regression tests cover the array and hash resolution paths and the
    nonextendible array miss. The reported reproducers and focused core
    tests pass.

    Fixes #25038

    Reported-by: Marcus Hildum

diff --git a/mg.c b/mg.c
index 6acc8c9526..e14506db59 100644
--- a/mg.c
+++ b/mg.c
@@ -3284,6 +3284,9 @@ Perl_magic_setvec(pTHX_ SV *sv, MAGIC *mg)
     return 0;
 }

+/* A deferred element is an lvalue alias for an array or hash element
+   that may not exist yet. It holds the container and an index or key
+   until it can resolve to the element itself. */
 SV *
 Perl_defelem_target(pTHX_ SV *sv, MAGIC *mg)
 {
@@ -3321,13 +3324,17 @@ Perl_defelem_target(pTHX_ SV *sv, MAGIC *mg)
             }
         }
         if (targ && (targ != &PL_sv_undef)) {
-            /* somebody else defined it for us */
-            SvREFCNT_dec(LvTARG(sv));
+            /* The container may own the only reference to targ. Retain
+               targ and resolve the alias before releasing the container,
+               since that release can run destructors. */
+            SV * const old_target = LvTARG(sv);
+            SV * const old_key = mg->mg_obj;
             LvTARG(sv) = SvREFCNT_inc_simple_NN(targ);
             LvTARGLEN(sv) = 0;
-            SvREFCNT_dec(mg->mg_obj);
             mg->mg_obj = NULL;
             mg->mg_flags &= ~MGf_REFCOUNTED;
+            SvREFCNT_dec(old_target);
+            SvREFCNT_dec(old_key);
         }
         return targ;
     }
@@ -3380,21 +3387,27 @@ Perl_vivify_defelem(pTHX_ SV *sv)
         croak(PL_no_aelem, LvSTARGOFF(sv));
     else {
         AV *const av = MUTABLE_AV(LvTARG(sv));
+        /* A nonextendible miss has no value. LvTARG must keep the array
+           until the common release or its reference is leaked. */
         if ((I32)LvTARGLEN(sv) < 0 && LvSTARGOFF(sv) > AvFILL(av))
-            LvTARG(sv) = NULL;	/* array can't be extended */
+            value = NULL;
         else {
             SV* const * const svp = av_fetch(av, LvSTARGOFF(sv), TRUE);
             if (!svp || !(value = *svp))
                 croak(PL_no_aelem, LvSTARGOFF(sv));
         }
     }
+    /* Retain value and resolve the alias before releasing its old
+       references, since those releases can run destructors. */
+    SV * const old_target = LvTARG(sv);
+    SV * const old_key = mg->mg_obj;
     SvREFCNT_inc_simple_void(value);
-    SvREFCNT_dec(LvTARG(sv));
     LvTARG(sv) = value;
     LvTARGLEN(sv) = 0;
-    SvREFCNT_dec(mg->mg_obj);
     mg->mg_obj = NULL;
     mg->mg_flags &= ~MGf_REFCOUNTED;
+    SvREFCNT_dec(old_target);
+    SvREFCNT_dec(old_key);
 }

 int
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index fbf499df36..b24b8bb99b 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -443,6 +443,13 @@ manager will later use a regex to expand these into links.

 =item *

+Resolving a deferred array or hash element no longer frees the element when
+the deferred alias holds the container's last reference. Assigning through a
+deferred array element that can no longer extend its array no longer leaks the
+array. [GH #25038]
+
+=item *
+
 A case-insensitive regex trie no longer accepts a word ending partway through
 an input character's fold. For example, C</s|zoo/iu> no longer matches a
 sharp-s, whose full fold is C<ss>. Later alternatives are tried in order.
diff --git a/t/op/for.t b/t/op/for.t
index b931a66a6c..ab2236a6ad 100644
--- a/t/op/for.t
+++ b/t/op/for.t
@@ -580,6 +580,48 @@ SKIP: {
     is $@, "", 'vivify_defelem does not croak on &PL_sv_undef elements';
 }

+{
+    my $saved;
+    my $array = [10, 20, 30];
+    sub { $saved = \@_ }->($array->[5]);
+    $array->[5] = 42;
+    undef $array;
+    is $saved->[0], 42, 'defelem retains an array element before its owner';
+}
+
+{
+    my $saved;
+    my $hash = { first => 10 };
+    sub { $saved = \@_ }->($hash->{later});
+    $hash->{later} = 42;
+    undef $hash;
+    is $saved->[0], 42, 'defelem retains a hash element before its owner';
+}
+
+{
+    package DefelemOwner;
+    our $destroyed = 0;
+    sub DESTROY { ++$destroyed }
+}
+
+for my $assign (0, 1) {
+    $DefelemOwner::destroyed = 0;
+    {
+        my @array = (bless({}, 'DefelemOwner'), 2, 3);
+        delete $array[1];
+        my $index = 0;
+        for my $element (@array) {
+            if ($index++ == 1) {
+                delete $array[2];
+                $element = 42 if $assign;
+            }
+        }
+    }
+    is $DefelemOwner::destroyed, 1,
+        $assign ? 'nonextendible defelem releases its array'
+                : 'unassigned defelem releases its array';
+}
+
 for $x ($y) {
     $x = 3;
     ($x, my $z) = (1, $y);