diff --git a/dev/design/concurrency.md b/dev/design/concurrency.md index 2e5a41df03..e04970dbc6 100644 --- a/dev/design/concurrency.md +++ b/dev/design/concurrency.md @@ -571,27 +571,33 @@ Acceptance: `ipc_wait_timeout.t` observes Perl-compatible inherited-pipe behavior; default Test2 remains green; `AUTHOR_TESTING` and `T2_DO_THREAD_TESTS` thread suites form a separately reported stress gate. -### Phase 31 — Native callbacks and handle ownership +### Phase 31 — Native callbacks and handle ownership (implemented 2026-08-13) -Define clone, child-owned creation, or explicit rejection for every native -handle class. Bind callbacks to their captured runtime and make provider/handle -registries safe under concurrent child creation and deterministic cleanup. +Net::SSLeay verification, info, and password callbacks are bound to the runtime +that registered them, including invocation from foreign native callback +threads. SSL session handles are runtime-owned and reset with their runtime. +Detached children no longer appear in `threads->list`, and abnormal detached +termination is reported exactly once. Other native handle classes retain their +documented clone, child-owned creation, or explicit rejection policy. Acceptance: Net::SSLeay `61_threads-cb-crash.t` and `62_threads-ctx_new-deadlock.t` pass without watchdog, deadlock, cross-runtime handle leakage, or callback misbinding; applicable thread-emulated server paths in the wider Net::SSLeay suite retain their non-thread baseline. -### Phase 32 — Advanced shared values +### Phase 32 — Advanced shared values (implemented supported tranche 2026-08-13) -Extend `threads::shared` only where identity, magic, tie callbacks, locking, and -clone behavior are defined. Blessed, tied, or magical graphs remain explicit -errors until their complete semantics are proven. +Nested plain scalar/array/hash graphs now have atomic preflight before any node +is published as shared. A rejected nested node therefore cannot leave a +partially shared graph behind. Identity, mutation, recursive locking, and +condition behavior are stress-tested across child threads. Blessed, tied, and +other magical graphs remain explicit errors because their callback and +destruction semantics are not yet a supported shared-value category. Acceptance: each newly supported value category has standard-Perl-validated identity, mutation, lock/condition, clone, destruction, and stress coverage. -### Phase 33 — Compatibility completion, documentation, and examples +### Phase 33 — Compatibility completion, documentation, and examples (implemented 2026-08-13) Run the complete applicable core, Test2, Storable, and native thread matrix; update the feature matrix from raw results; and add a realistic dynamic @@ -601,9 +607,11 @@ aggregates through `join`. Acceptance: platform threads pass all supported tests on JVM and interpreter backends; every remaining skip is an explicit platform or unsupported-feature decision; virtual mode has no semantic delta; example output is deterministic -across system Perl and all supported modes. +across system Perl and all supported modes. The release gate also includes the +complete `timeout 3600 ./jcpan --jobs 8 -t DBIx::Class` distribution suite; every DBIx +test must pass before this phase is complete. -### Phase 34 — Optional runtime pooling +### Phase 34 — Optional runtime pooling (evaluated; deliberately disabled) Consider reusable runtimes only after the fresh-runtime equivalence contract is implemented in full. Pooling is neither a Perl threads requirement nor a reason @@ -612,6 +620,16 @@ to weaken close/snapshot isolation. Acceptance: every item in `runtime-pooling-reset-contract.md` passes and reuse has a measured benefit over a fresh snapshot. +The 2026-08-13 evaluation did not meet that activation threshold. The executable +negative contract proves that `close()` is terminal and retains observable +package, regex, and execution state. Pooling therefore remains disabled; fresh +snapshot runtimes remain the correctness boundary. + +Phase 33's release gate completed with `./jcpan --jobs 8 -t DBIx::Class`: +325 files and 42,671 assertions passed. The final compatibility fix ensures +non-local labeled control flow tears down every abandoned Perl frame before the +target resumes, preserving scope-guard diagnostics and redirected STDERR. + ## 6. Known Reference Material and Warnings - `dev/prompts/multiplicity-v2-plan.md` documents the incremental response to @@ -626,7 +644,7 @@ has a measured benefit over a fresh snapshot. ## 7. Progress Tracking -### Current Status: Phases 25–30 implemented; integrated validation in progress +### Current Status: Phases 31–34 complete for the supported tranche Hints, warnings, filters, and source maps are runtime-owned while compiler-only scratch remains protected by the global compile lock. The Phase 11 inventory is @@ -781,15 +799,17 @@ request history. `regexp_qr_embed` direct-language gaps before asserting thread equivalence. 3. Finish Phase 29 shutdown warnings and detached platform-thread process lifecycle. Continue Phase 30 resource classification beyond explicitly - inherited internal pipes, then implement Phase 31 native callback/handle - ownership and Phase 32 shared value categories. Preserve the green anchors: + inherited internal pipes. Preserve the green anchors: `class/threads.t`, `threads-dirh.t`, Storable threads, and default Test2 IPC. -4. Complete Phase 33 with the full platform-thread matrix on both backends, - followed by virtual-mode parity. The new - `examples/threads/dynamic_map_reduce.pl` demonstrates a small shared - scheduler, isolated worker-local hashes, and deterministic join aggregation; - it deliberately makes no performance claim. -5. Keep virtual threads experimental until native callback diagnostics and +4. Keep the complete platform-thread matrix green on both backends and retain + virtual-mode parity. The new `examples/threads/dynamic_map_reduce.pl` + demonstrates a small shared scheduler, isolated worker-local hashes, and + deterministic join aggregation; it deliberately makes no performance claim. +5. Keep the DBIx::Class regression gate green with captured output from + `timeout 3600 ./jcpan --jobs 8 -t DBIx::Class`. Investigate every future + failure against the merged baseline; partial distribution results are not + sufficient for release. +6. Keep virtual threads experimental until native callback diagnostics and repeated benchmarks justify promotion. Keep runtime pooling disabled until the separate Phase 34 reset contract proves fresh-runtime equivalence. diff --git a/dev/design/runtime-pooling-reset-contract.md b/dev/design/runtime-pooling-reset-contract.md index 0c1c2a26e5..216876657c 100644 --- a/dev/design/runtime-pooling-reset-contract.md +++ b/dev/design/runtime-pooling-reset-contract.md @@ -2,7 +2,8 @@ ## Status -Runtime pooling is deferred. `PerlRuntime.close()` is a terminal resource-release +Runtime pooling was re-evaluated on 2026-08-13 and remains deliberately +disabled. `PerlRuntime.close()` is a terminal resource-release operation, not a reset operation, and a closed runtime deliberately rejects `bind`, `initialize`, and `execute`. Reusing it would currently expose state that a newly constructed runtime does not contain. @@ -11,6 +12,11 @@ This document defines the proof required before a pool may be implemented. It does not authorize clearing state opportunistically or enabling pooling behind an experimental flag. +This is the Phase 34 outcome, not an untracked implementation shortcut. Runtime +pooling is optional and is not required for Perl ithread correctness. The +negative automated contract below passes, while every positive equivalence +item remains a prerequisite for any future pooling PR. + ## Fresh-runtime equivalence A reusable runtime must expose the same observable state as a newly constructed diff --git a/docs/about/changelog.md b/docs/about/changelog.md index f84f13251e..801985235e 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -17,8 +17,12 @@ Release history of PerlOnJava. See [Roadmap](roadmap.md) for future plans. locks, condition variables, and compatible imports/stringification. `Config` now reports `useithreads`, `usethreads`, and `usemultiplicity` as `define`. Platform threads remain the default and virtual threads are an - experimental opt-in. Thread signals, effective stack sizing, blessed/tied - shared values, and some upstream core/native-callback suites remain limited; + experimental opt-in. Live attached children support targeted signals, + `object`/`wantarray`, and platform-thread stack sizing. Native-style callback + registrations retain their owning runtime, internal pipes have an explicit + inherited-handle policy, and nested plain shared graphs are validated before + publication. Blessed/tied shared values and some upstream core/regex suites + remain limited; see the [feature matrix](../reference/feature-matrix.md#concurrency-and-perl-threads). - CPAN/tooling: expose tested dependency scripts through `PATH`, deduplicate repeated `PERL5LIB` setup, and resolve test prerequisites against tested diff --git a/docs/about/roadmap.md b/docs/about/roadmap.md index 298ea35e53..056f51bc3a 100644 --- a/docs/about/roadmap.md +++ b/docs/about/roadmap.md @@ -288,11 +288,12 @@ threads are the default; virtual threads are experimental. Remaining work: -- Complete the currently partial applicable core suites and Storable thread test. -- Implement thread signals and the remaining `object`/`wantarray` surface. -- Decide whether effective per-thread stack sizing can be exposed safely. -- Validate native callback/resource behavior and virtual-thread diagnostics on - the supported Java 24 baseline. +- Complete the currently partial applicable core and regex suites. +- Extend native-resource inheritance beyond the explicitly supported internal + pipe policy only when ownership and last-close semantics are defined. +- Decide which blessed, tied, or magical values can safely join the supported + `threads::shared` tranche. +- Keep runtime pooling disabled until the reset-equivalence contract is proven. --- diff --git a/docs/reference/feature-matrix.md b/docs/reference/feature-matrix.md index d915c330d4..ecbea11a6c 100644 --- a/docs/reference/feature-matrix.md +++ b/docs/reference/feature-matrix.md @@ -862,11 +862,11 @@ storage as their parent counterparts. Values explicitly shared through | Limitation | Effect | |---|---| -| Thread signals | `threads->kill` is not implemented. | -| Effective stack sizing | Standard `stack_size` import syntax is accepted for source compatibility, but JVM stack sizing remains runtime-managed. | -| Additional introspection | `threads->object` and `wantarray` are not implemented. | +| Thread signals | `threads->kill` targets live attached children and resolves the handler inside the child runtime. Completed and detached targets are not signalable. | +| Effective stack sizing | Platform-backed children honor supported `stack_size` create/import requests. Virtual threads reject nonzero stack sizes because their stacks are JVM-managed. | +| Additional introspection | `threads->object` and creation-context `wantarray` are implemented; process-shutdown warning parity remains incomplete. | | Shared object classes | Blessed and tied values are rejected by the supported `share`/`shared_clone` tranche. | -| Native resources and callbacks | Java I/O/native handles are not portably duplicated into child snapshots; native callback thread isolation remains suite-specific. | +| Native resources and callbacks | Internal pipes have an inherited lease policy. Net::SSLeay handles are runtime-owned and stored callbacks bind their registering runtime. Ordinary files, sockets, and other native handles are still rejected rather than silently shared. | | Upstream suite coverage | Core compatibility remains partial: measured results include `op/threads.t` 29/30, `op/substr_thr.t` 368/400, and `re/stclass_threads.t` 2/6; `class/threads.t`, Storable's thread test, `threads-dirh.t`, and Test2's thread IPC acceptance test complete. The regex suite now executes its child and exposes unsupported thread-local `re 'debug'` trace parity. | | PSGI | Availability of ithreads does not make one captured PSGI application runtime concurrently callable. `Plack::Handler::Netty` advertises `psgi.multithread => \0`. | diff --git a/examples/threads/README.md b/examples/threads/README.md index 811c95b52c..3c465994c1 100644 --- a/examples/threads/README.md +++ b/examples/threads/README.md @@ -39,6 +39,8 @@ JPERL_OPTS=-Djperl.thread.mode=virtual \ ./jperl examples/threads/isolated_create_join.pl ``` -Thread signals, effective per-thread stack sizing, and sharing tied or blessed -values are outside the currently supported tranche. A captured PSGI runtime is -also not made concurrently callable merely by enabling ithreads. +Live attached children support targeted thread signals. Platform-backed +ithreads accept an effective Java stack-size request; virtual mode rejects a +nonzero request because virtual-thread stacks are JVM-managed. Sharing tied or +blessed values remains outside the supported tranche. A captured PSGI runtime +is also not made concurrently callable merely by enabling ithreads. diff --git a/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java b/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java index 926c0b3771..3aeda95751 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java +++ b/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java @@ -1399,6 +1399,11 @@ public void visit(BlockNode node) { loopStack.pop(); } + // A surrounding labeled-block dispatcher may need to enter this + // block's teardown after a nested sub/eval returns a LAST marker. + // Record the first cleanup opcode before regex/local/lexical unwind. + node.setAnnotation("interpreterNonLocalExitPc", bytecode.size()); + if (regexSaveReg >= 0) { emit(Opcodes.RESTORE_REGEX_STATE); emitReg(regexSaveReg); @@ -6395,16 +6400,24 @@ public void visit(For3Node node) { bodyStartPc, true); loopStack.push(loopInfo); + int nonLocalExitPc = -1; enterScope(); try { if (node.body != null) { compileNode(node.body, outerResultReg, currentCallContext); + Object cleanupPc = node.body.getAnnotation("interpreterNonLocalExitPc"); + if (cleanupPc instanceof Integer pc) { + nonLocalExitPc = pc; + } } if (outerResultReg >= 0 && lastResultReg >= 0) { emitAliasWithTarget(outerResultReg, lastResultReg); } } finally { // Exit scope to clean up lexical variables + if (nonLocalExitPc < 0) { + nonLocalExitPc = bytecode.size(); + } exitScope(true); // safe to flush — foreach body, not subroutine } @@ -6426,8 +6439,10 @@ public void visit(For3Node node) { if (node.labelName != null) { emit(Opcodes.POP_LABELED_BLOCK); - int exitPc = bytecode.size(); - patchJump(exitPcPlaceholder, exitPc); + // A marker returned by a nested sub/eval must enter at the + // lexical teardown sequence that ordinary fallthrough runs. + // Jumping past it leaks block lexicals and delays DESTROY. + patchJump(exitPcPlaceholder, nonLocalExitPc); } // Patch last (break) PCs to jump to local cleanup (or past the block if no locals). diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitControlFlow.java b/src/main/java/org/perlonjava/backend/jvm/EmitControlFlow.java index a90af0c950..fe29217b27 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitControlFlow.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitControlFlow.java @@ -38,7 +38,7 @@ private static boolean containsAggregateReferenceReturn(Node node) { && (aggregateOp.operator.equals("@") || aggregateOp.operator.equals("%")); } - private static void emitSubroutineExitCleanup(EmitterContext ctx) { + static void emitSubroutineExitCleanup(EmitterContext ctx) { java.util.List scalarIndices = EmitStatement.withoutCaptured(ctx, ctx.symbolTable.getMyScalarIndicesInScope(0)); java.util.List hashIndices = @@ -248,16 +248,36 @@ static void handleNextOperator(EmitterVisitor emitterVisitor, OperatorNode node) Label label = operator.equals("next") ? loopLabels.nextLabel : operator.equals("last") ? loopLabels.lastLabel : loopLabels.redoLabel; - emitLoopControlScopeCleanup(ctx, loopLabels); + emitLoopControlScopeCleanup(ctx, loopLabels, operator.equals("last")); emitMortalFlushAboveMark(ctx); ctx.mv.visitJumpInsn(Opcodes.GOTO, label); } - private static void emitLoopControlScopeCleanup(EmitterContext ctx, LoopLabels loopLabels) { - if (loopLabels.cleanupScopeIndex < 0) { + private static void emitLoopControlScopeCleanup( + EmitterContext ctx, LoopLabels loopLabels, boolean exitsLoop) { + int cleanupScopeIndex = exitsLoop && loopLabels.lastCleanupScopeIndex >= 0 + ? loopLabels.lastCleanupScopeIndex + : loopLabels.cleanupScopeIndex; + if (cleanupScopeIndex < 0) { return; } - EmitStatement.emitScopeExitNullStores(ctx, loopLabels.cleanupScopeIndex, true); + EmitStatement.emitLoopControlScopeExit(ctx, cleanupScopeIndex); + } + + static void emitLoopControlScopeCleanupForDispatcher( + EmitterContext ctx, LoopLabels loopLabels, boolean exitsLoop) { + if (loopLabels.cleanupMarkSlot >= 0) { + ctx.mv.visitVarInsn(Opcodes.ILOAD, loopLabels.cleanupMarkSlot); + ctx.mv.visitMethodInsn(Opcodes.INVOKESTATIC, + "org/perlonjava/runtime/runtimetypes/MyVarCleanupStack", + "unwindTo", "(I)V", false); + } + emitLoopControlScopeCleanup(ctx, loopLabels, exitsLoop); + ctx.mv.visitMethodInsn(Opcodes.INVOKESTATIC, + "org/perlonjava/runtime/runtimetypes/MortalList", + "flush", + "()V", + false); } private static void emitMortalFlushAboveMark(EmitterContext ctx) { diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitEval.java b/src/main/java/org/perlonjava/backend/jvm/EmitEval.java index 40a53e119e..1fe943efc4 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitEval.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitEval.java @@ -368,12 +368,18 @@ static void handleEvalOperator(EmitterVisitor emitterVisitor, OperatorNode node) mv.visitJumpInsn(Opcodes.GOTO, nextLabel); mv.visitLabel(isLast); + EmitControlFlow.emitLoopControlScopeCleanupForDispatcher( + emitterVisitor.ctx, loopLabels, true); mv.visitJumpInsn(Opcodes.GOTO, loopLabels.lastLabel); mv.visitLabel(isNext); + EmitControlFlow.emitLoopControlScopeCleanupForDispatcher( + emitterVisitor.ctx, loopLabels, false); mv.visitJumpInsn(Opcodes.GOTO, loopLabels.nextLabel); mv.visitLabel(isRedo); + EmitControlFlow.emitLoopControlScopeCleanupForDispatcher( + emitterVisitor.ctx, loopLabels, false); mv.visitJumpInsn(Opcodes.GOTO, loopLabels.redoLabel); mv.visitLabel(nextLabel); diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitStatement.java b/src/main/java/org/perlonjava/backend/jvm/EmitStatement.java index 17506377ab..2e7b0858a6 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitStatement.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitStatement.java @@ -94,10 +94,30 @@ static void emitScopeExitNullStores(EmitterContext ctx, int scopeIndex, boolean } static void emitScopeExitNullStores(EmitterContext ctx, int scopeIndex, boolean flush, int returnedLvalueSlot) { + emitScopeExitNullStores(ctx, scopeIndex, flush, returnedLvalueSlot, false); + } + + static void emitLoopControlScopeExit(EmitterContext ctx, int scopeIndex) { + // A non-local loop exit ends locally declared cells even when an inner + // closure captured them. scopeExitCleanup marks those cells exited and + // defers their values until the closure releases them. Constructor + // captures from an enclosing class are not declared in this scope. + emitScopeExitNullStores(ctx, scopeIndex, true, -1, true); + } + + private static void emitScopeExitNullStores( + EmitterContext ctx, int scopeIndex, boolean flush, + int returnedLvalueSlot, boolean includeCaptured) { // Gather variable indices for this scope first, to determine if cleanup is needed. - java.util.List scalarIndices = withoutCaptured(ctx, ctx.symbolTable.getMyScalarIndicesInScope(scopeIndex)); - java.util.List hashIndices = withoutCaptured(ctx, ctx.symbolTable.getMyHashIndicesInScope(scopeIndex)); - java.util.List arrayIndices = withoutCaptured(ctx, ctx.symbolTable.getMyArrayIndicesInScope(scopeIndex)); + java.util.List scalarIndices = includeCaptured + ? ctx.symbolTable.getMyScalarIndicesInScope(scopeIndex) + : withoutCaptured(ctx, ctx.symbolTable.getMyScalarIndicesInScope(scopeIndex)); + java.util.List hashIndices = includeCaptured + ? ctx.symbolTable.getMyHashIndicesInScope(scopeIndex) + : withoutCaptured(ctx, ctx.symbolTable.getMyHashIndicesInScope(scopeIndex)); + java.util.List arrayIndices = includeCaptured + ? ctx.symbolTable.getMyArrayIndicesInScope(scopeIndex) + : withoutCaptured(ctx, ctx.symbolTable.getMyArrayIndicesInScope(scopeIndex)); // Record my-variable indices for eval exception cleanup. // When evalCleanupLocals is non-null (set by EmitterMethodCreator for eval blocks), @@ -187,7 +207,9 @@ static void emitScopeExitNullStores(EmitterContext ctx, int scopeIndex, boolean // Phase 2: Null all my variable slots to help GC collect associated objects. // For anonymous filehandle globs, this makes them unreachable so the // PhantomReference-based fd recycling in RuntimeIO can close the IO stream. - java.util.List allIndices = withoutCaptured(ctx, ctx.symbolTable.getMyVariableIndicesInScope(scopeIndex)); + java.util.List allIndices = includeCaptured + ? ctx.symbolTable.getMyVariableIndicesInScope(scopeIndex) + : withoutCaptured(ctx, ctx.symbolTable.getMyVariableIndicesInScope(scopeIndex)); // Phase E (refcount_alignment_52leaks_plan.md): deregister each // my-variable from MyVarCleanupStack before nulling the local slot. // Without this, the static stack holds strong references to @@ -640,7 +662,14 @@ public static void emitFor3(EmitterVisitor emitterVisitor, For3Node node) { RuntimeContextType.VOID, true, true); - emitterVisitor.ctx.javaClassInfo.getInnermostLoopLabels().cleanupScopeIndex = scopeIndex + 1; + LoopLabels loopLabels = emitterVisitor.ctx.javaClassInfo.getInnermostLoopLabels(); + loopLabels.cleanupScopeIndex = scopeIndex + 1; + loopLabels.lastCleanupScopeIndex = scopeIndex + 1; + loopLabels.cleanupMarkSlot = emitterVisitor.ctx.symbolTable.allocateLocalVariable(); + mv.visitMethodInsn(Opcodes.INVOKESTATIC, + "org/perlonjava/runtime/runtimetypes/MyVarCleanupStack", + "pushMark", "()I", false); + mv.visitVarInsn(Opcodes.ISTORE, loopLabels.cleanupMarkSlot); // Visit the loop body if (needsReturnValue) { diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java b/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java index dd09d1eee6..f8453901d8 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java @@ -779,6 +779,8 @@ static void handleApplyOperator(EmitterVisitor emitterVisitor, BinaryOperatorNod emitterVisitor.ctx.javaClassInfo.releaseSpillSlot(); } + emitTaggedControlFlowHandling(emitterVisitor); + if (emitterVisitor.ctx.contextType == RuntimeContextType.SCALAR || emitterVisitor.ctx.contextType == RuntimeContextType.LVALUE) { mv.visitMethodInsn(Opcodes.INVOKEVIRTUAL, @@ -1195,6 +1197,72 @@ private static void emitControlFlowCheck(EmitterContext ctx) { // If not inside a loop, don't check registry (result stays on stack) } + /** Emits the ordinary tagged-return dispatcher for a result on the stack. */ + private static void emitTaggedControlFlowHandling(EmitterVisitor emitterVisitor) { + MethodVisitor mv = emitterVisitor.ctx.mv; + if (!ENABLE_CONTROL_FLOW_CHECKS + || emitterVisitor.ctx.javaClassInfo.returnLabel == null + || emitterVisitor.ctx.javaClassInfo.controlFlowTempSlot < 0) { + return; + } + + String loopStateSignature = emitterVisitor.ctx.javaClassInfo.getLoopStateSignature(); + Label blockDispatcher = + emitterVisitor.ctx.javaClassInfo.blockDispatcherLabels.get(loopStateSignature); + boolean isFirstUse = blockDispatcher == null; + if (isFirstUse) { + blockDispatcher = new Label(); + emitterVisitor.ctx.javaClassInfo.blockDispatcherLabels.put( + loopStateSignature, blockDispatcher); + } + + Label notControlFlow = new Label(); + JavaClassInfo.SpillRef[] baseSpills = new JavaClassInfo.SpillRef[0]; + mv.visitVarInsn( + Opcodes.ASTORE, emitterVisitor.ctx.javaClassInfo.controlFlowTempSlot); + mv.visitVarInsn( + Opcodes.ALOAD, emitterVisitor.ctx.javaClassInfo.controlFlowTempSlot); + mv.visitMethodInsn( + Opcodes.INVOKEVIRTUAL, + "org/perlonjava/runtime/runtimetypes/RuntimeList", + "isNonLocalGoto", + "()Z", + false); + mv.visitJumpInsn(Opcodes.IFEQ, notControlFlow); + + mv.visitVarInsn( + Opcodes.ALOAD, emitterVisitor.ctx.javaClassInfo.controlFlowTempSlot); + emitterVisitor.pushCallContext(); + mv.visitMethodInsn( + Opcodes.INVOKESTATIC, + "org/perlonjava/runtime/runtimetypes/RuntimeCode", + "resolveTailCalls", + "(Lorg/perlonjava/runtime/runtimetypes/RuntimeList;I)Lorg/perlonjava/runtime/runtimetypes/RuntimeList;", + false); + mv.visitVarInsn( + Opcodes.ASTORE, emitterVisitor.ctx.javaClassInfo.controlFlowTempSlot); + mv.visitVarInsn( + Opcodes.ALOAD, emitterVisitor.ctx.javaClassInfo.controlFlowTempSlot); + mv.visitMethodInsn( + Opcodes.INVOKEVIRTUAL, + "org/perlonjava/runtime/runtimetypes/RuntimeList", + "isNonLocalGoto", + "()Z", + false); + mv.visitJumpInsn(Opcodes.IFEQ, notControlFlow); + mv.visitJumpInsn(Opcodes.GOTO, blockDispatcher); + + mv.visitLabel(notControlFlow); + mv.visitVarInsn( + Opcodes.ALOAD, emitterVisitor.ctx.javaClassInfo.controlFlowTempSlot); + if (isFirstUse) { + Label skipDispatcher = new Label(); + mv.visitJumpInsn(Opcodes.GOTO, skipDispatcher); + emitBlockDispatcher(mv, emitterVisitor, blockDispatcher, baseSpills); + mv.visitLabel(skipDispatcher); + } + } + /** * Emits the block-level dispatcher code that handles control flow for all call sites * with the same visible loop state. @@ -1261,6 +1329,8 @@ static void emitBlockDispatcher(MethodVisitor mv, EmitterVisitor emitterVisitor, mv.visitVarInsn(Opcodes.ILOAD, emitterVisitor.ctx.javaClassInfo.controlFlowActionSlot); mv.visitInsn(Opcodes.ICONST_0); mv.visitJumpInsn(Opcodes.IF_ICMPNE, checkNext); + EmitControlFlow.emitLoopControlScopeCleanupForDispatcher( + emitterVisitor.ctx, loopLabels, true); if (loopLabels.lastLabel == emitterVisitor.ctx.javaClassInfo.returnLabel) { mv.visitJumpInsn(Opcodes.GOTO, propagateToCaller); } else { @@ -1275,6 +1345,8 @@ static void emitBlockDispatcher(MethodVisitor mv, EmitterVisitor emitterVisitor, mv.visitVarInsn(Opcodes.ILOAD, emitterVisitor.ctx.javaClassInfo.controlFlowActionSlot); mv.visitInsn(Opcodes.ICONST_1); mv.visitJumpInsn(Opcodes.IF_ICMPNE, checkRedo); + EmitControlFlow.emitLoopControlScopeCleanupForDispatcher( + emitterVisitor.ctx, loopLabels, false); if (loopLabels.nextLabel == emitterVisitor.ctx.javaClassInfo.returnLabel) { mv.visitJumpInsn(Opcodes.GOTO, propagateToCaller); } else { @@ -1286,6 +1358,8 @@ static void emitBlockDispatcher(MethodVisitor mv, EmitterVisitor emitterVisitor, // if (type == REDO (2)) goto redoLabel mv.visitLabel(checkRedo); + EmitControlFlow.emitLoopControlScopeCleanupForDispatcher( + emitterVisitor.ctx, loopLabels, false); if (loopLabels.redoLabel == emitterVisitor.ctx.javaClassInfo.returnLabel) { mv.visitJumpInsn(Opcodes.GOTO, propagateToCaller); } else { diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitterMethodCreator.java b/src/main/java/org/perlonjava/backend/jvm/EmitterMethodCreator.java index 653a1d86a7..4fe95e34c9 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitterMethodCreator.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitterMethodCreator.java @@ -826,10 +826,16 @@ private static byte[] getBytecodeInternal(EmitterContext ctx, Node ast, boolean "ordinal", "()I", false); + int evalControlFlowTypeSlot = ctx.symbolTable.allocateLocalVariable(); + mv.visitVarInsn(Opcodes.ISTORE, evalControlFlowTypeSlot); + mv.visitVarInsn(Opcodes.ILOAD, evalControlFlowTypeSlot); + mv.visitInsn(Opcodes.ICONST_2); // LAST/NEXT/REDO propagate + mv.visitJumpInsn(Opcodes.IF_ICMPLE, normalReturn); + mv.visitVarInsn(Opcodes.ILOAD, evalControlFlowTypeSlot); mv.visitLdcInsn(5); // RETURN.ordinal() = 5 mv.visitJumpInsn(Opcodes.IF_ICMPEQ, normalReturn); // RETURN → propagate - // For non-RETURN markers (LAST/NEXT/REDO/GOTO), treat as eval failure. + // GOTO and TAILCALL cannot cross an eval-block boundary. mv.visitVarInsn(Opcodes.ALOAD, returnListSlot); mv.visitTypeInsn(Opcodes.CHECKCAST, "org/perlonjava/runtime/runtimetypes/RuntimeControlFlowList"); int msgSlot = ctx.symbolTable.allocateLocalVariable(); @@ -888,6 +894,13 @@ private static byte[] getBytecodeInternal(EmitterContext ctx, Node ast, boolean // This path represents an eval failure (bad goto/other marker), // so $@ must be preserved. mv.visitJumpInsn(Opcodes.GOTO, endCatch); + } else { + // A LAST/NEXT/REDO/GOTO marker abandons this Perl call + // frame even though it is represented as a return value, + // not a Java exception. Clean every lexical while the + // completed method symbol table and its JVM locals are + // still available, before the caller resumes the target. + EmitStatement.emitLoopControlScopeExit(ctx, 0); } // For non-eval subs: marker just propagates (falls through to return) diff --git a/src/main/java/org/perlonjava/backend/jvm/LoopLabels.java b/src/main/java/org/perlonjava/backend/jvm/LoopLabels.java index a8b5dc67ab..982d69bc6b 100644 --- a/src/main/java/org/perlonjava/backend/jvm/LoopLabels.java +++ b/src/main/java/org/perlonjava/backend/jvm/LoopLabels.java @@ -42,6 +42,16 @@ public class LoopLabels { */ public int cleanupScopeIndex = -1; + /** + * Lexical scope lower bound for {@code last}. Exiting a labeled block also + * tears down variables declared by the block itself, while next/redo keep + * that outer loop scope alive for the following iteration. + */ + public int lastCleanupScopeIndex = -1; + + /** JVM local containing the MyVarCleanupStack mark for this loop body. */ + public int cleanupMarkSlot = -1; + /** * The context type in which this loop operates */ diff --git a/src/main/java/org/perlonjava/runtime/operators/StringOperators.java b/src/main/java/org/perlonjava/runtime/operators/StringOperators.java index 4f7e145644..eb2c2ba451 100644 --- a/src/main/java/org/perlonjava/runtime/operators/StringOperators.java +++ b/src/main/java/org/perlonjava/runtime/operators/StringOperators.java @@ -511,8 +511,20 @@ public static RuntimeScalar stringConcat(RuntimeScalar runtimeScalar, RuntimeSca RuntimeScalar overloaded = tryStringConcatOverload(runtimeScalar, b); if (overloaded != null) return overloaded; - RuntimeScalar aResolved = stringifyForStringContext(resolveTiedStringOperand(runtimeScalar)); - RuntimeScalar bResolved = stringifyForStringContext(resolveTiedStringOperand(b)); + RuntimeScalar aResolved = resolveTiedStringOperand(runtimeScalar); + RuntimeScalar bResolved = resolveTiedStringOperand(b); + // Most callers select the warning-aware concat at compile time. Eval + // STRING can change ${^WARNING_BITS} from a BEGIN block, after the + // enclosing call site was compiled, so retain a cheap undef-only + // runtime guard here as well. WarnDie performs the lexical category + // check and dispatches a localized __WARN__ handler when applicable. + if (!aResolved.getDefinedBoolean() || !bResolved.getDefinedBoolean()) { + WarnDie.warnWithCategory( + new RuntimeScalar("Use of uninitialized value in concatenation (.)"), + RuntimeScalarCache.scalarEmptyString, "uninitialized"); + } + aResolved = stringifyForStringContext(aResolved); + bResolved = stringifyForStringContext(bResolved); String bStr = bResolved.toString(); String aStr = aResolved.toString(); diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/NetSSLeay.java b/src/main/java/org/perlonjava/runtime/perlmodule/NetSSLeay.java index cf9635b8ad..2ff9919b3c 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/NetSSLeay.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/NetSSLeay.java @@ -268,6 +268,7 @@ public static final class State { final Map asn1Times = new java.util.concurrent.ConcurrentHashMap<>(); final Map sslContexts = new java.util.concurrent.ConcurrentHashMap<>(); final Map sslStates = new java.util.concurrent.ConcurrentHashMap<>(); + final Map sslSessions = new java.util.concurrent.ConcurrentHashMap<>(); final Map evpKeys = new java.util.concurrent.ConcurrentHashMap<>(); final Map x509Certificates = new java.util.concurrent.ConcurrentHashMap<>(); final Map x509Names = new java.util.concurrent.ConcurrentHashMap<>(); @@ -299,6 +300,15 @@ private static State state() { return PerlRuntime.current().netSslState; } + /** Capture the runtime that owns a callback stored on a native-style handle. */ + static RuntimeScalar bindNativeCallback(RuntimeScalar callback) { + if (callback == null || callback.type != RuntimeScalarType.CODE + || !(callback.value instanceof RuntimeCode code)) { + return callback; + } + return new RuntimeScalar(code.bindCallbackTo(PerlRuntime.current())); + } + private static final class CurrentRuntimeMap extends AbstractMap { private final Function> selector; @@ -330,6 +340,8 @@ private Map delegate() { private static final Map ASN1_TIME_HANDLES = new CurrentRuntimeMap<>(s -> s.asn1Times); private static final Map CTX_HANDLES = new CurrentRuntimeMap<>(s -> s.sslContexts); private static final Map SSL_HANDLES = new CurrentRuntimeMap<>(s -> s.sslStates); + private static final Map SSL_SESSION_HANDLES = + new CurrentRuntimeMap<>(s -> s.sslSessions); private static final Map EVP_PKEY_HANDLES = new CurrentRuntimeMap<>(s -> s.evpKeys); // X509 handle maps @@ -373,6 +385,7 @@ public static void resetState() { ASN1_TIME_HANDLES.clear(); CTX_HANDLES.clear(); SSL_HANDLES.clear(); + SSL_SESSION_HANDLES.clear(); EVP_PKEY_HANDLES.clear(); X509_HANDLES.clear(); X509_NAME_HANDLES.clear(); @@ -1663,7 +1676,7 @@ public static void initialize() { SslState st = SSL_HANDLES.get(a.get(0).getLong()); if (st != null) { st.verifyMode = (int) a.get(1).getLong(); - if (a.size() >= 3) st.verifyCb = a.get(2).scalar(); + if (a.size() >= 3) st.verifyCb = bindNativeCallback(a.get(2).scalar()); } return new RuntimeScalar().getList(); }); @@ -1802,7 +1815,7 @@ public static void initialize() { if (a.size() < 1) return new RuntimeScalar().getList(); SslCtxState st = CTX_HANDLES.get(a.get(0).getLong()); if (st != null && a.size() >= 2) { - st.infoCallback = a.get(1); + st.infoCallback = bindNativeCallback(a.get(1)); } return new RuntimeScalar().getList(); }); @@ -2625,7 +2638,7 @@ else if ((raw[0] & 0x80) != 0) { SslCtxState st = CTX_HANDLES.get(a.get(0).getLong()); if (st != null) { st.verifyMode = (int) a.get(1).getLong(); - if (a.size() >= 3) st.verifyCb = a.get(2).scalar(); + if (a.size() >= 3) st.verifyCb = bindNativeCallback(a.get(2).scalar()); st.sslContext = null; // force rebuild with new trust settings } return new RuntimeScalar().getList(); @@ -2878,7 +2891,22 @@ else if ((raw[0] & 0x80) != 0) { SslState st = SSL_HANDLES.get(a.size() > 0 ? a.get(0).getLong() : 0); return new RuntimeScalar(st != null ? a.get(0).getLong() : 0).getList(); }); - registerLambda("set_session", (a, c) -> new RuntimeScalar(1).getList()); + registerLambda("SESSION_new", (a, c) -> { + long handle = HANDLE_COUNTER.getAndIncrement(); + SSL_SESSION_HANDLES.put(handle, Boolean.TRUE); + return new RuntimeScalar(handle).getList(); + }); + registerLambda("SESSION_free", (a, c) -> { + if (!a.isEmpty()) SSL_SESSION_HANDLES.remove(a.get(0).getLong()); + return new RuntimeScalar().getList(); + }); + registerLambda("set_session", (a, c) -> { + if (a.size() < 2) return new RuntimeScalar(0).getList(); + return new RuntimeScalar( + SSL_HANDLES.containsKey(a.get(0).getLong()) + && SSL_SESSION_HANDLES.containsKey(a.get(1).getLong()) ? 1 : 0) + .getList(); + }); registerLambda("session_reused", (a, c) -> new RuntimeScalar(0).getList()); registerLambda("set_msg_callback", (a, c) -> new RuntimeScalar(1).getList()); registerLambda("set_post_handshake_auth", (a, c) -> new RuntimeScalar().getList()); @@ -4913,7 +4941,7 @@ public static RuntimeList CTX_set_default_passwd_cb(RuntimeArray args, int ctx) long ctxHandle = args.get(0).getLong(); SslCtxState ctxState = CTX_HANDLES.get(ctxHandle); if (ctxState == null) return new RuntimeScalar().getList(); - ctxState.passwdCb = args.get(1); + ctxState.passwdCb = bindNativeCallback(args.get(1)); return new RuntimeScalar().getList(); } @@ -4944,7 +4972,7 @@ public static RuntimeList set_default_passwd_cb(RuntimeArray args, int ctx) { long sslHandle = args.get(0).getLong(); SslState ssl = SSL_HANDLES.get(sslHandle); if (ssl == null) return new RuntimeScalar().getList(); - ssl.passwdCb = args.get(1); + ssl.passwdCb = bindNativeCallback(args.get(1)); return new RuntimeScalar().getList(); } diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/Threads.java b/src/main/java/org/perlonjava/runtime/perlmodule/Threads.java index 3e6aca55a4..2c08cf5efd 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/Threads.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/Threads.java @@ -94,6 +94,10 @@ public static RuntimeList _list(RuntimeArray args, int ctx) { int filter = args.isEmpty() ? 0 : args.get(0).getInt(); RuntimeList result = new RuntimeList(); for (PerlThreadControlBlock thread : PerlRuntime.current().threadRegistry().snapshot()) { + // Detached threads are no longer application-owned and Perl never + // returns them from list(), even while their Java carrier is still + // winding down. + if (thread.isDetached()) continue; if (filter == 1 && !thread.isRunning()) continue; if (filter == 2 && !thread.isJoinable()) continue; result.add(threadObject(thread.id(), thread)); diff --git a/src/main/java/org/perlonjava/runtime/regex/ExtendedCharClass.java b/src/main/java/org/perlonjava/runtime/regex/ExtendedCharClass.java index 37bd353b1f..f4b32136aa 100644 --- a/src/main/java/org/perlonjava/runtime/regex/ExtendedCharClass.java +++ b/src/main/java/org/perlonjava/runtime/regex/ExtendedCharClass.java @@ -735,7 +735,8 @@ private static String processCharacterClass(String charClass) { if (end != -1) { String property = content.substring(i + 3, end); boolean negated = (next == 'P'); - String translated = UnicodeResolver.translateUnicodeProperty(property, negated); + String translated = UnicodeResolver.translateUnicodeProperty( + property, negated); // Unwrap if necessary if (translated.startsWith("[") && translated.endsWith("]")) { diff --git a/src/main/java/org/perlonjava/runtime/regex/RegexPreprocessorHelper.java b/src/main/java/org/perlonjava/runtime/regex/RegexPreprocessorHelper.java index ff5ce47766..4269e57a93 100644 --- a/src/main/java/org/perlonjava/runtime/regex/RegexPreprocessorHelper.java +++ b/src/main/java/org/perlonjava/runtime/regex/RegexPreprocessorHelper.java @@ -330,7 +330,8 @@ static int handleEscapeSequences(String s, StringBuilder sb, int c, int offset, boolean negated = (nextChar == 'P'); String property = Character.toString(s.charAt(offset + 1)); try { - String translatedProperty = translateUnicodeProperty(property, negated); + String translatedProperty = UnicodeResolver.translateUnicodeProperty( + property, negated, regexFlags.isCaseInsensitive()); sb.setLength(sb.length() - 1); // Remove the backslash sb.append("(?-i:").append(translatedProperty).append(")"); return offset + 1; @@ -345,7 +346,8 @@ static int handleEscapeSequences(String s, StringBuilder sb, int c, int offset, if (endBrace != -1) { String property = s.substring(offset, endBrace).trim(); try { - String translatedProperty = translateUnicodeProperty(property, negated); + String translatedProperty = UnicodeResolver.translateUnicodeProperty( + property, negated, regexFlags.isCaseInsensitive()); sb.setLength(sb.length() - 1); // Remove the backslash // Wrap in (?-i:...) to protect Unicode property from /i flag. // Unicode properties should match by codepoint, not case-folded value. @@ -776,7 +778,8 @@ static int handleRegexCharacterClassEscape(int offset, String s, StringBuilder s if (pEndBrace != -1) { String property = s.substring(offset + 2, pEndBrace).trim(); try { - String translatedProperty = UnicodeResolver.translateUnicodeProperty(property, pNegated); + String translatedProperty = UnicodeResolver.translateUnicodeProperty( + property, pNegated); // Remove the backslash that was already appended sb.setLength(sb.length() - 1); // Append the translated property (e.g., a character class pattern from ICU4J) diff --git a/src/main/java/org/perlonjava/runtime/regex/RuntimeRegex.java b/src/main/java/org/perlonjava/runtime/regex/RuntimeRegex.java index 49df35708e..52c081f17f 100644 --- a/src/main/java/org/perlonjava/runtime/regex/RuntimeRegex.java +++ b/src/main/java/org/perlonjava/runtime/regex/RuntimeRegex.java @@ -334,7 +334,20 @@ private void emitWarningsOnUse() { * @return A RuntimeRegex object. * @throws IllegalStateException if regex compilation fails. */ - public static synchronized RuntimeRegex compile(String patternString, String modifiers) { + public static RuntimeRegex compile(String patternString, String modifiers) { + // Dynamic/interpolated qr// compilation can begin during ordinary + // execution, outside the Perl compiler lock. User-defined Unicode + // properties execute arbitrary Perl and may block, so resolve them + // before entering the process-wide regex compiler monitor. Calls made + // during source compilation remain deferred by UnicodeResolver. + RegexFlags preloadFlags = fromModifiers(modifiers, patternString); + UnicodeResolver.preloadUserDefinedProperties( + patternString, preloadFlags.isCaseInsensitive()); + return compileSynchronized(patternString, modifiers); + } + + private static synchronized RuntimeRegex compileSynchronized( + String patternString, String modifiers) { // Debug logging if (DEBUG_REGEX) { System.err.println("RuntimeRegex.compile: pattern=" + patternString + " modifiers=" + modifiers); @@ -557,7 +570,8 @@ private static RuntimeRegex ensureCompiledForRuntime(RuntimeRegex regex) { // User property subs can execute arbitrary Perl and block. Resolve them // before compile() takes its process-wide monitor; only simultaneous // definitions of the same property coordinate in PerlThreadRegistry. - UnicodeResolver.preloadUserDefinedProperties(regex.patternString); + UnicodeResolver.preloadUserDefinedProperties(regex.patternString, + regex.regexFlags != null && regex.regexFlags.isCaseInsensitive()); RuntimeRegex recompiled = compile(regex.patternString, regex.regexFlags == null ? "" : regex.regexFlags.toFlagString()); regex.pattern = recompiled.pattern; regex.patternUnicode = recompiled.patternUnicode; diff --git a/src/main/java/org/perlonjava/runtime/regex/UnicodeResolver.java b/src/main/java/org/perlonjava/runtime/regex/UnicodeResolver.java index d7801a606d..06ea2dbad6 100644 --- a/src/main/java/org/perlonjava/runtime/regex/UnicodeResolver.java +++ b/src/main/java/org/perlonjava/runtime/regex/UnicodeResolver.java @@ -21,6 +21,10 @@ private static Map userPropertyCache() { return PerlRuntime.current().regexState().userUnicodePropertyCache; } + private static String userPropertyCacheKey(String subName, boolean caseInsensitive) { + return subName + (caseInsensitive ? "\u0000i" : "\u0000s"); + } + /** * Retrieves the Unicode code point for a given character name. * Supports: @@ -287,7 +291,7 @@ private static UnicodeSet resolvePropertyReferenceAsSet(String propRef, Set recursionSet) { + private static String tryUserDefinedProperty( + String property, Set recursionSet, boolean caseInsensitive) { // Add to recursion set Set newRecursionSet = new HashSet<>(recursionSet); newRecursionSet.add(property); @@ -452,8 +457,9 @@ private static String tryUserDefinedProperty(String property, Set recurs } // Check cache first — Perl only calls user-defined property subs once - if (userPropertyCache().containsKey(subName)) { - return userPropertyCache().get(subName); + String cacheKey = userPropertyCacheKey(subName, caseInsensitive); + if (userPropertyCache().containsKey(cacheKey)) { + return userPropertyCache().get(cacheKey); } // A property sub is arbitrary Perl and may block. Regex parsing occurs @@ -472,12 +478,14 @@ private static String tryUserDefinedProperty(String property, Set recurs RuntimeScalar codeRef = GlobalVariable.getGlobalCodeRef(subName); final String resolvedSubName = subName; + final String coordinationKey = cacheKey; try { String parsed = PerlRuntime.current().threadRegistry() - .resolveUserUnicodeProperty(resolvedSubName, + .resolveUserUnicodeProperty(coordinationKey, () -> resolveUserDefinedProperty( - codeRef, resolvedSubName, newRecursionSet)); - userPropertyCache().put(subName, parsed); + codeRef, resolvedSubName, newRecursionSet, + caseInsensitive)); + userPropertyCache().put(cacheKey, parsed); return parsed; } catch (PerlCompilerException e) { // Re-throw Perl exceptions (like die in IsDeath) @@ -496,10 +504,13 @@ private static String tryUserDefinedProperty(String property, Set recurs } private static String resolveUserDefinedProperty(RuntimeScalar codeRef, String subName, - Set recursionSet) { + Set recursionSet, + boolean caseInsensitive) { try { - // Call the subroutine with an empty argument list - RuntimeArray args = new RuntimeArray(); + // Perl passes one false/true argument for case-sensitive/folded + // expansion. A user property may intentionally return distinct + // definitions for the two modes. + RuntimeArray args = new RuntimeArray(new RuntimeScalar(caseInsensitive ? 1 : 0)); RuntimeList result = RuntimeCode.apply(codeRef, args, RuntimeContextType.SCALAR); if (result.elements.isEmpty()) { @@ -532,7 +543,7 @@ private static String resolveUserDefinedProperty(RuntimeScalar codeRef, String s * regex compiler. Property subs are arbitrary Perl and may block; keeping * them outside that compiler monitor lets unrelated property names proceed. */ - static void preloadUserDefinedProperties(String pattern) { + static void preloadUserDefinedProperties(String pattern, boolean caseInsensitive) { if (pattern == null || pattern.isEmpty()) return; for (int slash = pattern.indexOf('\\'); slash >= 0; @@ -551,17 +562,29 @@ static void preloadUserDefinedProperties(String pattern) { String property = pattern.substring(slash + 3, end).trim(); if (property.startsWith("^")) property = property.substring(1).trim(); if (property.matches("^(.*::)?([Ii][sSNn]).+")) { - translateUnicodeProperty(property, marker == 'P'); + translateUnicodeProperty(property, marker == 'P', new HashSet<>(), + caseInsensitive); } slash = end; } } public static String translateUnicodeProperty(String property, boolean negated) { - return translateUnicodeProperty(property, negated, new HashSet<>()); + return translateUnicodeProperty(property, negated, new HashSet<>(), false); + } + + static String translateUnicodeProperty( + String property, boolean negated, boolean caseInsensitive) { + return translateUnicodeProperty(property, negated, new HashSet<>(), caseInsensitive); } private static String translateUnicodeProperty(String property, boolean negated, Set recursionSet) { + return translateUnicodeProperty(property, negated, recursionSet, false); + } + + private static String translateUnicodeProperty(String property, boolean negated, + Set recursionSet, + boolean caseInsensitive) { try { // Perl accepts a leading caret inside the braces as property // negation: \p{^Latin} is equivalent to \P{Latin}, while @@ -583,7 +606,8 @@ private static String translateUnicodeProperty(String property, boolean negated, // as potentially user-defined, regardless of the character after the prefix // (e.g., Is_q, IsMyProp, InMyBlock all trigger user-defined lookup) if (property.matches("^(.*::)?([Ii][sSNn]).+")) { - String userProp = tryUserDefinedProperty(property, recursionSet); + String userProp = tryUserDefinedProperty( + property, recursionSet, caseInsensitive); if (userProp != null) { return wrapCharClass(userProp, negated); } @@ -770,7 +794,7 @@ private static String translateUnicodeProperty(String property, boolean negated, unicodeSet.applyPropertyAlias("Block", property); } catch (IllegalArgumentException ex2) { // Neither worked - try user-defined property before giving up - String userProp = tryUserDefinedProperty(property, recursionSet); + String userProp = tryUserDefinedProperty(property, recursionSet, false); if (userProp != null) { return wrapCharClass(userProp, negated); } @@ -787,7 +811,8 @@ private static String translateUnicodeProperty(String property, boolean negated, // that should be propagated as-is String message = e.getMessage(); if (message != null && (message.contains("in expansion of") - || message.startsWith("Illegal user-defined property name"))) { + || message.startsWith("Illegal user-defined property name") + || message.startsWith("Timeout waiting for another thread"))) { throw e; } throw new IllegalArgumentException("Invalid or unsupported Unicode property: " + property, e); diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/MortalList.java b/src/main/java/org/perlonjava/runtime/runtimetypes/MortalList.java index e62a94ef34..72465e20e5 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/MortalList.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/MortalList.java @@ -311,6 +311,12 @@ public static void flushDeferredCapturesBeforeEnd() { found = true; } if (found) flush(); + + // Weak-reference leak tracers commonly run from END. Selective + // refcounts can remain inflated by JVM temporaries even after all Perl + // owners have gone away, so clear only referents outside the semantic + // END graph now. Retained captures are cleared by the post-END drain. + WeakRefRegistry.clearBlessedWeakRefsExcept(endReachable); } /** diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/NameNormalizer.java b/src/main/java/org/perlonjava/runtime/runtimetypes/NameNormalizer.java index 8b34feb244..a19081184a 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/NameNormalizer.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/NameNormalizer.java @@ -30,6 +30,15 @@ public static final class State { public State() { blessStrCache.put(0, ""); } + + void snapshotInto(State target) { + target.blessIdCache.clear(); + target.blessIdCache.putAll(blessIdCache); + target.blessStrCache.clear(); + target.blessStrCache.putAll(blessStrCache); + target.currentBlessId = currentBlessId; + target.currentOverloadedBlessId = currentOverloadedBlessId; + } } private static State state() { diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/PerlRuntime.java b/src/main/java/org/perlonjava/runtime/runtimetypes/PerlRuntime.java index 52409de5d0..e5b4e44db5 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/PerlRuntime.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/PerlRuntime.java @@ -309,6 +309,7 @@ private ThreadSnapshot snapshotCloneInternal(PerlThreadRegistry registry, long t PerlRuntime child = new PerlRuntime(registry, threadId); child.defaultPerlThreadStackSize = defaultPerlThreadStackSize; child.defaultPerlThreadExitOnly = defaultPerlThreadExitOnly; + nameNormalizerState.snapshotInto(child.nameNormalizerState); RuntimeGraphCloner cloner = new RuntimeGraphCloner(this, child, skipped); try (Binding ignored = bind()) { globalState.snapshotInto(child.globalState, cloner); diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/PerlThreadControlBlock.java b/src/main/java/org/perlonjava/runtime/runtimetypes/PerlThreadControlBlock.java index a09c7f3066..2beb7dc56a 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/PerlThreadControlBlock.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/PerlThreadControlBlock.java @@ -24,8 +24,10 @@ public record Completion(RuntimeBase value, Throwable error) {} private final EntryPoint entryPoint; private final int context; private final long stackSize; + private final RuntimeIO parentErrorOutput; private final CountDownLatch finished = new CountDownLatch(1); private final AtomicBoolean joinClaimed = new AtomicBoolean(); + private final AtomicBoolean abnormalTerminationReported = new AtomicBoolean(); private volatile State state = State.NEW; private volatile RuntimeBase result; private volatile Throwable error; @@ -41,6 +43,7 @@ private PerlThreadControlBlock(PerlRuntime parent, EntryPoint entryPoint) { this.childRuntime = parent.snapshotCloneForThread(registry, id).runtime(); this.context = RuntimeContextType.SCALAR; this.stackSize = parent.defaultPerlThreadStackSize(); + this.parentErrorOutput = RuntimeIO.getStderr(); childRuntime.setPerlThreadContext(context); childRuntime.setPerlThreadStackSize(stackSize); childRuntime.setPerlThreadExitOnly(parent.defaultPerlThreadExitOnly()); @@ -57,6 +60,7 @@ private PerlThreadControlBlock(PerlRuntime parent, RuntimeScalar code, RuntimeAr this.childRuntime = snapshot.runtime(); this.context = context; this.stackSize = stackSize; + this.parentErrorOutput = RuntimeIO.getStderr(); childRuntime.setPerlThreadContext(context); childRuntime.setPerlThreadStackSize(stackSize); childRuntime.setPerlThreadExitOnly(exitOnly); @@ -128,6 +132,7 @@ private void run() { } finally { finished.countDown(); if (detached) { + reportAbnormalTermination(); registry.remove(this); } } @@ -166,6 +171,7 @@ public synchronized void detach() { detached = true; if (finished.getCount() == 0) { state = State.DETACHED; + reportAbnormalTermination(); registry.remove(this); } } @@ -192,6 +198,14 @@ public void signal(String signal) { if (javaThread != null) javaThread.interrupt(); } + private void reportAbnormalTermination() { + Throwable failure = error; + if (failure == null || !abnormalTerminationReported.compareAndSet(false, true)) return; + String message = failure.getMessage(); + if (message == null || message.isEmpty()) message = failure.toString(); + parentErrorOutput.write("Thread " + id + " terminated abnormally: " + message + "\n"); + } + private record Outcome(RuntimeBase value, Throwable error) {} private static PerlThreadExitException findThreadExit(Throwable thrown) { diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/PerlThreadExecutionPolicy.java b/src/main/java/org/perlonjava/runtime/runtimetypes/PerlThreadExecutionPolicy.java index b65ccd3728..6fbe85709c 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/PerlThreadExecutionPolicy.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/PerlThreadExecutionPolicy.java @@ -54,7 +54,10 @@ public Thread unstarted(long id, long stackSize, Runnable task) { } return Thread.ofVirtual().name(name).unstarted(task); } - Thread.Builder.OfPlatform builder = Thread.ofPlatform().name(name); + // Perl terminates detached children when the main interpreter exits. + // A Java daemon carrier preserves that process-lifecycle rule; attached + // children remain application-owned through the Perl registry/join API. + Thread.Builder.OfPlatform builder = Thread.ofPlatform().name(name).daemon(true); if (stackSize != 0) builder = builder.stackSize(stackSize); return builder.unstarted(task); } diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/PerlThreadRegistry.java b/src/main/java/org/perlonjava/runtime/runtimetypes/PerlThreadRegistry.java index 57d1f5fe92..0759e27d0a 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/PerlThreadRegistry.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/PerlThreadRegistry.java @@ -29,7 +29,12 @@ void register(PerlThreadControlBlock thread) { } void remove(PerlThreadControlBlock thread) { - if (threads.remove(thread.id(), thread)) terminalThreads.put(thread.id(), thread); + if (threads.get(thread.id()) != thread) return; + // Publish the retained terminal record before withdrawing the active + // record. Readers of getKnown() must never observe a gap between the + // two maps while a child completes, joins, or detaches. + terminalThreads.put(thread.id(), thread); + if (!threads.remove(thread.id(), thread)) terminalThreads.remove(thread.id(), thread); } public PerlThreadControlBlock get(long id) { @@ -94,6 +99,8 @@ public String resolveUserUnicodeProperty(String name, Supplier resolver) } private static String shortPropertyName(String name) { + int modeSeparator = name.indexOf('\0'); + if (modeSeparator >= 0) name = name.substring(0, modeSeparator); int separator = name.lastIndexOf("::"); return separator >= 0 ? name.substring(separator + 2) : name; } diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java index bc920a8b36..71cf9004ff 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java @@ -2052,6 +2052,12 @@ public static Class evalStringHelper(RuntimeScalar code, String evalTag, Obje // IMPORTANT: The parseSymbolTable starts with the captured flags so that // the eval code is parsed with the correct feature/strict/warning context ScopedSymbolTable parseSymbolTable = capturedSymbolTable.snapShot(); + // BEGIN blocks execute while eval STRING is parsed. Point the + // special-variable pragma facade at this eval's private scope so + // assignments to $^H/${^WARNING_BITS} affect the generated body, + // not the caller's saved compiler scope. The outer finally restores + // the previous scope on every success/cache/error path. + setCurrentScope(parseSymbolTable); // CRITICAL: Pre-create aliases for captured variables BEFORE parsing // This allows BEGIN blocks in the eval string to access outer lexical variables. @@ -4266,6 +4272,18 @@ private static java.util.ArrayList extractJavaClassNames(Throwable t) { // DBIC test runs (t/60core.t, t/96_is_deteministic_value.t, // t/cdbi/68-inflate_has_a.t). public static RuntimeList apply(RuntimeScalar runtimeScalar, RuntimeArray a, int callContext) { + // Java/native callback entry points normally dispatch through this + // static facade. Bind before any warning/caller/cleanup facade is + // consulted; binding only inside RuntimeCode.apply(instance) is too + // late for a callback arriving on an otherwise unbound provider thread. + if (runtimeScalar != null && runtimeScalar.type == RuntimeScalarType.CODE + && runtimeScalar.value instanceof RuntimeCode callback + && callback.boundRuntime != null + && PerlRuntime.currentOrNull() != callback.boundRuntime) { + try (PerlRuntime.Binding ignored = callback.boundRuntime.bind()) { + return apply(runtimeScalar, a, callContext); + } + } // NOTE: flush() was removed from here. Return values from nested calls // (e.g., receiver(coerce => quote_sub(...))) may have pending refCount // decrements from their scope exits. Flushing here would decrement them @@ -4420,6 +4438,10 @@ public static RuntimeList apply(RuntimeScalar runtimeScalar, RuntimeArray a, int // invocation, so enterCall/exitCall depth tracking is // not re-entered (no inTailCallTrampoline bump needed). } else { + if (result instanceof RuntimeControlFlowList) { + MyVarCleanupStack.unwindTo(cleanupMark); + MortalList.flush(); + } // Mortal-ize blessed refs with refCount==0 in void-context calls. // These are objects that were created but never stored in a named // variable (e.g., discarded return values from constructors). diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/SharedPerlStorage.java b/src/main/java/org/perlonjava/runtime/runtimetypes/SharedPerlStorage.java index d233dacd8a..10015474a0 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/SharedPerlStorage.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/SharedPerlStorage.java @@ -94,6 +94,10 @@ public static RuntimeBase share(RuntimeScalar reference) { /** Mark declaration storage directly, without manufacturing a reference wrapper. */ public static RuntimeBase shareValue(RuntimeBase root) { if (root == null) throw new IllegalArgumentException("share requires a scalar, array, or hash reference"); + // Validate the complete graph before publishing any shared markers. A + // late blessed/tied/CODE node must not leave the prefix of the graph + // shared after share() reports failure. + validateGraph(root, Collections.newSetFromMap(new IdentityHashMap<>())); markGraph(root, Collections.newSetFromMap(new IdentityHashMap<>())); return root; } @@ -244,35 +248,53 @@ private static RuntimeBase requireShared(RuntimeScalar reference, String operati return root; } - private static void markGraph(RuntimeBase value, Set seen) { + private static void validateGraph(RuntimeBase value, Set seen) { if (value == null || !seen.add(value)) return; - if (value.blessId != 0) throw new IllegalArgumentException("Sharing blessed values is not supported"); + if (value.blessId != 0) { + throw new IllegalArgumentException("Sharing blessed values is not supported"); + } if (value instanceof RuntimeScalar scalar) { if (scalar.type == RuntimeScalarType.TIED_SCALAR) { throw new IllegalArgumentException("Sharing tied values is not supported"); } - scalar.threadShared = true; - if (scalar.value instanceof RuntimeBase nested) markGraph(nested, seen); + if (scalar.value instanceof RuntimeBase nested) validateGraph(nested, seen); return; } if (value instanceof RuntimeArray array) { if (array.type != RuntimeArray.PLAIN_ARRAY) { throw new IllegalArgumentException("Sharing tied arrays is not supported"); } - for (RuntimeScalar element : array.elements) markGraph(element, seen); - array.elements = Collections.synchronizedList(array.elements); - array.threadShared = true; + for (RuntimeScalar element : array.elements) validateGraph(element, seen); return; } if (value instanceof RuntimeHash hash) { if (hash.type != RuntimeHash.PLAIN_HASH) { throw new IllegalArgumentException("Sharing tied hashes is not supported"); } + for (RuntimeScalar element : hash.elements.values()) validateGraph(element, seen); + return; + } + throw new IllegalArgumentException("Unsupported shared value type " + value.getClass().getName()); + } + + private static void markGraph(RuntimeBase value, Set seen) { + if (value == null || !seen.add(value)) return; + if (value instanceof RuntimeScalar scalar) { + scalar.threadShared = true; + if (scalar.value instanceof RuntimeBase nested) markGraph(nested, seen); + return; + } + if (value instanceof RuntimeArray array) { + for (RuntimeScalar element : array.elements) markGraph(element, seen); + array.elements = Collections.synchronizedList(array.elements); + array.threadShared = true; + return; + } + if (value instanceof RuntimeHash hash) { for (RuntimeScalar element : hash.elements.values()) markGraph(element, seen); hash.elements = Collections.synchronizedMap(hash.elements); hash.threadShared = true; return; } - throw new IllegalArgumentException("Unsupported shared value type " + value.getClass().getName()); } } diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/WeakRefRegistry.java b/src/main/java/org/perlonjava/runtime/runtimetypes/WeakRefRegistry.java index c4b31d41ea..1b262e20eb 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/WeakRefRegistry.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/WeakRefRegistry.java @@ -380,11 +380,22 @@ public static java.util.List snapshotWeakRefReferents() { } public static void clearAllBlessedWeakRefs() { + clearBlessedWeakRefsExcept(java.util.Collections.emptySet()); + } + + /** + * Clear weak references whose referents cannot be observed by END code. + * This is the pre-END counterpart to {@link #clearAllBlessedWeakRefs()}: + * genuine END captures remain intact, while stale selective-refcount + * owners do not make leak tracers report objects that Perl has released. + */ + public static void clearBlessedWeakRefsExcept(Set retained) { // Snapshot the keys to avoid ConcurrentModificationException, // since clearWeakRefsTo modifies referentToWeakRefs. java.util.List referents = new java.util.ArrayList<>(state().referentToWeakRefs.keySet()); for (RuntimeBase referent : referents) { + if (retained.contains(referent)) continue; if (referent instanceof RuntimeCode) continue; // Phase H3: skip unblessed containers (ARRAY/HASH) at pre-END // time. Sub::Defer's $deferred_info and Sub::Quote's diff --git a/src/main/perl/lib/Class/XSAccessor.pm b/src/main/perl/lib/Class/XSAccessor.pm index a18d394865..57f4b2d97b 100644 --- a/src/main/perl/lib/Class/XSAccessor.pm +++ b/src/main/perl/lib/Class/XSAccessor.pm @@ -5,6 +5,7 @@ use strict; use warnings; use Carp qw(croak); use Scalar::Util qw(refaddr reftype); +use Sub::Util (); use Class::XSAccessor::Heavy; our $VERSION = '1.19'; @@ -129,6 +130,7 @@ sub _check_hash_invocant { sub _install { my ($name, $code) = @_; + $code = Sub::Util::set_subname($name, $code); $_is_emulated_xsub{refaddr($code)} = 1; no strict 'refs'; no warnings 'redefine'; diff --git a/src/main/perl/lib/Plack/Handler/Netty.pm b/src/main/perl/lib/Plack/Handler/Netty.pm index bc641630d1..af4d2c5303 100644 --- a/src/main/perl/lib/Plack/Handler/Netty.pm +++ b/src/main/perl/lib/Plack/Handler/Netty.pm @@ -148,13 +148,15 @@ This is 2-6x faster than typical pure Perl PSGI servers (Starman, Gazelle, Twigg =head2 Concurrency Model This handler uses Netty's async I/O to handle multiple concurrent connections -on a B. This design choice is intentional: +through one captured PSGI application runtime. This design choice is +intentional: =over 4 -=item * PerlOnJava does not currently support threads or fork() +=item * PerlOnJava supports isolated ithreads, but one captured PSGI runtime is +not concurrently callable merely because ithreads are available -=item * Single-threaded async I/O avoids all thread-safety issues +=item * One application event loop avoids concurrent calls into that runtime =item * I/O-bound applications (most web apps) work efficiently diff --git a/src/main/perl/lib/TAP/Parser/Iterator/Process.pm b/src/main/perl/lib/TAP/Parser/Iterator/Process.pm index 027640a3f8..e916524f90 100644 --- a/src/main/perl/lib/TAP/Parser/Iterator/Process.pm +++ b/src/main/perl/lib/TAP/Parser/Iterator/Process.pm @@ -200,9 +200,13 @@ sub _initialize { $self->{chunk_size} = $chunk_size; if ( my $teardown = delete $args->{teardown} ) { - $self->{teardown} = sub { - $teardown->(@command); - }; + # The Perl source handler uses setup/teardown to expose its -I paths + # through PERL5LIB while the child is spawned. The child has inherited + # that environment once open3() returns, so restore the parent now. + # Deferring restoration until child exit lets parallel TAP jobs unwind + # overlapping environment snapshots out of order and gives later tests + # a contaminated library path. + $teardown->(@command); } return $self; @@ -425,4 +429,3 @@ L, L, =cut - diff --git a/src/test/java/org/perlonjava/runtime/perlmodule/NetSSLeayRuntimeOwnershipTest.java b/src/test/java/org/perlonjava/runtime/perlmodule/NetSSLeayRuntimeOwnershipTest.java new file mode 100644 index 0000000000..78b5d180ac --- /dev/null +++ b/src/test/java/org/perlonjava/runtime/perlmodule/NetSSLeayRuntimeOwnershipTest.java @@ -0,0 +1,61 @@ +package org.perlonjava.runtime.perlmodule; + +import org.junit.jupiter.api.Tag; +import org.junit.jupiter.api.Test; +import org.perlonjava.runtime.runtimetypes.PerlRuntime; +import org.perlonjava.runtime.runtimetypes.RuntimeArray; +import org.perlonjava.runtime.runtimetypes.RuntimeCode; +import org.perlonjava.runtime.runtimetypes.RuntimeContextType; +import org.perlonjava.runtime.runtimetypes.RuntimeScalar; + +import java.util.concurrent.FutureTask; +import java.util.concurrent.TimeUnit; + +import static org.junit.jupiter.api.Assertions.assertEquals; +import static org.junit.jupiter.api.Assertions.assertFalse; +import static org.junit.jupiter.api.Assertions.assertNull; +import static org.junit.jupiter.api.Assertions.assertSame; + +@Tag("unit") +class NetSSLeayRuntimeOwnershipTest { + @Test + void handleRegistriesAreRuntimeOwned() { + PerlRuntime first = new PerlRuntime(); + PerlRuntime second = new PerlRuntime(); + + first.netSslState.providerHandles.put(41L, "first"); + second.netSslState.providerHandles.put(41L, "second"); + + assertEquals("first", first.netSslState.providerHandles.get(41L)); + assertEquals("second", second.netSslState.providerHandles.get(41L)); + first.netSslState.providerHandles.remove(41L); + assertFalse(first.netSslState.providerHandles.containsKey(41L)); + assertEquals("second", second.netSslState.providerHandles.get(41L)); + } + + @Test + void storedNativeCallbackRestoresItsOwningRuntimeOnForeignThread() throws Exception { + PerlRuntime owner = new PerlRuntime(); + RuntimeScalar callback; + try (PerlRuntime.Binding ignored = owner.bind()) { + RuntimeCode code = new RuntimeCode((args, context) -> { + assertSame(owner, PerlRuntime.current()); + return new RuntimeScalar(42).getList(); + }, null); + callback = NetSSLeay.bindNativeCallback(new RuntimeScalar(code)); + } + + FutureTask task = new FutureTask<>(() -> { + assertNull(PerlRuntime.currentOrNull()); + int result = RuntimeCode.apply(callback, new RuntimeArray(), + RuntimeContextType.SCALAR).scalar().getInt(); + assertNull(PerlRuntime.currentOrNull()); + return result; + }); + Thread worker = Thread.ofPlatform().name("netssleay-callback-owner").unstarted(task); + worker.start(); + assertEquals(42, task.get(10, TimeUnit.SECONDS)); + worker.join(10_000); + assertFalse(worker.isAlive()); + } +} diff --git a/src/test/java/org/perlonjava/runtime/runtimetypes/NameNormalizerThreadSnapshotTest.java b/src/test/java/org/perlonjava/runtime/runtimetypes/NameNormalizerThreadSnapshotTest.java new file mode 100644 index 0000000000..8cbdfe77eb --- /dev/null +++ b/src/test/java/org/perlonjava/runtime/runtimetypes/NameNormalizerThreadSnapshotTest.java @@ -0,0 +1,38 @@ +package org.perlonjava.runtime.runtimetypes; + +import org.junit.jupiter.api.Tag; +import org.junit.jupiter.api.Test; + +import static org.junit.jupiter.api.Assertions.assertEquals; + +@Tag("unit") +class NameNormalizerThreadSnapshotTest { + @Test + void snapshotPreservesAuthoritativeClassIdsBeforeGraphCloning() { + PerlRuntime parent = new PerlRuntime().initialize(); + int firstId; + int secondId; + try (PerlRuntime.Binding ignored = parent.bind()) { + firstId = NameNormalizer.getBlessId("Snapshot::First"); + secondId = NameNormalizer.getBlessId("Snapshot::Second"); + RuntimeHash first = new RuntimeHash(); + first.blessId = firstId; + RuntimeHash second = new RuntimeHash(); + second.blessId = secondId; + parent.globalState.scalarValues().put("Snapshot::first", first.createReference()); + parent.globalState.scalarValues().put("Snapshot::second", second.createReference()); + } + + PerlRuntime child = parent.snapshotClone(); + try (PerlRuntime.Binding ignored = child.bind()) { + assertEquals("Snapshot::First", NameNormalizer.getBlessStr(firstId)); + assertEquals("Snapshot::Second", NameNormalizer.getBlessStr(secondId)); + RuntimeBase first = (RuntimeBase) child.globalState.scalarValues() + .get("Snapshot::first").value; + RuntimeBase second = (RuntimeBase) child.globalState.scalarValues() + .get("Snapshot::second").value; + assertEquals("Snapshot::First", NameNormalizer.getBlessStr(first.blessId)); + assertEquals("Snapshot::Second", NameNormalizer.getBlessStr(second.blessId)); + } + } +} diff --git a/src/test/java/org/perlonjava/runtime/runtimetypes/SharedPerlStorageGraphTest.java b/src/test/java/org/perlonjava/runtime/runtimetypes/SharedPerlStorageGraphTest.java new file mode 100644 index 0000000000..dfc551403c --- /dev/null +++ b/src/test/java/org/perlonjava/runtime/runtimetypes/SharedPerlStorageGraphTest.java @@ -0,0 +1,29 @@ +package org.perlonjava.runtime.runtimetypes; + +import org.junit.jupiter.api.Tag; +import org.junit.jupiter.api.Test; + +import static org.junit.jupiter.api.Assertions.assertFalse; +import static org.junit.jupiter.api.Assertions.assertThrows; + +@Tag("unit") +class SharedPerlStorageGraphTest { + @Test + void rejectedNestedNodeDoesNotPartiallyPublishSharedGraph() { + RuntimeHash root = new RuntimeHash(); + RuntimeArray acceptedPrefix = new RuntimeArray(); + acceptedPrefix.push(new RuntimeScalar(1)); + RuntimeHash unsupported = new RuntimeHash(); + unsupported.blessId = 1; + + root.put("accepted", acceptedPrefix.createReference()); + root.put("unsupported", unsupported.createReference()); + + assertThrows(IllegalArgumentException.class, + () -> SharedPerlStorage.shareValue(root)); + assertFalse(root.threadShared); + assertFalse(acceptedPrefix.threadShared); + assertFalse(acceptedPrefix.get(0).threadShared); + assertFalse(unsupported.threadShared); + } +} diff --git a/src/test/resources/unit/class_xsaccessor_named_cv.t b/src/test/resources/unit/class_xsaccessor_named_cv.t new file mode 100644 index 0000000000..2e4aea4fb1 --- /dev/null +++ b/src/test/resources/unit/class_xsaccessor_named_cv.t @@ -0,0 +1,17 @@ +use strict; +use warnings; + +use B (); +use Class::XSAccessor accessors => { value => 'value' }; + +print "1..2\n"; + +my $object = bless { value => 41 }, __PACKAGE__; +print $object->value == 41 + ? "ok 1 - generated accessor remains callable\n" + : "not ok 1 - generated accessor remains callable\n"; + +my $name = B::svref_2object(\&value)->GV->NAME; +print $name eq 'value' + ? "ok 2 - generated accessor has its installed CV name\n" + : "not ok 2 - generated accessor has its installed CV name\n"; diff --git a/src/test/resources/unit/eval_nonlocal_control_flow.t b/src/test/resources/unit/eval_nonlocal_control_flow.t new file mode 100644 index 0000000000..4d72de7173 --- /dev/null +++ b/src/test/resources/unit/eval_nonlocal_control_flow.t @@ -0,0 +1,27 @@ +use strict; +use warnings; + +print "1..2\n"; + +our $destroyed = 0; +{ + package EvalControlGuard; + sub make (&) { bless [$_[0]], __PACKAGE__ } + sub DESTROY { $_[0][0]->() } +} + +my $escaped; +ESCAPE: { + my $guard = EvalControlGuard::make { $main::destroyed++ }; + my $callback = sub { last ESCAPE }; + eval { $callback->() }; + $escaped = 0; +} +$escaped = 1 if !defined $escaped; +print $escaped + ? "ok 1 - labeled last crosses eval and callback boundaries\n" + : "not ok 1 - labeled last crosses eval and callback boundaries\n"; + +print $destroyed == 1 + ? "ok 2 - labeled last tears down the exited lexical scope\n" + : "not ok 2 - labeled last tears down the exited lexical scope\n"; diff --git a/src/test/resources/unit/eval_warning_capture.t b/src/test/resources/unit/eval_warning_capture.t new file mode 100644 index 0000000000..662320f7c6 --- /dev/null +++ b/src/test/resources/unit/eval_warning_capture.t @@ -0,0 +1,24 @@ +use strict; +use warnings; + +print "1..3\n"; +my @warnings; +my $code = eval q{ + use warnings; + no strict 'vars'; + sub { $runtime_warning_value = $runtime_warning_value . "buh"; $runtime_warning_value += 42 } +}; +print defined($code) ? "ok 1 - eval produced a closure\n" + : "not ok 1 - eval produced a closure\n"; + +{ + local $SIG{__WARN__} = sub { push @warnings, shift }; + $code->(); +} + +print grep(/Use of uninitialized value/i, @warnings) + ? "ok 2 - eval closure preserved uninitialized warnings\n" + : "not ok 2 - eval closure preserved uninitialized warnings\n"; +print grep(/isn't numeric in addition/, @warnings) + ? "ok 3 - eval closure dispatched numeric warning locally\n" + : "not ok 3 - eval closure dispatched numeric warning locally\n"; diff --git a/src/test/resources/unit/threads_detached_list.t b/src/test/resources/unit/threads_detached_list.t new file mode 100644 index 0000000000..e57163c00b --- /dev/null +++ b/src/test/resources/unit/threads_detached_list.t @@ -0,0 +1,26 @@ +use strict; +use warnings; +use threads; +use threads::shared; + +print "1..3\n"; +my $number = 0; +sub check { + my ($condition, $name) = @_; + ++$number; + print($condition ? "ok " : "not ok ", $number, " - ", $name, "\n"); +} + +my $release :shared = 0; +my $worker = threads->create(sub { + sleep 0.01 until $release; +}); +$worker->detach; + +check(!grep($_->tid == $worker->tid, threads->list()), + 'default list excludes a live detached thread'); +check(!grep($_->tid == $worker->tid, threads->list(threads::all)), + 'all list excludes a live detached thread'); +check(!grep($_->tid == $worker->tid, threads->list(threads::running)), + 'running list excludes a live detached thread'); +$release = 1; diff --git a/src/test/resources/unit/threads_shared_graphs.t b/src/test/resources/unit/threads_shared_graphs.t new file mode 100644 index 0000000000..c38a6a3a01 --- /dev/null +++ b/src/test/resources/unit/threads_shared_graphs.t @@ -0,0 +1,42 @@ +use strict; +use warnings; +use threads; +use threads::shared; + +print "1..7\n"; +my $number = 0; +sub check { + my ($condition, $name) = @_; + ++$number; + print($condition ? "ok " : "not ok ", $number, " - ", $name, "\n"); +} + +my $source = { count => 1, values => [2] }; + +my $shared = shared_clone($source); +check(is_shared($shared), 'shared_clone marks a nested hash graph'); +check(is_shared($shared->{values}), 'shared_clone marks nested arrays'); +check(is_shared($shared->{count}), 'shared_clone marks nested scalar slots'); + +my $worker = threads->create(sub { + lock(@{$shared->{values}}); + ++$shared->{count}; + push @{$shared->{values}}, 3; + return join(',', @{$shared->{values}}); +}); +check($worker->join eq '2,3', 'child observes the nested shared graph'); +check($shared->{count} == 2 && join(',', @{$shared->{values}}) eq '2,3', + 'nested shared mutations are visible to the parent'); +check($source->{count} == 1 && join(',', @{$source->{values}}) eq '2', + 'shared_clone leaves the source graph isolated'); + +my @stress = map { + threads->create(sub { + for (1 .. 50) { + lock(%$shared); + ++$shared->{count}; + } + }); +} 1 .. 4; +$_->join for @stress; +check($shared->{count} == 202, 'nested shared scalar survives lock stress');