[perl #107366] Don’t clone GVs during thread join

unless they are orphaned.

This commit stops globs that still reside in their stashes from being
cloned during a join.

That way, a sub like sub{$::x++}, when cloned into a subthread and
returned from it, will still point to the same $::x.

This commit takes the conservative approach of copying on those globs
that can be found under their names in the original thread.

While this doesn’t work for all cases, it’s probably not possible to
make it work all the time.

2 files changed, 28 insertions, 1 deletions

diff --git a/sv.c b/sv.c
index 8b266c3d44..471caba014 100644
--- a/sv.c
+++ b/sv.c
@@ -11813,6 +11813,27 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
 		return dstr;
 	    }
         }
+	else if (SvTYPE(sstr) == SVt_PVGV && !SvFAKE(sstr)) {
+	    HV *stash = GvSTASH(sstr);
+	    const HEK * hvname;
+	    if (stash && (hvname = HvNAME_HEK(stash))) {
+		/** don't clone GVs if they already exist **/
+		SV **svp;
+		stash = gv_stashpvn(HEK_KEY(hvname), HEK_LEN(hvname),
+				    HEK_UTF8(hvname) ? SVf_UTF8 : 0);
+		svp = hv_fetch(
+			stash, GvNAME(sstr),
+			GvNAMEUTF8(sstr)
+			    ? -GvNAMELEN(sstr)
+			    :  GvNAMELEN(sstr),
+			0
+		      );
+		if (svp && *svp && SvTYPE(*svp) == SVt_PVGV) {
+		    ptr_table_store(PL_ptr_table, sstr, *svp);
+		    return *svp;
+		}
+	    }
+        }
     }
 
     /* create anew and remember what it is */
diff --git a/t/op/threads.t b/t/op/threads.t
index a07fc4ad71..1181a0015f 100644
--- a/t/op/threads.t
+++ b/t/op/threads.t
@@ -9,7 +9,7 @@ BEGIN {
      skip_all_without_config('useithreads');
      skip_all_if_miniperl("no dynamic loading on miniperl, no threads");
 
-     plan(25);
+     plan(26);
 }
 
 use strict;
@@ -385,4 +385,10 @@ EOF
   ok(1, "Pipes shared between threads do not block when closed");
 }
 
+# [perl #105208] Typeglob clones should not be cloned again during a join
+{
+  threads->create(sub { sub { $::hypogamma = 3 } })->join->();
+  is $::hypogamma, 3, 'globs cloned and joined are not recloned';
+}
+
 # EOF