Complete Perl ithread lifecycle compatibility

dev/tools/perl_test_runner.pl

@@ -8,6 +8,7 @@
 use JSON::PP;
 use Data::Dumper;
 use POSIX qw(WNOHANG);
+use Config ();
 
 # PerlOnJava Test Runner
 # Runs standard Perl tests against PerlOnJava and analyzes results
@@ -244,6 +245,30 @@ sub process_test_result {
 sub run_single_test {
     my ($test_file) = @_;
 
+    # Core thread distributions assume their own build-directory cwd.  In
+    # particular, threads and threads-shared resolve ../../t/test.pl when
+    # PERL_CORE is set, while Thread-Queue and Thread-Semaphore load their
+    # pure-Perl implementation from the distribution's lib directory.  Keep
+    # the upstream tests unchanged and reproduce that layout here.
+    my $thread_distribution_root;
+    my $thread_distribution_uses_core = 0;
+    if ($test_file =~ m{^(perl5/dist/(threads|threads-shared))/t/}) {
+        $thread_distribution_root = $1;
+        $thread_distribution_uses_core = 1;
+    } elsif ($test_file =~ m{^(perl5/dist/(?:Thread-Queue|Thread-Semaphore))/t/}) {
+        $thread_distribution_root = $1;
+    }
+
+    local $ENV{PERL_CORE} = $thread_distribution_uses_core ? 1 : $ENV{PERL_CORE};
+    local $ENV{PERL5LIB} = $ENV{PERL5LIB};
+    if ($thread_distribution_root && !$thread_distribution_uses_core) {
+        my $distribution_lib = File::Spec->rel2abs("$thread_distribution_root/lib");
+        my $separator = $Config::Config{path_sep} || ':';
+        $ENV{PERL5LIB} = defined($ENV{PERL5LIB}) && length($ENV{PERL5LIB})
+            ? "$distribution_lib$separator$ENV{PERL5LIB}"
+            : $distribution_lib;
+    }
+
     # A few subprocess- or CPU-heavy tests routinely use most of the default
     # deadline and can cross it when the full parallel corpus contends for CPU.
     # Give those known outliers a stable minimum wall-clock allowance while
@@ -321,7 +346,10 @@ sub run_single_test {
     # For perl5_t tests (especially Pod tests), change to the test directory
     # so they can find their test data files with relative paths
     my $local_test_dir = $test_dir;
-    if ($test_file =~ m{^perl5_t/t/}) {
+    if ($thread_distribution_root) {
+        $local_test_dir = $thread_distribution_root;
+    }
+    elsif ($test_file =~ m{^perl5_t/t/}) {
         # For core Perl 5 tests in perl5_t/t/, chdir to perl5_t/t
         # so they can find TestInit.pm via require
         $local_test_dir = 'perl5_t/t';

src/main/java/org/perlonjava/app/cli/Main.java

@@ -126,6 +126,12 @@ private static void run(String[] args) {
         try {
             PerlLanguageProvider.executePerlCode(parsedArgs, true);
 
+            int requestedThreadExit = PerlRuntime.current().threadRegistry()
+                    .requestedProcessExitOr(Integer.MIN_VALUE);
+            if (requestedThreadExit != Integer.MIN_VALUE) {
+                System.exit(requestedThreadExit);
+            }
+
             if (parsedArgs.compileOnly) {
                 // Match system perl: `perl -c` prints this line to stderr (Test::Script relies on it).
                 System.err.println(parsedArgs.fileName + " syntax OK");
@@ -143,7 +149,8 @@ private static void run(String[] args) {
             }
         } catch (PerlExitException e) {
             // Perl's exit() throws PerlExitException - convert to real System.exit() for CLI
-            System.exit(e.getExitCode());
+            System.exit(PerlRuntime.current().threadRegistry()
+                    .requestedProcessExitOr(e.getExitCode()));
         } catch (Throwable t) {
             if (parsedArgs.debugEnabled) {
                 // Print full JVM stack

src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java

@@ -3399,6 +3399,11 @@ void compileVariableDeclaration(OperatorNode node, String op) {
                                             throwCompilerException("Unsupported variable type in list declaration: " + sigil);
                                 }
 
+                                // A captured declaration-list slot is retrieved from the
+                                // persistent definition-time cell, but attributes still
+                                // apply at runtime to that exact cell before its first use.
+                                emitVarAttrsIfNeeded(node, reg, sigil);
+
                                 varRegs.add(reg);
                                 wrapWithRef.add(isDeclaredReference);
                             } else {

src/main/java/org/perlonjava/backend/bytecode/BytecodeInterpreter.java

@@ -57,6 +57,7 @@ static boolean isImmutableProxy(RuntimeBase val) {
     private static boolean lexicalAssignmentMustPreserveSlot(RuntimeBase val) {
         if (!(val instanceof RuntimeScalar scalar)) return false;
         return scalar instanceof ReadOnlyAlias
+                || scalar.threadShared
                 || scalar.captureCount > 0
                 || scalar.captureRefCountOwned > 0
                 || scalar.referencedByScalarReference

src/main/java/org/perlonjava/backend/bytecode/CompileAssignment.java

@@ -798,12 +798,12 @@ public static void compileAssignmentOperator(BytecodeCompiler bytecodeCompiler,
                                             }
                                         }
                                         bytecodeCompiler.registerVariable(varName, varReg);
-                                        // Outer `my ($a,$b) : ATTR` puts attributes on the `my` node, not on
-                                        // each list slot; dispatching MODIFY_*_ once per RETRIEVE_BEGIN_* slot
-                                        // would duplicate calls. Variable attributes + RETRIEVE_BEGIN_* are
-                                        // fully handled for `my $x`, `my @x`, `my %x`, and `my $x=` forms above.
                                         bytecodeCompiler.emit(Opcodes.REGISTER_MY_VAR);
                                         bytecodeCompiler.emitReg(varReg);
+                                        // Attributes on a list declaration belong to every declared slot.
+                                        // The assignment-specific path constructs these slots directly, so
+                                        // it must dispatch attributes here before SET_FROM_LIST populates them.
+                                        bytecodeCompiler.emitVarAttrsIfNeeded(leftOp, varReg, sigil);
                                     } else {
                                         varReg = bytecodeCompiler.addVariable(varName, "my");
                                         switch (sigil) {
@@ -823,6 +823,7 @@ public static void compileAssignmentOperator(BytecodeCompiler bytecodeCompiler,
                                         bytecodeCompiler.emitLexicalAlias(varReg, varName);
                                         bytecodeCompiler.emit(Opcodes.REGISTER_MY_VAR);
                                         bytecodeCompiler.emitReg(varReg);
+                                        bytecodeCompiler.emitVarAttrsIfNeeded(leftOp, varReg, sigil);
                                     }
                                     varRegs.add(varReg);
                                 }

src/main/java/org/perlonjava/backend/bytecode/CompileBinaryOperator.java

@@ -691,7 +691,14 @@ else if (node.right instanceof BinaryOperatorNode rightCall) {
         // The repeat operator preserves list context on its left operand:
         // `(($expr) x 4)` repeats values, while scalar-context x repeats the
         // resulting string. All other ordinary binary operands are scalar.
-        int leftCtx = node.operator.equals("x") ? outerCtx : RuntimeContextType.SCALAR;
+        int leftCtx = switch (node.operator) {
+            case "x" -> outerCtx;
+            // Preserve the actual scalar slot: bless may publish metadata through
+            // a threads::shared scalar and must not operate on a temporary copy.
+            case "bless" -> isDirectScalarLvalue(node.left)
+                    ? RuntimeContextType.LVALUE : RuntimeContextType.SCALAR;
+            default -> RuntimeContextType.SCALAR;
+        };
         bytecodeCompiler.compileNode(node.left, -1, leftCtx);
         int rs1 = bytecodeCompiler.lastResultReg;
 
@@ -712,12 +719,33 @@ else if (node.right instanceof BinaryOperatorNode rightCall) {
         int rs2 = bytecodeCompiler.lastResultReg;
 
         // Emit opcode based on operator (delegated to helper method)
-        int rd = CompileBinaryOperatorHelper.compileBinaryOperatorSwitch(bytecodeCompiler, node, rs1, rs2, node.getIndex());
+        // In list context, both forms are range operators.  The distinction
+        // between `..` and `...` only belongs to scalar flip-flop semantics.
+        // Keeping `...` here used to emit FLIP_FLOP even for array-slice
+        // indices such as @array[1...4], collapsing the slice to one element.
+        int rd = node.operator.equals("...") && outerCtx != RuntimeContextType.SCALAR
+                ? CompileBinaryOperatorHelper.compileBinaryOperatorSwitch(
+                        bytecodeCompiler, "..", rs1, rs2, node.getIndex())
+                : CompileBinaryOperatorHelper.compileBinaryOperatorSwitch(
+                        bytecodeCompiler, node, rs1, rs2, node.getIndex());
 
 
         bytecodeCompiler.lastResultReg = rd;
     }
 
+    private static boolean isDirectScalarLvalue(Node node) {
+        if (node instanceof OperatorNode operator) {
+            return operator.operator.equals("$");
+        }
+        if (node instanceof BinaryOperatorNode binary) {
+            return switch (binary.operator) {
+                case "[", "{" -> true;
+                default -> false;
+            };
+        }
+        return false;
+    }
+
     private static void compileBinaryAsListOp(BytecodeCompiler bytecodeCompiler, BinaryOperatorNode node) {
         if (node.left instanceof IdentifierNode idNode) {
             String name = NameNormalizer.normalizeVariableName(idNode.name, bytecodeCompiler.getCurrentPackage());

src/main/java/org/perlonjava/backend/bytecode/Disassemble.java

@@ -208,6 +208,12 @@ public static String disassemble(InterpretedCode interpretedCode) {
                         src = interpretedCode.bytecode[pc++];
                         sb.append("ASSIGN_LEXICAL_SCALAR r").append(rd).append(" = r").append(src).append("\n");
                         break;
+                    case Opcodes.DISPATCH_VAR_ATTRS:
+                        rd = interpretedCode.bytecode[pc++];
+                        int attributeMetadataIdx = interpretedCode.bytecode[pc++];
+                        sb.append("DISPATCH_VAR_ATTRS r").append(rd)
+                                .append(" const[").append(attributeMetadataIdx).append("]\n");
+                        break;
                     case Opcodes.RELEASE_CONSUMED_TEMP:
                         src = interpretedCode.bytecode[pc++];
                         rd = interpretedCode.bytecode[pc++];

src/main/java/org/perlonjava/backend/bytecode/Opcodes.java

@@ -2355,9 +2355,9 @@ public class Opcodes {
     /**
      * Assign to an existing lexical scalar.
      * Plain lexicals are replaced with a fresh RuntimeScalar, preserving the
-     * current interpreter behavior for local/alias restoration. Magical lexicals
-     * such as tied scalars and Internals::SvREADONLY scalars are assigned in
-     * place so STORE/read-only checks still fire.
+     * current interpreter behavior for local/alias restoration. Magical and
+     * shared lexicals are assigned in place so STORE/read-only checks and
+     * shared storage identity are preserved.
      * Format: ASSIGN_LEXICAL_SCALAR rd rs
      */
     public static final short ASSIGN_LEXICAL_SCALAR = 491;

src/main/java/org/perlonjava/backend/jvm/EmitBinaryOperator.java

@@ -7,7 +7,9 @@
 import org.perlonjava.frontend.analysis.EmitterVisitor;
 import org.perlonjava.frontend.astnode.BinaryOperatorNode;
 import org.perlonjava.frontend.astnode.IdentifierNode;
+import org.perlonjava.frontend.astnode.Node;
 import org.perlonjava.frontend.astnode.NumberNode;
+import org.perlonjava.frontend.astnode.OperatorNode;
 import org.perlonjava.frontend.astnode.StringNode;
 import org.perlonjava.runtime.operators.OperatorHandler;
 import org.perlonjava.runtime.perlmodule.Strict;
@@ -30,6 +32,13 @@ private static boolean isIntegerEnabled(EmitterVisitor emitterVisitor, BinaryOpe
     static void handleBinaryOperator(EmitterVisitor emitterVisitor, BinaryOperatorNode node, OperatorHandler operatorHandler) {
         EmitterVisitor scalarVisitor =
                 emitterVisitor.with(RuntimeContextType.SCALAR); // execute operands in scalar context
+        // bless mutates the scalar slot as well as its referent.  In particular,
+        // threads::shared publishes a class change only when the operand is the
+        // actual shared scalar, not a scalar-context copy of its reference.
+        EmitterVisitor leftVisitor = node.operator.equals("bless")
+                && isDirectScalarLvalue(node.left)
+                ? emitterVisitor.with(RuntimeContextType.LVALUE)
+                : scalarVisitor;
         if (CompilerOptions.DEBUG_ENABLED) emitterVisitor.ctx.logDebug("handleBinaryOperator: " + node.toString());
 
         if (isIntegerEnabled(emitterVisitor, node)
@@ -200,7 +209,7 @@ && switch (node.operator) {
         }
 
         MethodVisitor mv = emitterVisitor.ctx.mv;
-        node.left.accept(scalarVisitor); // left parameter
+        node.left.accept(leftVisitor); // left parameter
         int leftSlot = emitterVisitor.ctx.javaClassInfo.acquireSpillSlot();
         boolean pooled = leftSlot >= 0;
         if (!pooled) {
@@ -219,6 +228,19 @@ && switch (node.operator) {
         emitOperator(node, emitterVisitor);
     }
 
+    private static boolean isDirectScalarLvalue(Node node) {
+        if (node instanceof OperatorNode operator) {
+            return operator.operator.equals("$");
+        }
+        if (node instanceof BinaryOperatorNode binary) {
+            return switch (binary.operator) {
+                case "[", "{" -> true;
+                default -> false;
+            };
+        }
+        return false;
+    }
+
     private static void emitIntegerBinaryOperator(EmitterVisitor emitterVisitor,
                                                   EmitterVisitor scalarVisitor,
                                                   BinaryOperatorNode node,

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

@@ -414,11 +414,18 @@ static RuntimeList runSpecialBlock(Parser parser, String blockPhase, Node block,
                     loc.fileName(),
                     loc.lineNumber());
             try {
+                // Deferred phasers must return the anonymous CODE value to the
+                // parser so it can be queued.  Compiling that wrapper in VOID
+                // context let the interpreter discard the last expression;
+                // the JVM happened to preserve it.  BEGIN keeps its caller's
+                // requested context because it executes immediately.
+                int executionContext = blockPhase.equals("BEGIN")
+                        ? contextType : RuntimeContextType.SCALAR;
                 result = PerlLanguageProvider.executePerlAST(
                         new BlockNode(nodes, tokenIndex),
                         parser.tokens,
                         parsedArgs,
-                        contextType);
+                        executionContext);
             } finally {
                 CallerStack.pop();
                 Deque<ScopedSymbolTable> scopes = compileTimeMutationScopes.get();

src/main/java/org/perlonjava/runtime/operators/Operator.java

@@ -568,6 +568,9 @@ public static RuntimeList splice(RuntimeArray runtimeArray, RuntimeList list) {
      * list context.
      */
     public static RuntimeList splice(RuntimeArray runtimeArray, RuntimeList list, int ctx) {
+        if (runtimeArray.threadShared) {
+            throw new IllegalStateException("Splice not implemented for shared arrays");
+        }
         return switch (runtimeArray.type) {
             case PLAIN_ARRAY -> {
                 RuntimeList removedElements = new RuntimeList();

src/main/java/org/perlonjava/runtime/operators/ReferenceOperators.java

@@ -182,6 +182,13 @@ public static RuntimeScalar bless(RuntimeScalar runtimeScalar, RuntimeScalar cla
                 MortalList.setActive(true);
             }
             DestroyDispatch.registerIfDestroyable(referent, newBlessId);
+            // A reference stored in a shared scalar publishes its class to
+            // the common slot. An ordinary argument/reference remains an
+            // ithread-local wrapper, even when its aggregate storage is shared.
+            if (runtimeScalar.threadShared
+                    || referent.sharedBlessingUnpublished()) {
+                SharedPerlStorage.publishBlessing(runtimeScalar);
+            }
         } else {
             throw new PerlCompilerException("Can't bless non-reference value");
         }
@@ -203,6 +210,10 @@ public static RuntimeScalar ref(RuntimeScalar runtimeScalar) {
         if (runtimeScalar instanceof ScalarSpecialVariable specialVar) {
             return ref(specialVar.getValueAsScalar());
         }
+        if (RuntimeScalarType.isReference(runtimeScalar)
+                && runtimeScalar.value instanceof RuntimeBase referent) {
+            referent.synchronizePublishedSharedBlessing();
+        }
         String str;
         int blessId;
         switch (runtimeScalar.type) {

src/main/java/org/perlonjava/runtime/operators/TieOperators.java

@@ -345,7 +345,9 @@ public static RuntimeScalar lock(int ctx, RuntimeBase... scalars) {
         // A threaded perl still accepts lock() as a compatibility no-op until
         // threads::shared is loaded.  Core's op/lock.t relies on this behavior
         // for ordinary scalar, aggregate, and code slots.
-        if (GlobalVariable.getGlobalHash("main::INC").elements.containsKey("threads/shared.pm")) {
+        RuntimeHash inc = GlobalVariable.getGlobalHash("main::INC");
+        if (inc.elements.containsKey("threads.pm")
+                && inc.elements.containsKey("threads/shared.pm")) {
             SharedPerlStorage.lock(variable);
         }
         // For scalar references, dereference to get the value

src/main/java/org/perlonjava/runtime/operators/WarnDie.java

@@ -120,7 +120,9 @@ private static void writeWarningToStderr(String message) {
 
     public static RuntimeException maybeInvokeUnhandledDieHandler(RuntimeException e) {
         Throwable unwrapped = unwrapException(e);
-        if (unwrapped instanceof PerlDieException || unwrapped instanceof PerlExitException) {
+        if (unwrapped instanceof PerlDieException
+                || unwrapped instanceof PerlExitException
+                || unwrapped instanceof PerlThreadExitException) {
             return e;
         }
         if (RuntimeCode.getEvalDepth() > 0) {
@@ -184,8 +186,18 @@ public static RuntimeScalar catchEval(Throwable e) {
         e = unwrapException(e);
 
         // exit() should never be caught by eval{} - re-throw it
-        if (e instanceof PerlExitException) {
-            throw (PerlExitException) e;
+        if (e instanceof PerlExitException exit) {
+            throw exit;
+        }
+        if (e instanceof PerlThreadExitException exit) {
+            throw exit;
+        }
+
+        RuntimeScalar pendingWarning = PerlRuntime.current().executionState()
+                .pendingThreadWarningHandler;
+        PerlRuntime.current().executionState().pendingThreadWarningHandler = null;
+        if (pendingWarning != null) {
+            RuntimeScalar.scopeExitCleanup(pendingWarning);
         }
 
         RuntimeScalar err = getGlobalVariable("main::@");
@@ -608,10 +620,26 @@ public static RuntimeBase die(RuntimeBase message, RuntimeScalar where, String f
                 DynamicVariableManager.popToLocalLevel(level);
             }
 
-            throw new PerlDieException(errVariable);
+            throw new PerlDieException(errVariable, snapshotWarningHandler());
         }
 
-        throw new PerlDieException(errVariable);
+        throw new PerlDieException(errVariable, snapshotWarningHandler());
+    }
+
+    private static RuntimeScalar snapshotWarningHandler() {
+        RuntimeScalar handler = getGlobalHash("main::SIG").get("__WARN__");
+        if (handler == null || !handler.getDefinedBoolean() || isReservedSigString(handler)) {
+            return null;
+        }
+        RuntimeScalar retained = new RuntimeScalar();
+        retained.set(handler);
+        RuntimeScalar previous = PerlRuntime.current().executionState()
+                .pendingThreadWarningHandler;
+        if (previous != null) {
+            RuntimeScalar.scopeExitCleanup(previous);
+        }
+        PerlRuntime.current().executionState().pendingThreadWarningHandler = retained;
+        return retained;
     }
 
     private static RuntimeBase dieEmptyMessage(RuntimeScalar oldErr, String fileName, int lineNumber) {