Commit 7adaf7664c for perl

commit 7adaf7664c08f45f782ff99ec5fce51ce7bf3b13
Author: Tony Cook <tony@develop-help.com>
Date:   Thu Aug 6 13:57:33 2026 +1000

    reftype/refaddr: invoke set magic in the non-reference case

    Fixes #24634

diff --git a/builtin.c b/builtin.c
index d95afda8a1..2a5338d2bf 100644
--- a/builtin.c
+++ b/builtin.c
@@ -524,7 +524,7 @@ PP(pp_refaddr)
     if(SvROK(arg))
         sv_setuv_mg(TARG, PTR2UV(SvRV(arg)));
     else
-        sv_setsv(TARG, &PL_sv_undef);
+        sv_setsv_mg(TARG, &PL_sv_undef);

     rpp_replace_1_1_NN(TARG);
     return NORMAL;
@@ -540,7 +540,7 @@ PP(pp_reftype)
     if(SvROK(arg))
         sv_setpv_mg(TARG, sv_reftype(SvRV(arg), FALSE));
     else
-        sv_setsv(TARG, &PL_sv_undef);
+        sv_setsv_mg(TARG, &PL_sv_undef);

     rpp_replace_1_1_NN(TARG);
     return NORMAL;
diff --git a/lib/builtin.t b/lib/builtin.t
index e77b283835..1a7be037e4 100644
--- a/lib/builtin.t
+++ b/lib/builtin.t
@@ -121,6 +121,27 @@ package FetchStoreCounter {
     is(reftype($obj),        "ARRAY", 'reftype yields basic container type for blessed object');
     is(reftype("not a ref"), undef,   'reftype yields undef for non-reference');

+    # GH #24634: refaddr and reftype weren't invoking set magic
+    # on TARG, and TARG could be some lvalue with magic.
+    #
+    # The test here:
+    # - $1 implements read-only-ness in its magic so if set
+    # magic is called it throws an exception.
+    # - $result is my, so TARGMY optimization should apply
+    # which makes the the assigned to variable the TARG of the OP,
+    # and
+    # - $result is an alias to $1 so $1's magic should be invoked
+    # when it is assigned to, throwing an exception.
+    #
+    # Before the fix the assignments weren't throwing exceptions
+    for my $result ($1) {
+        my $y = 1; # no constant folding
+        ok(!eval { $result = reftype($y); 1 },
+           "magic called for TARGMY reftype");
+        ok(!eval { $result = refaddr($y); 1 },
+           "magic called for TARGMY refaddr");
+    }
+
     is(blessed($arr), undef, 'blessed yields undef for non-object');
     is(blessed($obj), "Object", 'blessed yields package name for object');