Fix CPAN runtime compatibility across threads

dev/tools/perl_test_runner.pl

@@ -381,7 +381,11 @@ sub run_single_test {
         }
     }
 
-    my $cmd = "${timeout_cmd}$abs_jperl $test_name 2>&1";
+    # Test subprocesses run in their own process groups under GNU timeout.
+    # Never inherit an interactive terminal as stdin: a test that reads from
+    # it would receive SIGTTIN and stop indefinitely as a background group.
+    my $devnull = File::Spec->devnull();
+    my $cmd = "${timeout_cmd}$abs_jperl $test_name < $devnull 2>&1";
 
     # Capture output with timeout
     my $output = '';
@@ -397,7 +401,7 @@ sub run_single_test {
         eval {
             local $SIG{ALRM} = sub { die "timeout\n" };
             alarm($test_timeout);
-            $output = `$abs_jperl $test_name 2>&1`;
+            $output = `$cmd`;
             $exit_code = $? >> 8;
             alarm(0);
         };
@@ -446,10 +450,11 @@ sub timeout_for_test {
 
     return 600 if $test_file =~ m{
           (?:^|/)perl5_t/t/lib/croak\.t$
-        | (?:^|/)perl5_t/t/re/pat\.t$
+        | (?:^|/)perl5_t/t/re/pat(?:_thr)?\.t$
+        | (?:^|/)perl5_t/t/re/pat_psycho(?:_thr)?\.t$
         | (?:^|/)perl5_t/t/op/gv\.t$
         | (?:^|/)perl5_t/t/re/pat_advanced(?:_thr)?\.t$
-        | (?:^|/)perl5_t/t/re/speed\.t$
+        | (?:^|/)perl5_t/t/re/speed(?:_thr)?\.t$
         | (?:^|/)perl5_t/t/benchmark/gh7094-speed-up-keys-on-empty-hash\.t$
         | (?:^|/)perl5_t/t/japh/abigail\.t$
     }x && $timeout < 600;
@@ -460,8 +465,10 @@ sub requires_exclusive_slot {
     my ($test_file) = @_;
     return $test_file =~ m{
           (?:^|/)perl5_t/t/op/gv\.t$
+        | (?:^|/)perl5_t/t/re/pat(?:_thr)?\.t$
+        | (?:^|/)perl5_t/t/re/pat_psycho(?:_thr)?\.t$
         | (?:^|/)perl5_t/t/re/pat_advanced(?:_thr)?\.t$
-        | (?:^|/)perl5_t/t/re/speed\.t$
+        | (?:^|/)perl5_t/t/re/speed(?:_thr)?\.t$
         | (?:^|/)perl5_t/t/benchmark/gh7094-speed-up-keys-on-empty-hash\.t$
         | (?:^|/)perl5_t/t/japh/abigail\.t$
     }x;

src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java

@@ -1854,6 +1854,19 @@ private static List<Object> closureCapturesForMaterialization(
 
     private static void installClosureCaptureMetadata(
             RuntimeCode code, List<String> capturedNames, List<Object> capturedValues) {
+        // Named subs created through the parser populate an existing stash
+        // scalar in place rather than going through RuntimeGlob's CODE-slot
+        // assignment path. Account for that persistent stash owner so a
+        // temporary copy of \&name cannot release the named CV's pad.
+        if (code != null && code.stashRefCount == 0) {
+            for (RuntimeScalar installed : GlobalVariable.globalCodeRefs.values()) {
+                if (installed != null && installed.value == code) {
+                    code.hadStashRef = true;
+                    code.stashRefCount = 1;
+                    break;
+                }
+            }
+        }
         if (code == null || capturedValues == null || capturedValues.isEmpty()
                 || code.capturedScalars != null) {
             return;

src/main/java/org/perlonjava/runtime/perlmodule/Internals.java

@@ -37,6 +37,7 @@ public static void initialize() {
             // against native Perl. See dev/design/refcount_alignment_plan.md.
             internals.registerMethod("jperl_refstate", "jperl_refstate", "$");
             internals.registerMethod("jperl_refstate_str", "jperl_refstate_str", "$");
+            internals.registerMethod("jperl_reference_by_address", "jperlReferenceByAddress", "$");
             // Phase 4 (refcount_alignment_plan.md): On-demand reachability
             // sweep. Walks Perl-visible roots (globals, stashes, rescued
             // objects) and clears weak refs for unreachable objects. Returns
@@ -373,6 +374,13 @@ public static RuntimeList svRefcount(RuntimeArray args, int ctx) {
         return new RuntimeScalar(1).getList();
     }
 
+    /** Return a reference whose displayed address was observed in this runtime. */
+    public static RuntimeList jperlReferenceByAddress(RuntimeArray args, int ctx) {
+        long address = args.get(0).getLong();
+        RuntimeBase value = PerlRuntime.current().resolveReferenceAddress(address);
+        return value == null ? RuntimeScalarCache.scalarUndef.getList() : value.createReference().getList();
+    }
+
     /**
      * Phase 0 diagnostic: return a hashref describing the full internal
      * refcount state of the referent. Intended for differential testing

src/main/java/org/perlonjava/runtime/perlmodule/ScalarUtil.java

@@ -123,7 +123,9 @@ public static RuntimeList refaddr(RuntimeArray args, int ctx) {
             case FORMAT:
             case REGEX:
                 // Return identity of the underlying value object
-                return new RuntimeScalar(System.identityHashCode(scalar.value)).getList();
+                RuntimeBase referenced = (RuntimeBase) scalar.value;
+                PerlRuntime.current().registerReferenceAddress(referenced);
+                return new RuntimeScalar(PerlRuntime.referenceAddress(referenced)).getList();
             case GLOB:
             case GLOBREFERENCE:
                 if (scalar.value instanceof RuntimeGlob glob) {

src/main/java/org/perlonjava/runtime/runtimetypes/BObjectRegistry.java

@@ -27,7 +27,10 @@ public static RuntimeScalar resolve(long address) {
         RuntimeBase referent = reference == null ? null : reference.get();
         if (referent == null) {
             state().remove((int) address);
-            return new RuntimeScalar();
+            // An ithread clone retains the parent's already-exposed address,
+            // but resolves it to the cloned referent in the child runtime.
+            referent = PerlRuntime.current().resolveReferenceAddress(address);
+            if (referent == null) return new RuntimeScalar();
         }
         return referent.createReference();
     }

src/main/java/org/perlonjava/runtime/runtimetypes/PerlRuntime.java

@@ -28,7 +28,11 @@
 import java.util.Objects;
 import java.util.Set;
 import java.util.TreeSet;
+import java.util.ArrayDeque;
+import java.util.Deque;
+import java.lang.ref.WeakReference;
 import java.util.concurrent.Callable;
+import java.util.concurrent.ConcurrentHashMap;
 import java.util.concurrent.locks.ReentrantLock;
 
 /**
@@ -81,6 +85,7 @@ public final class PerlRuntime implements AutoCloseable {
     public RuntimeArray libOriginalInc;
     public boolean storableLastOpInNetorder;
     public final Set<String> xsShimLoadingInProgress = new HashSet<>();
+    private final Map<Long, WeakReference<RuntimeBase>> referenceAddresses = new ConcurrentHashMap<>();
 
     RuntimeIO ioStdout;
     RuntimeIO ioStderr;
@@ -150,6 +155,43 @@ public static PerlRuntime currentOrNull() {
         return frame != null ? frame.runtime : null;
     }
 
+    /** Record the address exposed by Perl reference stringification for B introspection. */
+    public void registerReferenceAddress(RuntimeBase value) {
+        registerReferenceAddress(referenceAddress(value), value);
+    }
+
+    public static long referenceAddress(RuntimeBase value) {
+        // Perl exposes the same pointer token through both reference
+        // stringification and numeric reference coercion. Runtime types may
+        // override hashCode() to implement that established token (notably
+        // typeglobs), so the B/refaddr registry must use it as well.
+        return Integer.toUnsignedLong(value.hashCode());
+    }
+
+    /** Record an inherited address token for the corresponding cloned referent. */
+    public void registerReferenceAddress(long address, RuntimeBase value) {
+        referenceAddresses.put(address, new WeakReference<>(value));
+    }
+
+    /** Resolve an address previously exposed in this interpreter instance. */
+    public RuntimeBase resolveReferenceAddress(long address) {
+        WeakReference<RuntimeBase> reference = referenceAddresses.get(address);
+        RuntimeBase value = reference == null ? null : reference.get();
+        if (reference != null && value == null) {
+            referenceAddresses.remove(address, reference);
+        }
+        return value;
+    }
+
+    Map<Long, RuntimeBase> snapshotReferenceAddresses() {
+        Map<Long, RuntimeBase> snapshot = new HashMap<>();
+        referenceAddresses.forEach((address, reference) -> {
+            RuntimeBase value = reference.get();
+            if (value != null) snapshot.put(address, value);
+        });
+        return snapshot;
+    }
+
     /** Bind this runtime until the returned scope is closed. */
     public Binding bind() {
         if (closed) {
@@ -318,6 +360,7 @@ private ThreadSnapshot snapshotCloneInternal(PerlThreadRegistry registry, long t
                 runtimeCodeState.snapshotCompiledMetadataInto(child.runtimeCodeState);
                 regexState.snapshotInto(child.regexState);
             }
+            cloner.finishSnapshot();
             child.currentDirectory = currentDirectory;
             child.initialized = true;
             try (Binding ignored = child.bind()) {
@@ -393,6 +436,7 @@ public void close() {
                 flipFlopState.clear();
                 scalarGlobState.clear();
                 pointerPackState.clear();
+                referenceAddresses.clear();
             }
             closed = true;
         } finally {

src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeArray.java

@@ -1610,7 +1610,8 @@ public Iterator<RuntimeScalar> iterator() {
      * @return A string representing the array reference.
      */
     public String toStringRef() {
-        String ref = "ARRAY(0x" + Integer.toHexString(this.hashCode()) + ")";
+        registerReferenceAddress();
+        String ref = "ARRAY(0x" + referenceAddressHex() + ")";
         return (blessId == 0
                 ? ref
                 : NameNormalizer.getBlessStr(blessId) + "=" + ref);

src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeBase.java

@@ -442,9 +442,21 @@ public RuntimeScalar getFirst() {
     }
 
     public String toStringRef() {
+        registerReferenceAddress();
         return this.toString();
     }
 
+    protected final String referenceAddressHex() {
+        return Long.toHexString(PerlRuntime.referenceAddress(this));
+    }
+
+    protected final void registerReferenceAddress() {
+        PerlRuntime runtime = PerlRuntime.currentOrNull();
+        if (runtime != null) {
+            runtime.registerReferenceAddress(this);
+        }
+    }
+
     public double getDoubleRef() {
         return this.hashCode();
     }

src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java

@@ -5770,7 +5770,8 @@ private static RuntimeList forkOpenResult(ForkOpenCompleteException exception, i
      * @return a string representing the CODE reference
      */
     public String toStringRef() {
-        String ref = "CODE(0x" + Integer.toHexString(this.hashCode()) + ")";
+        registerReferenceAddress();
+        String ref = "CODE(0x" + referenceAddressHex() + ")";
         return (blessId == 0
                 ? ref
                 : NameNormalizer.getBlessStr(blessId) + "=" + ref);

src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeGlob.java

@@ -1234,7 +1234,8 @@ public String toString() {
      * @return A string representation of the typeglob reference.
      */
     public String toStringRef() {
-        String ref = "GLOB(0x" + Integer.toHexString(this.hashCode()) + ")";
+        registerReferenceAddress();
+        String ref = "GLOB(0x" + referenceAddressHex() + ")";
         return (blessId == 0
                 ? ref
                 : NameNormalizer.getBlessStr(blessId) + "=" + ref);

src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeGraphCloner.java

@@ -56,7 +56,7 @@ public <T extends RuntimeBase> T cloneGraph(T value) {
         try {
             return (T) cloneValue(value);
         } finally {
-            if (--publicDepth == 0) finishWeakReferences();
+            if (--publicDepth == 0) finishCloneBoundary();
         }
     }
 
@@ -68,10 +68,37 @@ public List<RuntimeBase> cloneRoots(List<? extends RuntimeBase> roots) {
             for (RuntimeBase root : roots) result.add(cloneValue(root));
             return result;
         } finally {
-            if (--publicDepth == 0) finishWeakReferences();
+            if (--publicDepth == 0) finishCloneBoundary();
         }
     }
 
+    private void finishCloneBoundary() {
+        Map<Long, RuntimeBase> observed = sourceRuntime.snapshotReferenceAddresses();
+        // A stringified object can remain visible only through a weak Perl
+        // edge. ithreads still clone that live SV before invoking CLONE, so
+        // ensure it participates in this graph even when no strong root led
+        // to it during the ordinary traversal.
+        for (RuntimeBase source : observed.values()) {
+            if (!source.threadShared && !clones.containsKey(source)) {
+                cloneValue(source);
+            }
+        }
+        finishWeakReferences();
+        for (Map.Entry<Long, RuntimeBase> entry : observed.entrySet()) {
+            RuntimeBase source = entry.getValue();
+            RuntimeBase target = source.threadShared
+                    ? source : (RuntimeBase) clones.get(source);
+            if (target != null) {
+                targetRuntime.registerReferenceAddress(entry.getKey(), target);
+            }
+        }
+    }
+
+    /** Complete a runtime snapshot before any child CLONE hooks execute. */
+    void finishSnapshot() {
+        finishCloneBoundary();
+    }
+
     /** Package/runtime snapshot entry point that retains the shared graph map. */
     RuntimeBase cloneValue(RuntimeBase value) {
         if (value == null) return null;

src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeHash.java

@@ -1306,6 +1306,7 @@ public String dump() {
      * @return A string in the format "HASH(hashCode)".
      */
     public String toStringRef() {
+        registerReferenceAddress();
         // Check if this is a Perl 5.38+ class instance
         String refType = "HASH";
         if (blessId != 0) {
@@ -1315,7 +1316,7 @@ public String toStringRef() {
             }
         }
 
-        String ref = refType + "(0x" + Integer.toHexString(this.hashCode()) + ")";
+        String ref = refType + "(0x" + referenceAddressHex() + ")";
         return (blessId == 0
                 ? ref
                 : NameNormalizer.getBlessStr(blessId) + "=" + ref);

src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java

@@ -2280,6 +2280,10 @@ public String toStringNoOverload() {
     public String toStringRef() {
         if (value instanceof RuntimeBase referent) {
             BObjectRegistry.register(referent);
+            PerlRuntime runtime = PerlRuntime.currentOrNull();
+            if (runtime != null) {
+                runtime.registerReferenceAddress(referent);
+            }
         }
         String ref = switch (type) {
             case UNDEF -> "SCALAR(0x" + scalarUndef.hashCode() + ")";
@@ -2334,7 +2338,7 @@ public String toStringRef() {
                         default -> "SCALAR";
                     };
                 }
-                String refStr = typeName + "(0x" + Integer.toHexString(value.hashCode()) + ")";
+                String refStr = typeName + "(0x" + ((RuntimeBase) value).referenceAddressHex() + ")";
                 // For REFERENCE type, the blessId is on the value (referent), not on the
                 // reference itself. We handle it here; the outer blessId check is skipped
                 // for REFERENCE type to avoid double-prepending the class name for circular

src/main/perl/lib/POSIX.pm

@@ -828,6 +828,8 @@ sub WSTOPSIG { POSIX::_WSTOPSIG(@_) }
 sub WCOREDUMP { POSIX::_WCOREDUMP(@_) }
 
 sub DBL_MAX { 1.7976931348623157E308 }
+sub DBL_EPSILON { 2.220446049250313E-16 }
+sub LDBL_EPSILON { 2.220446049250313E-16 }
 
 1;
 

src/test/resources/unit/b_sv_object_2svref_thread_clone.t

@@ -0,0 +1,24 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 3;
+use B ();
+use Scalar::Util qw(refaddr reftype);
+use threads;
+
+my $referent = bless {}, 'Local::ThreadType';
+my $address = refaddr($referent);
+
+my $result = threads->create(sub {
+    my $b_object = bless \$address, 'B::SV';
+    my $restored = $b_object->object_2svref;
+    return [
+        defined($restored),
+        ref($restored),
+        reftype($restored) eq 'HASH',
+    ];
+})->join;
+
+ok($result->[0], 'B::SV restores a reference from its cloned-thread address');
+is($result->[1], 'Local::ThreadType', 'the restored reference keeps its blessing');
+ok($result->[2], 'the restored reference retains its underlying type');

src/test/resources/unit/named_sub_coderef_reuse_capture.t

@@ -0,0 +1,19 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 2;
+
+my $called = 0;
+sub callback { ++$called }
+
+my $first = bless [\&callback], 'Local::CallbackHolder';
+$first->[0]->();
+is($called, 1, 'a named callback mutates its captured lexical');
+
+$first = undef;
+$called = 0;
+
+my $second = bless [\&callback], 'Local::CallbackHolder';
+$second->[0]->();
+is($called, 1,
+    'reusing a named callback still shares the outer lexical container');