From 30ddc5bb6b3ac3a45b934e6d41d96089c6ecbfd7 Mon Sep 17 00:00:00 2001
From: Leon Timmermans <fawaka@gmail.com>
Date: Sat, 24 May 2025 19:40:59 +0200
Subject: [PATCH] Pass clone parameter to CLONE methods as a UV

Any CLONE method that needs to call sv_clone and friends needs to pass
this on as an argument.

On older releases such an argument would not be passed, so they would
need to take it as an optional argument to work in both cases. E.g.

void
CLONE(SV* classname, UV uv_params = 0)
CODE:
    CLONE_PARAMS* params = INT2PTR(params);

That means this change can break XS modules not taking the extra
argument into account. Fortunately most modules have cargo-culted a
CLONE(...) from perlxs so they're safe from this change.
---
 ext/Hash-Util-FieldHash/FieldHash.xs               |  2 +-
 ext/Hash-Util-FieldHash/lib/Hash/Util/FieldHash.pm |  2 +-
 sv.c                                               | 12 ++++++++++--
 3 files changed, 12 insertions(+), 4 deletions(-)

diff --git a/ext/Hash-Util-FieldHash/FieldHash.xs b/ext/Hash-Util-FieldHash/FieldHash.xs
index 61292b5aba74..740524e49e68 100644
--- a/ext/Hash-Util-FieldHash/FieldHash.xs
+++ b/ext/Hash-Util-FieldHash/FieldHash.xs
@@ -429,7 +429,7 @@ OUTPUT:
     RETVAL
 
 void
-CLONE(char* classname)
+CLONE(char* classname, ...)
 CODE:
     if (strEQ(classname, "Hash::Util::FieldHash")) {
         HUF_global(aTHX_ HUF_CLONE);
diff --git a/ext/Hash-Util-FieldHash/lib/Hash/Util/FieldHash.pm b/ext/Hash-Util-FieldHash/lib/Hash/Util/FieldHash.pm
index 36b628906084..bfcbb9f107e4 100644
--- a/ext/Hash-Util-FieldHash/lib/Hash/Util/FieldHash.pm
+++ b/ext/Hash-Util-FieldHash/lib/Hash/Util/FieldHash.pm
@@ -5,7 +5,7 @@ use warnings;
 no warnings 'experimental::builtin';
 use builtin qw(reftype);
 
-our $VERSION = '1.27';
+our $VERSION = '1.28';
 
 use Exporter 'import';
 our %EXPORT_TAGS = (
diff --git a/sv.c b/sv.c
index ae6d09dea28a..75219b35d8f1 100644
--- a/sv.c
+++ b/sv.c
@@ -16430,6 +16430,9 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     /* Call the ->CLONE method, if it exists, for each of the stashes
        identified by sv_dup() above.
     */
+
+    SV *param_sv = newSVuv(PTR2UV(param));
+
     while(av_count(param->stashes) != 0) {
         HV* const stash = MUTABLE_HV(av_shift(param->stashes));
         GV* const cloner = gv_fetchmethod_autoload(stash, "CLONE", 0);
@@ -16437,10 +16440,13 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
             ENTER;
             SAVETMPS;
             PUSHMARK(PL_stack_sp);
-            rpp_extend(1);
+            rpp_extend(2);
             SV *newsv = newSVhek(HvNAME_HEK(stash));
             *++PL_stack_sp = newsv;
-            if (!rpp_stack_is_rc())
+            *++PL_stack_sp = param_sv;
+            if (rpp_stack_is_rc())
+                SvREFCNT_inc(param_sv);
+            else
                 sv_2mortal(newsv);
             call_sv(MUTABLE_SV(GvCV(cloner)), G_DISCARD);
             FREETMPS;
@@ -16448,6 +16454,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
         }
     }
 
+    SvREFCNT_dec(param_sv);
+
     if (!(flags & CLONEf_KEEP_PTR_TABLE)) {
         ptr_table_free(PL_ptr_table);
         PL_ptr_table = NULL;