Merge pull request #966 from fglock/feature/complete-perl-threads-final

Complete Perl ithread lifecycle compatibility

Author: fglock

dev/design/concurrency.md

@@ -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';

dev/tools/perl_test_runner.pl

@@ -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/app/cli/Main.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/BytecodeCompiler.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/BytecodeInterpreter.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/CompileAssignment.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/CompileBinaryOperator.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/Disassemble.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/bytecode/Opcodes.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,