diff --git a/dev/design/goto-tailcall-parity-handoff.md b/dev/design/goto-tailcall-parity-handoff.md new file mode 100644 index 000000000..5fd6268ed --- /dev/null +++ b/dev/design/goto-tailcall-parity-handoff.md @@ -0,0 +1,236 @@ +# `goto &sub` parity handoff + +## Objective + +Complete Perl-compatible `goto &sub` behavior on the JVM and bytecode interpreter backends. The acceptance target is every applicable assertion in `perl5_t/t/op/goto-sub.t`, with identical JVM and interpreter results. + +## Current state + +Both backends use `RuntimeCode.resolveTailCalls()` for tail-call marker dispatch. Named-target `AUTOLOAD`, chained calls, recursion, localized/replaced `@_`, and absent ARRAY slots after `undef *_` and `local *_` pass on both backends. + +The two UAT regressions are resolved on both backends: + +- `RuntimeCode.resolveTailCalls()` drains only deferred referents represented + by the marker's ownership carrier after a completed replacement call, so + destructor ordering is correct without touching borrowed caller values. +- Eval-scoped tail-call markers are resolved inside the bytecode interpreter's + active eval boundary. This preserves the named-undefined-target-before-eval + diagnostic order and lets the catcher populate `$@`. +- Dynamic `goto $coderef` now carries compile-time eval scope in its bytecode + operand rather than inferring eval-string provenance from a caller's runtime + eval depth. A normal sub can therefore tail-call through a tied coderef when + invoked by an eval block. +- Dynamic tail calls retain their saved coderef identity. Only markers emitted + for literal named gotos perform a fresh symbol lookup, so a wrapper using + `goto &$original_stub` cannot recurse through its replacement CODE slot. + +Completed since the initial handoff: + +- Tail-call markers carry explicit named-source identity, deferred eval scope, and the original `@_` container. +- A named target is freshly resolved after source-frame cleanup; core assertion 2 now passes with the required `Goto undefined subroutine ... at file line N` form. +- Literal `@_` uses the live/current-frame-localized argument container in both emitters; sparse `$_[0]` reification now passes core assertion 24. +- `src/test/resources/unit/goto_tailcall_cleanup.t` passes on system Perl, JVM, and interpreter with 60-second process timeouts. + +Focused validation now passes on system Perl, JVM, and interpreter: +`goto_tailcall_cleanup.t`, `goto_named_redefinition.t`, all 44 assertions in +`goto-sub.t`, and all four assertions in `uni/goto.t`. The DBIC lifecycle +regression `refcount/dbic_try_tiny_goto_schema_backref.t` also passes on +system Perl, JVM, and interpreter. A successful immutable full `make` gate +remains required before the PR can be updated. + +## Required implementation + +### Tail-call marker + +Extend `ControlFlowMarker` / `RuntimeControlFlowList` so a TAILCALL marker stores the original coderef, optional named-symbol identity, source file/line, the unchanged `RuntimeArray` argument container, and ownership of marker-created aliases. + +Only a source `goto &name` or `goto &Pkg::name` supplies named-symbol identity. Do not infer it from `RuntimeCode.packageName` / `subName`: anonymous closures and dynamic coderefs can carry those fields. Preserve normal behavior for coderefs, globs, strings, overload, `AUTOLOAD`, and eval. + +Do not validate in the marker constructor. After the source frame cleanup, `RuntimeCode.resolveTailCalls()` must freshly look up an explicitly named marker target through normal dispatch, preserving `AUTOLOAD`. For an undefined target, use marker file/line and the exact form: + +``` +Goto undefined subroutine &Pkg::name at file line N +``` + +Undefined-target handling precedes any eval-scope error. + +### Argument ownership + +Always pass the actual current or current-frame-localized `@_` container; never clone it for cleanup control. Audit `RuntimeCode.apply(..., "tailcall", ...)` and `RuntimeCode.resolveTailCalls()` together: each currently has tail-call cleanup paths. Assign cleanup ownership to one layer, consume each marker once, and release only marker-owned temporary aliases after the target returns or yields its next marker. This must fix core assertions 7 and 9 without changing aliasing. + +### Sparse arguments and ARRAY slots + +Trace `RuntimeArray.getTailCallArrayOfAlias()`, `RuntimeCode.getGotoArgs()`, and `utf8::encode`. A sparse `@_` created with `$#_++` must remain the same container through the handoff, so `utf8::encode($_[0])` reifies its missing element as `""`. + +Keep glob slot reads non-vivifying: reads of `*glob{ARRAY}` use a peek; writes and true array dereferences may create a slot. Do not use slot vivification to solve sparse-argument reification. + +## Regression coverage + +Keep and extend project-owned tests under `src/test/resources/unit` for the exact named-target cleanup diagnostic, repeated destructor ordering, sparse `@_` reification through `utf8::encode`, deferred named-target `AUTOLOAD`, and absent ARRAY slots after `undef *_` / `local *_`. + +Run new or modified Perl tests with system Perl first. Do not alter existing core tests. + +## Validation + +Capture complete output to files and wrap every `jperl` invocation in `timeout`. + +1. Run focused unit tests on system Perl, JVM, and interpreter. +2. Run `perl5_t/t/op/goto-sub.t` on JVM and interpreter; require no `not ok` lines and normal exit. +3. Run relevant `goto`, subroutine, typeglob, and UTF-8 tests on both backends. +4. Update `docs/about/changelog.md` under `## Work in progress` when runtime behavior is complete. +5. On an immutable final commit, run `make`, inspect its complete log, then update PR #1205 and monitor CI before UAT. + +## Progress Tracking + +### Current Status: UAT regression fixed; final PR validation pending (2026-09-02) + +### Completed Phases + +- [x] Marker identity and late named-target lookup + - Files: `ControlFlowMarker.java`, `RuntimeControlFlowList.java`, `RuntimeCode.java`, JVM and bytecode emitters. +- [x] Live `@_` handoff for literal `goto &name` + - Files: `CompileOperator.java`, `BytecodeInterpreter.java`, `RuntimeArray.java`. + - Core sparse argument assertion 24 passes on both backends. +- [x] Tail-call cleanup timing and exercised eval restriction diagnostics + - `RuntimeCode.resolveTailCalls()` flushes deferred source-frame decrements + after consuming marker ownership and emits the exact eval diagnostics. + - Core `goto-sub.t` assertions cover the eval-string diagnostic; the focused + regression covers target lookup and repeated destructor ordering. +- [x] Direct JVM eval-string trampoline and sparse argument handoff + - `evalStringWithInterpreter()` now resolves tail-call markers at the eval + execution boundary, matching `EvalStringHandler`. + - `CompileOperator` recognizes a list-wrapped literal `@_` and preserves the + live argument container for bytecode tail calls. + - Expanded `goto_tailcall_cleanup.t` covers eval strings, late `AUTOLOAD`, + sparse argument reification, and absent ARRAY slots after `undef *_` and + `local *_` on system Perl, JVM, and interpreter. +- [x] Top-level anonymous-coderef invocation + - `Variable.parseCoderefVariable()` now lowers bare `&{sub {...}}` to an + auto-call sharing `@_`, while `\&{sub {...}}` remains reference-taking. + - Added `top_level_coderef_call.t`; system Perl, JVM, and interpreter pass + invocation side-effect, scalar-return, and reference-taking assertions. +- [x] Rebase regression repair + - Tail-call scope cleanup now drains only the retired frame's mortal entries; + it no longer releases caller-owned deferred `Sub::Quote` metadata. + - Restored refcount-aware ARRAY/HASH typeglob detachment so saved slots can + be re-installed after `undef`. + - `sub_quote_qsub_metadata.t`, `typeglob_undef_slot_semantics.t`, and + `goto_tailcall_cleanup.t` pass on system Perl, JVM, and interpreter. +- [x] JVM undefined Unicode tail-marker diagnostic + - Top-level marker resolution and named-target preservation now report + `Goto undefined subroutine &main::因` rather than an internal escaped-marker error. + - `perl5_t/t/uni/goto.t` passes all four assertions on the JVM backend. +- [x] Completed handoff cleanup and eval-boundary parity + - `RuntimeCode.resolveTailCalls()` drains only marker-owned pending + referents after the replacement call completes, fixing core destructor + assertions 7 and 9 without regressing `Sub::Quote` metadata or caller + lifetimes. + - `GOTO_TAILCALL` resolves eval-scoped markers inside the interpreter's + catcher; `GOTO_DYNAMIC` carries compile-time eval scope to avoid treating + normal subs called from eval as eval-string code. + - `goto_tailcall_cleanup.t` adds destructor-ordering, Unicode eval-block, + and dynamic tied-coderef regressions; it passes on system Perl, JVM, and + interpreter. Core `goto-sub.t` (44 assertions) and `uni/goto.t` (4) + pass on both backends. +- [x] CI named-redefinition timeout repair + - The stalled `goto_named_redefinition.t` shard was traced to a generic + tail-call coderef rewrite that turned `goto &$original_stub` into the + replacement wrapper. Fresh lookup is now limited to explicit named-marker + targets. + - The existing six-case project regression passes on system Perl, JVM, and + interpreter, alongside the 13-case cleanup regression. +- [x] Borrowed-argument lifetime repair + - The first final gate exposed an early DBIC schema `DESTROY`: the completed + handoff drain considered every live `@_` alias, including caller-owned + values. + - The drain now consumes only the marker's ownership carrier. The existing + `dbic_try_tiny_goto_schema_backref.t` regression passes 3/3 on system + Perl, JVM, and interpreter without weakening tail-call cleanup coverage. +- [x] Windows filehandle stat identity repair + - Windows handle stat now retains the open-time `BasicFileAttributes` file + key, so a renamed handle has a distinct synthetic inode from a replacement + at its former path while an unchanged handle and pathname agree. + - The handle also resolves the current identity-validated Windows mode record + at its original pathname, preserving File::Temp's default `0600` mode + without sacrificing the captured inode after a rename. + - Existing `file_temp_stat_mode.t` and `stat_filehandle_after_rename.t` + regressions pass on system Perl, JVM, and interpreter. The immutable full + `make` gate passed in 4m24s. +- [x] Hosted cross-platform validation + - PR #1205 run 33570088728 passed on Ubuntu and Windows. Windows completed + the full build plus focused Perl thread gate; Ubuntu completed the full + build, Perl thread compatibility gate, and SBOM generation. +- [x] Destructor-ordering ownership provenance + - The tail-call drain now recognizes only an abandoned argument referent's + explicit `bless mortal temporary` birth hold when that deferred entry has + no scalar owner. This retires inline constructor arguments before the + replacement sub starts, without releasing borrowed DBIC schema aliases. + - `goto_tailcall_core_destroy_order.t` (six assertions) and + `refcount/dbic_try_tiny_goto_schema_backref.t` (three assertions) pass on + system Perl, JVM, and interpreter. Core `op/goto-sub.t` passes on both + backends; the final immutable `make` gate passed in 4m27s. +- [x] Closed-`STDERR` unhandled-die UAT repair + - `Main` now writes uncaught Perl diagnostics through the active Perl + `main::STDERR` handle instead of directly to Java `System.err`, preserving + Perl-level close/redirection semantics. + - Added `closed_stderr_unhandled_die.t`; it passes on system Perl, JVM, and + interpreter. `run/fresh_perl.t` test 72 passes on both backends in focused + core runs. + +### Next Steps + +1. Commit the closed-`STDERR` repair and focused regression. +2. Update PR #1205 and restart UAT after reviewing the complete `make` log. +3. Monitor hosted CI and resolve any remaining unrelated baseline failures. + +### Validation note + +Earlier gates exposed a named-redefinition loop and a borrowed DBIC schema +lifetime regression. Both have focused system-Perl, JVM, and interpreter +coverage and now pass. The final immutable `make` gate on `ddd1160a6` passed +in 4m25s (856 tests, 3 skips, zero failures); its complete log is +`/tmp/pr1205-owner-drain-final-make.log`. + +The direct JVM one-liner (`sub target{}; eval q{goto &target}`) is now covered +by the focused regression and reports the expected eval-string diagnostic on +both backends. + +The closed-`STDERR` regression was validated on system Perl, JVM, and +interpreter. The immutable `make` gate at `acdf0c442` passed in 4m37s; its +complete log is `/tmp/make-fresh-perl-stderr.log`. Focused `run/fresh_perl.t` +runs report test 72 as `ok` on both backends; the file continues into older +unrelated failures after that assertion. + +UAT passed on `72cca717e`. Its hosted Ubuntu CI job also passed, but Windows +exposed an unrelated `File::Temp` handle/path `stat` representation mismatch +(device, inode, and mode). The first repair made unchanged paths agree but +revealed that renamed handles must retain their open-time identity. The final +repair records `BasicFileAttributes` at channel open and derives the same +synthetic inode for pathname and handle stat without losing renamed-handle +identity. It also resolves the remembered Windows mode against the original +path only while that identity still matches, so File::Temp handle and pathname +stat retain the same `0600` mode. + +### Reopened destructor-ordering investigation + +UAT again reports `perl5_t/t/op/goto-sub.t` assertions 7 and 9 one iteration +late on both JVM and interpreter. The exact core test reproduces the result. +`goto_tailcall_core_destroy_order.t` is the new focused project regression: +it passes on system Perl and exposes the interpreter variant. The broad +live-argument cleanup restores the core ordering but destroys DBIC's borrowed +weak schema too early. The marker-owned-only cleanup preserves DBIC but leaves +the core object late. A provisional owner/frame-provenance implementation and +last-counted-owner cleanup did not change either core failure, so the next +phase is trace-led rather than extending that heuristic. + +## Relevant files + +- `src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java` +- `src/main/java/org/perlonjava/runtime/runtimetypes/ControlFlowMarker.java` +- `src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeControlFlowList.java` +- `src/main/java/org/perlonjava/backend/bytecode/BytecodeInterpreter.java` +- `src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeGlob.java` +- `src/test/resources/unit/goto_tailcall_cleanup.t` +- `src/test/resources/unit/closed_stderr_unhandled_die.t` +- `perl5_t/t/op/goto-sub.t` +- `perl5_t/t/run/fresh_perl.t` diff --git a/docs/about/changelog.md b/docs/about/changelog.md index 1155e6081..fd22356e4 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -25,11 +25,18 @@ Release history of PerlOnJava. See [Roadmap](roadmap.md) for future plans. avoiding alias-package misattribution in compatibility reports. - Fix parser diagnostics, Unicode split and global-regex progression, and persistent-app closure cleanup while preserving DBIx::Class leak behavior. +- Complete `goto &sub` tail-call parity, including eval diagnostics, sparse + `@_` reification, late `AUTOLOAD`, completed-handoff temporary cleanup, + dynamic-coderef calls from eval, preserved saved-coderef identity across + named redefinition, and top-level anonymous-coderef invocation. +- Route uncaught Perl diagnostics through the active `STDERR` handle, so a + closed `STDERR` suppresses a bare `die` like standard Perl. - Preserve process-pipe descriptors through returned and argument-aliased aggregates, and align compound-assignment lvalue order across both backends. - Keep Windows `sysopen` raw unless lexical `use open` applies, preserve exact - emulated mode bits in `stat`, and pass Ubuntu/Windows CI run `33223173108` on - runtime head `b1b0494cd`. + emulated mode bits in `stat`, make tempfile handle stats reflect creation + modes, and pass Ubuntu/Windows CI run `33223173108` on runtime head + `b1b0494cd`. - Restore the post-acceptance core UAT baseline on `9b2377b6f`: value-producing `defer` bodies remain verifier-safe, `PerlIO->import` rejects code injection without inheriting `UNIVERSAL` export errors, and repeated `$#array` lvalues diff --git a/src/main/java/org/perlonjava/app/cli/Main.java b/src/main/java/org/perlonjava/app/cli/Main.java index 024ced087..40aa64eba 100644 --- a/src/main/java/org/perlonjava/app/cli/Main.java +++ b/src/main/java/org/perlonjava/app/cli/Main.java @@ -6,6 +6,7 @@ import org.perlonjava.runtime.runtimetypes.GlobalVariable; import org.perlonjava.runtime.runtimetypes.PerlExitException; import org.perlonjava.runtime.runtimetypes.PerlRuntime; +import org.perlonjava.runtime.runtimetypes.RuntimeIO; import org.perlonjava.runtime.runtimetypes.RuntimeScalar; import org.perlonjava.runtime.regex.RuntimeRegex; @@ -161,8 +162,17 @@ private static void run(String[] args) { } String errorMessage = ErrorMessageUtil.stringifyException(t); - System.err.print(errorMessage); - System.err.flush(); + // Unhandled Perl errors follow the current Perl STDERR handle. In + // particular, `close STDERR; die` must remain silent; writing to + // Java's process stderr bypasses Perl-level handle state. + RuntimeIO stderr = GlobalVariable.getGlobalIO("main::STDERR").getRuntimeIO(); + if (stderr != null) { + stderr.write(errorMessage); + stderr.flush(); + } else { + System.err.print(errorMessage); + System.err.flush(); + } RuntimeRegex.emitPendingFailedCompileDebugFreeTraces(); // Match system perl behavior for unhandled die: diff --git a/src/main/java/org/perlonjava/app/scriptengine/PerlLanguageProvider.java b/src/main/java/org/perlonjava/app/scriptengine/PerlLanguageProvider.java index c57fb3bbb..a881909e3 100644 --- a/src/main/java/org/perlonjava/app/scriptengine/PerlLanguageProvider.java +++ b/src/main/java/org/perlonjava/app/scriptengine/PerlLanguageProvider.java @@ -603,6 +603,12 @@ private static RuntimeList executeCodeImpl(RuntimeCode runtimeCode, Node ast, Em WarningBitsRegistry.setCallSiteBits(savedCallSiteBits); } + // Top-level code normally has no generated call-site trampoline. + // Resolve a propagated goto &sub marker here so an undefined named + // target reports its Perl diagnostic instead of escaping as an + // internal control-flow marker. + result = RuntimeCode.resolveTailCalls(result, executionContext); + try { if (isMainProgram) { // Flush deferred mortal decrements from file-scoped lexical cleanup. diff --git a/src/main/java/org/perlonjava/backend/bytecode/BytecodeInterpreter.java b/src/main/java/org/perlonjava/backend/bytecode/BytecodeInterpreter.java index ea72d68a5..52046fd37 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/BytecodeInterpreter.java +++ b/src/main/java/org/perlonjava/backend/bytecode/BytecodeInterpreter.java @@ -658,6 +658,8 @@ private static RuntimeList execute(SuspendedInterpreterFrame frame) { case Opcodes.GOTO_DYNAMIC -> { // Dynamic goto: evaluate register to get label name, look up PC int rs = bytecode[pc++]; + int evalScopeIdx = bytecode[pc++]; + String evalScope = evalScopeIdx >= 0 ? code.stringPool[evalScopeIdx] : null; RuntimeScalar target = (RuntimeScalar) registers[rs]; if (target.type == RuntimeScalarType.TIED_SCALAR) { target = target.tiedFetch(); @@ -674,7 +676,11 @@ private static RuntimeList execute(SuspendedInterpreterFrame frame) { // Create a TAILCALL marker - pass current @_ (register 1) RuntimeArray currentArgs = registers[1].getTailCallArrayOfAlias(); RuntimeControlFlowList marker = new RuntimeControlFlowList( - target, currentArgs, code.sourceName, code.sourceLine); + target, currentArgs, code.sourceName, code.sourceLine, + evalScope); + if (evalScope != null) { + RuntimeCode.resolveTailCalls(marker, callContext); + } return marker; } String labelName = target.toString(); @@ -1665,25 +1671,10 @@ private static RuntimeList execute(SuspendedInterpreterFrame frame) { result = RuntimeCode.apply(codeRef, "", callArgs, context); } - // Handle TAILCALL with trampoline loop (same as JVM backend) - while (result.isNonLocalGoto()) { - RuntimeControlFlowList flow = (RuntimeControlFlowList) result; - if (flow.getControlFlowType() == ControlFlowType.TAILCALL) { - // Extract codeRef and args, call target - codeRef = flow.getTailCallCodeRef(); - callArgs = flow.getTailCallArgs(); - try { - result = RuntimeCode.apply(codeRef, "tailcall", callArgs, context); - } finally { - RuntimeCode.cleanupTailCallArgs(callArgs); - RuntimeCode.cleanupTailCallCodeRef(codeRef); - } - // Loop to handle chained tail calls - } else { - // Not TAILCALL - check labeled blocks or propagate - break; - } - } + // Use the same tail-call marker handoff as generated JVM code. + // In particular, it resolves named targets after the abandoned + // frame's cleanup and consumes marker-owned temporaries once. + result = RuntimeCode.resolveTailCalls(result, context); } finally { CallerStack.pop(); } @@ -1801,20 +1792,8 @@ private static RuntimeList execute(SuspendedInterpreterFrame frame) { try { result = RuntimeCode.call(invocant, method, currentSub, callArgs, context); - // Handle TAILCALL with trampoline loop (same as JVM backend) - while (result.isNonLocalGoto()) { - RuntimeControlFlowList flow = (RuntimeControlFlowList) result; - if (flow.getControlFlowType() == ControlFlowType.TAILCALL) { - // Extract codeRef and args, call target - RuntimeScalar codeRef = flow.getTailCallCodeRef(); - callArgs = flow.getTailCallArgs(); - result = RuntimeCode.apply(codeRef, "tailcall", callArgs, context); - // Loop to handle chained tail calls - } else { - // Not TAILCALL - check labeled blocks or propagate - break; - } - } + // Keep method calls on the shared tail-call handoff as well. + result = RuntimeCode.resolveTailCalls(result, context); } finally { CallerStack.pop(); } @@ -1934,6 +1913,7 @@ private static RuntimeList execute(SuspendedInterpreterFrame frame) { int argsReg = bytecode[pc++]; int context = bytecode[pc++]; // unused in marker, but consumed int evalScopeIdx = bytecode[pc++]; // -1 = not in eval + int namedTargetIdx = bytecode[pc++]; // -1 = dynamic target // Get coderef RuntimeBase codeRefBase = registers[coderefReg]; @@ -1947,7 +1927,9 @@ private static RuntimeList execute(SuspendedInterpreterFrame frame) { codeRef = codeRef.codeDerefNonStrict(currentPackageScalar.toString()); } - RuntimeArray callArgs = registers[argsReg].getTailCallArrayOfAlias(); + RuntimeArray callArgs = argsReg < 0 + ? RuntimeCode.getGotoArgs((RuntimeArray) registers[1], currentPackageScalar.toString()) + : registers[argsReg].getTailCallArrayOfAlias(); RuntimeArray localizedArgs = RuntimeGlob.localizedUnderscoreArrayForCurrentCall(); if (localizedArgs != null) { callArgs = localizedArgs; @@ -1955,7 +1937,21 @@ private static RuntimeList execute(SuspendedInterpreterFrame frame) { // Create TAILCALL marker with eval scope for runtime check String evalScope = (evalScopeIdx >= 0) ? code.stringPool[evalScopeIdx] : null; - registers[rd] = new RuntimeControlFlowList(codeRef, callArgs, code.sourceName, 0, evalScope); + String namedTarget = namedTargetIdx >= 0 ? code.stringPool[namedTargetIdx] : null; + RuntimeControlFlowList marker = new RuntimeControlFlowList( + codeRef, callArgs, code.sourceName, 0, evalScope, namedTarget); + + // A goto &sub from eval must fail at the eval + // boundary. Returning this marker would bypass + // EVAL_TRY because the goto compiler emits an + // immediate RETURN. Resolve it while the eval + // catcher is active: resolveTailCalls preserves + // Perl's named-undefined-target-before-eval rule + // and throws the diagnostic for EVAL_TRY to catch. + if (evalScope != null) { + RuntimeCode.resolveTailCalls(marker, context); + } + registers[rd] = marker; } case Opcodes.IS_CONTROL_FLOW -> { diff --git a/src/main/java/org/perlonjava/backend/bytecode/CompileOperator.java b/src/main/java/org/perlonjava/backend/bytecode/CompileOperator.java index 807f4e77a..fc87197db 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/CompileOperator.java +++ b/src/main/java/org/perlonjava/backend/bytecode/CompileOperator.java @@ -42,6 +42,17 @@ private static void emitSubroutineExitCleanup(BytecodeCompiler bc, int returnReg } } + /** True when a parsed call argument is the current frame's literal {@code @_}. */ + private static boolean isAtUnderscore(Node node) { + if (node instanceof ListNode list && list.elements.size() == 1) { + return isAtUnderscore(list.elements.getFirst()); + } + return node instanceof OperatorNode op + && op.operator.equals("@") + && op.operand instanceof IdentifierNode id + && id.name.equals("_"); + } + private static void compileScalarOperand(BytecodeCompiler bc, OperatorNode node, String opName) { if (node.operand instanceof ListNode list) { if (!list.elements.isEmpty()) { @@ -1855,8 +1866,16 @@ private static void visitGoto(BytecodeCompiler bc, OperatorNode node) { int outerContext = bc.currentCallContext; bc.compileNode(callTarget, -1, RuntimeContextType.SCALAR); int codeRefReg = bc.lastResultReg; - bc.compileNode(callNode.right, -1, RuntimeContextType.LIST); - int argsReg = bc.lastResultReg; + int argsReg; + boolean currentArgs = isAtUnderscore(callNode.right); + if (currentArgs) { + argsReg = -1; + } else { + bc.compileNode(callNode.right, -1, RuntimeContextType.LIST); + argsReg = bc.lastResultReg; + } + String namedTarget = opNode.operand instanceof IdentifierNode id + ? NameNormalizer.normalizeVariableName(id.name, bc.getCurrentPackage()) : null; int rd = bc.allocateOutputRegister(); bc.emit(Opcodes.GOTO_TAILCALL); bc.emitReg(rd); @@ -1864,6 +1883,7 @@ private static void visitGoto(BytecodeCompiler bc, OperatorNode node) { bc.emitReg(argsReg); bc.emit(outerContext); bc.emit(evalScopeIdx); + bc.emit(namedTarget == null ? -1 : bc.addToStringPool(namedTarget)); emitSubroutineExitCleanup(bc, rd); bc.emitWithToken(Opcodes.RETURN, node.getIndex()); bc.emitReg(rd); @@ -1894,6 +1914,7 @@ private static void visitGoto(BytecodeCompiler bc, OperatorNode node) { bc.emitReg(argsReg); bc.emit(outerContext); bc.emit(evalScopeIdx); + bc.emit(-1); emitSubroutineExitCleanup(bc, rd); bc.emitWithToken(Opcodes.RETURN, node.getIndex()); bc.emitReg(rd); @@ -1917,6 +1938,7 @@ private static void visitGoto(BytecodeCompiler bc, OperatorNode node) { bc.emitReg(argsReg); bc.emit(outerContext); bc.emit(evalScopeIdx); + bc.emit(-1); emitSubroutineExitCleanup(bc, rd); bc.emitWithToken(Opcodes.RETURN, node.getIndex()); bc.emitReg(rd); @@ -1933,6 +1955,8 @@ private static void visitGoto(BytecodeCompiler bc, OperatorNode node) { int exprReg = bc.lastResultReg; bc.emit(Opcodes.GOTO_DYNAMIC); bc.emit(exprReg); + String evalScope = bc.getEvalScopeType(); + bc.emit(evalScope == null ? -1 : bc.addToStringPool(evalScope)); bc.lastResultReg = -1; return; } @@ -1946,6 +1970,7 @@ private static void visitGoto(BytecodeCompiler bc, OperatorNode node) { bc.emit(emptyIdx); bc.emit(Opcodes.GOTO_DYNAMIC); bc.emit(rd); + bc.emit(-1); bc.lastResultReg = -1; return; } @@ -1962,6 +1987,7 @@ private static void visitGoto(BytecodeCompiler bc, OperatorNode node) { bc.emit(labelIdx); bc.emit(Opcodes.GOTO_DYNAMIC); bc.emit(rd); + bc.emit(-1); } bc.lastResultReg = -1; } diff --git a/src/main/java/org/perlonjava/backend/bytecode/Disassemble.java b/src/main/java/org/perlonjava/backend/bytecode/Disassemble.java index 7f6e2bea7..ba629b56e 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/Disassemble.java +++ b/src/main/java/org/perlonjava/backend/bytecode/Disassemble.java @@ -77,7 +77,8 @@ public static String disassemble(InterpretedCode interpretedCode) { pc += 1; break; case Opcodes.GOTO_DYNAMIC: - sb.append("GOTO_DYNAMIC r").append(interpretedCode.bytecode[pc++]).append("\n"); + sb.append("GOTO_DYNAMIC r").append(interpretedCode.bytecode[pc++]) + .append(" evalScopeIdx=").append(interpretedCode.bytecode[pc++]).append("\n"); break; case Opcodes.LAST: sb.append("LAST ").append(InterpretedCode.readInt(interpretedCode.bytecode, pc)).append("\n"); diff --git a/src/main/java/org/perlonjava/backend/bytecode/EvalStringHandler.java b/src/main/java/org/perlonjava/backend/bytecode/EvalStringHandler.java index 820ccebf2..86abf388b 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/EvalStringHandler.java +++ b/src/main/java/org/perlonjava/backend/bytecode/EvalStringHandler.java @@ -600,7 +600,7 @@ private static RuntimeList evalStringList(String perlCode, RuntimeList result; RuntimeCode.incrementEvalDepth(); try { - result = evalCode.apply(args, callContext); + result = RuntimeCode.resolveTailCalls(evalCode.apply(args, callContext), callContext); } finally { RuntimeCode.decrementEvalDepth(); DynamicVariableManager.popToLocalLevel(pkgLevel); @@ -779,7 +779,8 @@ public static RuntimeScalar evalString(String perlCode, RuntimeList result; RuntimeCode.incrementEvalDepth(); try { - result = evalCode.apply(args, RuntimeContextType.SCALAR); + result = RuntimeCode.resolveTailCalls( + evalCode.apply(args, RuntimeContextType.SCALAR), RuntimeContextType.SCALAR); } finally { RuntimeCode.decrementEvalDepth(); DynamicVariableManager.popToLocalLevel(pkgLevel); diff --git a/src/main/java/org/perlonjava/backend/bytecode/Opcodes.java b/src/main/java/org/perlonjava/backend/bytecode/Opcodes.java index 9328331eb..42d6e724f 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/Opcodes.java +++ b/src/main/java/org/perlonjava/backend/bytecode/Opcodes.java @@ -2017,7 +2017,7 @@ public class Opcodes { /** * Dynamic goto: evaluate register rs to get label name, look up PC in gotoLabelPcs map. - * Format: GOTO_DYNAMIC rs + * Format: GOTO_DYNAMIC rs evalScopeIdx * If label not found, throws "Can't find label" error. */ public static final short GOTO_DYNAMIC = 396; diff --git a/src/main/java/org/perlonjava/backend/jvm/Dereference.java b/src/main/java/org/perlonjava/backend/jvm/Dereference.java index b3ed979e5..305b4f0bb 100644 --- a/src/main/java/org/perlonjava/backend/jvm/Dereference.java +++ b/src/main/java/org/perlonjava/backend/jvm/Dereference.java @@ -1076,6 +1076,18 @@ && firstMethodArgumentIsLiteralSub(callNode) // Store result in temp slot mv.visitVarInsn(Opcodes.ASTORE, emitterVisitor.ctx.javaClassInfo.controlFlowTempSlot); + // Keep the JVM path on the same ownership-aware tail-call + // handoff as the bytecode interpreter. In particular this + // drains only deferred owners from the abandoned @_ frame. + 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); + // Load and check if it's a control flow marker mv.visitVarInsn(Opcodes.ALOAD, emitterVisitor.ctx.javaClassInfo.controlFlowTempSlot); mv.visitMethodInsn(Opcodes.INVOKEVIRTUAL, diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitControlFlow.java b/src/main/java/org/perlonjava/backend/jvm/EmitControlFlow.java index ddb9d6ea1..4f23c54f2 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitControlFlow.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitControlFlow.java @@ -551,10 +551,14 @@ static void handleGotoSubroutine(EmitterVisitor emitterVisitor, OperatorNode sub } else { ctx.mv.visitInsn(Opcodes.ACONST_NULL); } + String namedTarget = subNode.operand instanceof IdentifierNode id + ? org.perlonjava.runtime.runtimetypes.NameNormalizer.normalizeVariableName( + id.name, ctx.symbolTable.getCurrentPackage()) : null; + if (namedTarget != null) ctx.mv.visitLdcInsn(namedTarget); else ctx.mv.visitInsn(Opcodes.ACONST_NULL); ctx.mv.visitMethodInsn(Opcodes.INVOKESPECIAL, "org/perlonjava/runtime/runtimetypes/RuntimeControlFlowList", "", - "(Lorg/perlonjava/runtime/runtimetypes/RuntimeScalar;Lorg/perlonjava/runtime/runtimetypes/RuntimeArray;Ljava/lang/String;ILjava/lang/String;)V", + "(Lorg/perlonjava/runtime/runtimetypes/RuntimeScalar;Lorg/perlonjava/runtime/runtimetypes/RuntimeArray;Ljava/lang/String;ILjava/lang/String;Ljava/lang/String;)V", false); if (pooledArgs) { diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java b/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java index f8b581fa1..d401493c4 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java @@ -915,6 +915,15 @@ static void handleApplyOperator(EmitterVisitor emitterVisitor, BinaryOperatorNod "(Lorg/perlonjava/runtime/runtimetypes/RuntimeScalar;Lorg/perlonjava/runtime/runtimetypes/RuntimeArray;I)Lorg/perlonjava/runtime/runtimetypes/RuntimeList;", false); + // A goto &sub marker must be resolved while this eval's generated + // try/catch is active, so its eval-scope diagnostic reaches $@. + emitterVisitor.pushCallContext(); + mv.visitMethodInsn(Opcodes.INVOKESTATIC, + "org/perlonjava/runtime/runtimetypes/RuntimeCode", + "resolveTailCalls", + "(Lorg/perlonjava/runtime/runtimetypes/RuntimeList;I)Lorg/perlonjava/runtime/runtimetypes/RuntimeList;", + false); + if (pooledCodeRef) { emitterVisitor.ctx.javaClassInfo.releaseSpillSlot(); } diff --git a/src/main/java/org/perlonjava/frontend/parser/Variable.java b/src/main/java/org/perlonjava/frontend/parser/Variable.java index 1dce1b654..8508f16eb 100644 --- a/src/main/java/org/perlonjava/frontend/parser/Variable.java +++ b/src/main/java/org/perlonjava/frontend/parser/Variable.java @@ -787,7 +787,16 @@ static Node parseCoderefVariable(Parser parser, LexerToken token) { TokenUtils.consume(parser); // consume '{' Node block = ParseBlock.parseBlock(parser); TokenUtils.consume(parser, LexerTokenType.OPERATOR, "}"); - return new OperatorNode("&", block, index); + OperatorNode codeRef = new OperatorNode("&", block, index); + // \&{sub ...} takes a coderef, but bare &{sub ...} is an + // invocation that shares the current @_ just like &name. + if (parser.parsingTakeReference) { + return codeRef; + } + BinaryOperatorNode callNode = new BinaryOperatorNode( + "(", block, atUnderscore(parser), index); + callNode.setAnnotation("shareCallerArgs", true); + return callNode; } break; // Not whitespace and not 'sub', so exit } diff --git a/src/main/java/org/perlonjava/runtime/io/CustomFileChannel.java b/src/main/java/org/perlonjava/runtime/io/CustomFileChannel.java index 41d727a2a..668f86f50 100644 --- a/src/main/java/org/perlonjava/runtime/io/CustomFileChannel.java +++ b/src/main/java/org/perlonjava/runtime/io/CustomFileChannel.java @@ -18,8 +18,10 @@ import java.nio.channels.WritableByteChannel; import java.nio.charset.Charset; import java.nio.charset.StandardCharsets; +import java.nio.file.Files; import java.nio.file.Path; import java.nio.file.StandardOpenOption; +import java.nio.file.attribute.BasicFileAttributes; import java.util.Set; import static org.perlonjava.runtime.runtimetypes.GlobalVariable.getGlobalVariable; @@ -204,6 +206,13 @@ public long transferTo(long position, long count, WritableByteChannel target) */ private final FFMPosixInterface.StatResult openedStat; + /** + * Windows-compatible identity captured for the file that was opened. + * Unlike pathname attributes, this remains associated with the open + * channel when that pathname is renamed and replaced. + */ + private final BasicFileAttributes openedBasicAttributes; + private boolean isEOF; // When true, writes should always occur at end-of-file (Perl's append semantics). @@ -230,6 +239,7 @@ public CustomFileChannel(Path path, Set options) throws IOEx this.filePath = path; this.fileChannel = FileChannel.open(path, options); this.openedStat = captureOpenedStat(path); + this.openedBasicAttributes = captureOpenedBasicAttributes(path); this.isEOF = false; this.appendMode = false; // Canonical path for the shared-lock registry. Fall back to absolute path @@ -257,6 +267,7 @@ public CustomFileChannel(Path path, Set options) throws IOEx public CustomFileChannel(FileDescriptor fd, Set options) throws IOException { this.filePath = null; this.openedStat = null; + this.openedBasicAttributes = null; this.lockKey = null; if (options.contains(StandardOpenOption.READ)) { this.fileChannel = new FileInputStream(fd).getChannel(); @@ -277,6 +288,10 @@ public FFMPosixInterface.StatResult getOpenedStat() { return openedStat; } + public BasicFileAttributes getOpenedBasicAttributes() { + return openedBasicAttributes; + } + private static FFMPosixInterface.StatResult captureOpenedStat(Path path) { try { return FFMPosix.get().stat(path.toString()); @@ -285,6 +300,14 @@ private static FFMPosixInterface.StatResult captureOpenedStat(Path path) { } } + private static BasicFileAttributes captureOpenedBasicAttributes(Path path) { + try { + return Files.readAttributes(path, BasicFileAttributes.class); + } catch (IOException ignored) { + return null; + } + } + /** * Return the size of the open file description. Unlike querying * {@link #getFilePath()}, this keeps working after an open temporary file diff --git a/src/main/java/org/perlonjava/runtime/operators/Stat.java b/src/main/java/org/perlonjava/runtime/operators/Stat.java index 59f1e7149..5b900b177 100644 --- a/src/main/java/org/perlonjava/runtime/operators/Stat.java +++ b/src/main/java/org/perlonjava/runtime/operators/Stat.java @@ -223,14 +223,55 @@ public static RuntimeList stat(RuntimeScalar arg) { } } if (innerHandle instanceof CustomFileChannel cfc) { + if (NativeUtils.IS_WINDOWS) { + BasicFileAttributes openedBasic = cfc.getOpenedBasicAttributes(); + if (openedBasic != null) { + try { + // A Windows pathname can be renamed and replaced while + // the channel keeps addressing the original file. + // Use the attributes captured at open time for + // identity, the current pathname's remembered + // Windows mode, and the channel's current length. + statInternalBasic(res, cfc.getFilePath(), openedBasic, cfc.size()); + getGlobalVariable("main::!").set(0); + updateLastStat(arg, true, 0, false); + FileTestOperator.State state = state(); + state.lastBasicAttr = openedBasic; + state.lastPosixAttr = null; + state.lastNativeStatFields = null; + return res; + } catch (IOException e) { + getGlobalVariable("main::!").set(5); + updateLastStat(arg, false, 5, false); + return res; + } + } + } FFMPosixInterface.StatResult opened = cfc.getOpenedStat(); if (opened != null) { try { - NativeStatFields nf = new NativeStatFields( + // Keep the open-time identity when a pathname has been + // renamed and replaced, but refresh metadata while it + // still names the opened inode. In particular, + // sysopen(..., O_CREAT, PERMS) applies PERMS after it + // creates the writable descriptor. + Path openedPath = cfc.getFilePath(); + NativeStatFields openedFields = new NativeStatFields( opened.dev(), opened.ino(), opened.mode(), opened.nlink(), - opened.uid(), opened.gid(), opened.rdev(), cfc.size(), + opened.uid(), opened.gid(), opened.rdev(), opened.size(), opened.atime(), opened.mtime(), opened.ctime(), opened.blksize(), opened.blocks()); + NativeStatFields current = openedPath == null + ? null : nativeStat(openedPath.toString(), true); + if (current != null && current.dev() == opened.dev() + && current.ino() == opened.ino()) { + openedFields = current; + } + NativeStatFields nf = new NativeStatFields( + openedFields.dev(), openedFields.ino(), openedFields.mode(), openedFields.nlink(), + openedFields.uid(), openedFields.gid(), openedFields.rdev(), cfc.size(), + openedFields.atime(), openedFields.mtime(), openedFields.ctime(), + openedFields.blksize(), openedFields.blocks()); statInternalNative(res, nf); getGlobalVariable("main::!").set(0); updateLastStat(arg, true, 0, false); @@ -400,19 +441,24 @@ public static void statInternal(RuntimeList res, BasicFileAttributes basicAttr, private static void statInternalBasic( RuntimeList res, Path path, BasicFileAttributes basicAttr) { + statInternalBasic(res, path, basicAttr, basicAttr.size()); + } + + private static void statInternalBasic( + RuntimeList res, Path path, BasicFileAttributes basicAttr, long size) { int mode = 0; Integer rememberedMode = rememberedWindowsMode(path, basicAttr); if (basicAttr.isDirectory()) mode = 0040000 | (rememberedMode == null ? 0755 : rememberedMode); else if (basicAttr.isRegularFile()) mode = 0100000 | (rememberedMode == null ? 0644 : rememberedMode); else if (basicAttr.isSymbolicLink()) mode = 0120000 | (rememberedMode == null ? 0777 : rememberedMode); res.add(scalarUndef); - res.add(scalarUndef); + res.add(getScalarInt(windowsInode(basicAttr))); res.add(getScalarInt(mode)); res.add(getScalarInt(1)); res.add(scalarUndef); res.add(scalarUndef); res.add(scalarUndef); - res.add(getScalarInt(basicAttr.size())); + res.add(getScalarInt(size)); res.add(getScalarInt(basicAttr.lastAccessTime().toMillis() / 1000)); res.add(getScalarInt(basicAttr.lastModifiedTime().toMillis() / 1000)); res.add(getScalarInt(basicAttr.creationTime().toMillis() / 1000)); @@ -420,6 +466,12 @@ private static void statInternalBasic( res.add(scalarUndef); } + private static long windowsInode(BasicFileAttributes basicAttr) { + Object fileKey = basicAttr.fileKey(); + if (fileKey != null) return Integer.toUnsignedLong(fileKey.hashCode()); + return basicAttr.creationTime().toMillis() ^ basicAttr.size(); + } + public record NativeStatFields( long dev, long ino, long mode, long nlink, long uid, long gid, long rdev, long size, diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/ControlFlowMarker.java b/src/main/java/org/perlonjava/runtime/runtimetypes/ControlFlowMarker.java index be363e462..8506e73a9 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/ControlFlowMarker.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/ControlFlowMarker.java @@ -24,6 +24,12 @@ public class ControlFlowMarker { * The arguments for TAILCALL (goto &NAME) */ public final RuntimeArray args; + /** Ownership-only carrier for temporary aliases transferred from {@link #args}. */ + public final RuntimeArray ownedArgs; + /** Snapshot identity of the source call's pristine argument frame. */ + public final Object argumentFrame; + public final String namedTarget; + public final String evalScope; /** * Source file name where the control flow originated (for error messages) @@ -50,6 +56,10 @@ public ControlFlowMarker(ControlFlowType type, String label, String fileName, in this.lineNumber = lineNumber; this.codeRef = null; this.args = null; + this.ownedArgs = null; + this.argumentFrame = null; + this.namedTarget = null; + this.evalScope = null; } /** @@ -61,12 +71,22 @@ public ControlFlowMarker(ControlFlowType type, String label, String fileName, in * @param lineNumber Line number (for error messages) */ public ControlFlowMarker(RuntimeScalar codeRef, RuntimeArray args, String fileName, int lineNumber) { + this(codeRef, args, fileName, lineNumber, null, null); + } + + public ControlFlowMarker(RuntimeScalar codeRef, RuntimeArray args, String fileName, int lineNumber, + String namedTarget, String evalScope) { this.type = ControlFlowType.TAILCALL; this.label = null; this.fileName = fileName; this.lineNumber = lineNumber; this.codeRef = codeRef; this.args = args; + this.ownedArgs = args != null ? args.takeTailCallOwnership() : null; + this.argumentFrame = args != null && !args.elements.isEmpty() + ? RuntimeCode.currentArgumentAliasFrame(args.elements.get(0)) : null; + this.namedTarget = namedTarget; + this.evalScope = evalScope; } /** @@ -90,6 +110,14 @@ public String buildErrorMessage() { String location = " at " + fileName + " line " + lineNumber; if (type == ControlFlowType.TAILCALL) { + String target = namedTarget; + if (target == null && codeRef != null && codeRef.value instanceof RuntimeCode code + && code.packageName != null && code.subName != null) { + target = code.packageName + "::" + code.subName; + } + if (target != null) { + return "Goto undefined subroutine &" + target + location; + } // Tail call should have been handled by trampoline at returnLabel return "Tail call escaped to top level (internal error)" + location; } else if (type == ControlFlowType.RETURN) { @@ -115,4 +143,3 @@ public void throwError() { throw new PerlCompilerException(buildErrorMessage()); } } - diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/LifecycleRuntimeState.java b/src/main/java/org/perlonjava/runtime/runtimetypes/LifecycleRuntimeState.java index 12128ae0d..16fcc32ef 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/LifecycleRuntimeState.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/LifecycleRuntimeState.java @@ -20,6 +20,9 @@ final class LifecycleRuntimeState { // Parallel to pending. A non-null entry retains trace-only provenance for // an owner token whose scalar was cleared when its decrement was queued. final ArrayList pendingOwnerReleases = new ArrayList<>(); + // Parallel to pending. Weak provenance permits a tail-call handoff to + // drain only the decrement whose owning argument it actually replaces. + final ArrayList> pendingOwnerScalars = new ArrayList<>(); // Parallel to pending. A non-scalar transient owner kind is recorded only // for trace attribution; it never changes runtime reachability. final ArrayList pendingTransientOwnerKinds = new ArrayList<>(); @@ -82,6 +85,7 @@ void clear() { } pending.clear(); pendingOwnerReleases.clear(); + pendingOwnerScalars.clear(); pendingTransientOwnerKinds.clear(); pendingTiedReleases.clear(); pendingIoReleases.clear(); diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/MortalList.java b/src/main/java/org/perlonjava/runtime/runtimetypes/MortalList.java index e7a795e8c..b35c42d43 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/MortalList.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/MortalList.java @@ -177,8 +177,16 @@ private static void queueDeferredBase(LifecycleRuntimeState state, RuntimeBase b private static void queueDeferredBase(LifecycleRuntimeState state, RuntimeBase base, RuntimeBase.PendingOwnerRelease ownerRelease, String transientOwnerKind) { + queueDeferredBase(state, base, ownerRelease, transientOwnerKind, null); + } + + private static void queueDeferredBase(LifecycleRuntimeState state, RuntimeBase base, + RuntimeBase.PendingOwnerRelease ownerRelease, + String transientOwnerKind, RuntimeScalar ownerScalar) { state.pending.add(base); state.pendingOwnerReleases.add(ownerRelease); + state.pendingOwnerScalars.add(ownerScalar == null ? null + : new java.lang.ref.WeakReference<>(ownerScalar)); state.pendingTransientOwnerKinds.add(transientOwnerKind); } @@ -372,7 +380,7 @@ public static void deferDecrementIfTracked(RuntimeScalar scalar) { markBoundaryWork(state); RuntimeBase.PendingOwnerRelease ownerRelease = base.queueOwnerRelease( scalar, "MortalList.deferDecrementIfTracked"); - queueDeferredBase(state, base, ownerRelease); + queueDeferredBase(state, base, ownerRelease, null, scalar); } else if (base.refCount == 0 && base.clearedOwnedAggregateElement && WeakRefRegistry.hasWeakRefsTo(base)) { @@ -663,6 +671,27 @@ public static void releaseTailCallArgs(RuntimeArray args) { args.elementsOwned = false; } + /** + * Retire a source {@code @_} alias only when it is the referent's last + * counted owner. A {@code goto &sub} replaces that frame immediately, but + * its aliases normally belong to the caller and must not be released here. + * The last-owner restriction is what distinguishes a temporary call + * argument from a shared value such as DBIx::Class's weak schema handle. + */ + public static void releaseLastOwnedTailCallArgs(RuntimeArray args) { + if (args == null || !isActive()) return; + for (RuntimeScalar scalar : args.elements) { + if (scalar == null + || !scalar.refCountOwned + || (scalar.type & RuntimeScalarType.REFERENCE_BIT) == 0 + || !(scalar.value instanceof RuntimeBase base) + || base.refCount != 1) { + continue; + } + releaseTailCallArgElement(scalar); + } + } + public static void releaseTailCallCodeRef(RuntimeScalar codeRef) { if (codeRef == null || !isActive() @@ -801,7 +830,7 @@ private static void deferDecrementRecursive(RuntimeScalar scalar) { releasingLastOwner = base.refCount == 1; LifecycleRuntimeState state = state(); markBoundaryWork(state); - queueDeferredBase(state, base, null); + queueDeferredBase(state, base, null, null, s); } else if (base.refCount == 0) { if (base.refCountTrace) { base.traceRefCount(+1, "MortalList.deferDecrementRecursive (blessed never-stored bump+queue)"); @@ -809,7 +838,7 @@ private static void deferDecrementRecursive(RuntimeScalar scalar) { base.refCount = 1; LifecycleRuntimeState state = state(); markBoundaryWork(state); - queueDeferredBase(state, base, null); + queueDeferredBase(state, base, null, null, s); // A zero-count blessed container returned from a helper // has no counted owner to release, but its fields still // disappear when this temporary dies. @@ -844,7 +873,7 @@ private static void deferDecrementRecursive(RuntimeScalar scalar) { base.releaseActiveOwner(s); LifecycleRuntimeState state = state(); markBoundaryWork(state); - queueDeferredBase(state, base, null); + queueDeferredBase(state, base, null, null, s); if (!WeakRefRegistry.weakRefsExist() && base.refCount > 1) { continue; } @@ -1417,6 +1446,7 @@ public static void flush() { processDeferredEntriesFrom(0, 0, 0); state.pending.clear(); state.pendingOwnerReleases.clear(); + state.pendingOwnerScalars.clear(); state.pendingTransientOwnerKinds.clear(); state.pendingTiedReleases.clear(); state.pendingIoReleases.clear(); @@ -1556,10 +1586,59 @@ public static void drainPendingSince(int startIdx) { while (state.pending.size() > startIdx) { state.pending.remove(state.pending.size() - 1); state.pendingOwnerReleases.remove(state.pendingOwnerReleases.size() - 1); + state.pendingOwnerScalars.remove(state.pendingOwnerScalars.size() - 1); state.pendingTransientOwnerKinds.remove(state.pendingTransientOwnerKinds.size() - 1); } } + /** + * Drain deferred decrements for marker-owned aliases after a completed + * {@code goto &sub} handoff. The source call's expression temporaries may + * be queued below the caller's mortal mark, so flushing that whole scope + * would also release unrelated deferred metadata (for example Sub::Quote + * captures) or borrowed caller arguments. Restrict the drain to the + * marker's ownership-only alias carrier. + */ + public static void drainPendingTailCallArgs(RuntimeArray args, Object argumentFrame) { + if (!isActive() || args == null) return; + java.util.Set owners = + java.util.Collections.newSetFromMap(new java.util.IdentityHashMap<>()); + owners.addAll(args.elements); + + LifecycleRuntimeState state = state(); + if (state.flushing) return; + invalidateDrainReachabilityCaches(); + state.flushing = true; + try { + for (int i = state.pending.size() - 1; i >= 0; i--) { + java.lang.ref.WeakReference ownerRef = + state.pendingOwnerScalars.get(i); + RuntimeScalar owner = ownerRef == null ? null : ownerRef.get(); + RuntimeBase pending = state.pending.get(i); + boolean directOwner = owner != null && owners.contains(owner); + boolean frameCopy = owner != null && owner.copiedFromArgumentFrame(argumentFrame); + boolean abandonedBirthTemporary = owner == null + && "bless mortal temporary".equals(state.pendingTransientOwnerKinds.get(i)) + && args.elements.stream().anyMatch(argument -> argument != null + && argument.value == pending); + if ((!directOwner && !frameCopy && !abandonedBirthTemporary) + || (owner == null && !abandonedBirthTemporary)) continue; + RuntimeBase.PendingOwnerRelease ownerRelease = + state.pendingOwnerReleases.get(i); + String transientOwnerKind = state.pendingTransientOwnerKinds.get(i); + state.pending.remove(i); + state.pendingOwnerReleases.remove(i); + state.pendingOwnerScalars.remove(i); + state.pendingTransientOwnerKinds.remove(i); + processDeferredBase(pending, true, ownerRelease, transientOwnerKind); + } + } finally { + state.flushing = false; + invalidateDrainReachabilityCaches(); + } + refreshBoundaryWork(state); + } + /** * Push a mark recording the current pending list size. * Called before scope-exit cleanup so that popAndFlush() only @@ -1638,6 +1717,7 @@ public static void flushAboveMark() { while (state.pending.size() > mark) { state.pending.removeLast(); state.pendingOwnerReleases.removeLast(); + state.pendingOwnerScalars.removeLast(); state.pendingTransientOwnerKinds.removeLast(); } while (state.pendingTiedReleases.size() > tiedMark) { @@ -1684,6 +1764,7 @@ public static void popAndFlush() { while (state.pending.size() > mark) { state.pending.removeLast(); state.pendingOwnerReleases.removeLast(); + state.pendingOwnerScalars.removeLast(); state.pendingTransientOwnerKinds.removeLast(); } while (state.pendingTiedReleases.size() > tiedMark) { diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeArray.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeArray.java index f29bbad29..34a75fca8 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeArray.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeArray.java @@ -1722,6 +1722,34 @@ public RuntimeArray getTailCallArrayOfAlias() { return arr; } + /** + * Transfers only this array's tail-call cleanup ownership to a separate + * carrier, retaining this exact array as the callee's {@code @_}. + */ + public RuntimeArray takeTailCallOwnership() { + RuntimeArray carrier = new RuntimeArray(); + if (!this.elementsOwned) return carrier; + + if (this.elementsAliased && this.ownedAliasElements != null) { + for (RuntimeScalar element : this.ownedAliasElements.toArray(new RuntimeScalar[0])) { + carrier.elements.add(element); + carrier.markOwnedAliasElement(element); + } + this.ownedAliasElements = null; + } else { + for (RuntimeScalar element : this.elements) { + if (element != null) { + carrier.elements.add(element); + carrier.markOwnedAliasElement(element); + } + } + } + this.elementsOwned = false; + carrier.elementsAliased = true; + carrier.elementsOwned = carrier.ownedAliasElements != null && !carrier.ownedAliasElements.isEmpty(); + return carrier; + } + /** * Returns an iterator for the array. * diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java index f8777687a..dfc911882 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java @@ -3390,7 +3390,10 @@ public static RuntimeList evalStringWithInterpreter( // Track eval depth for $^S support incrementEvalDepth(); try { - result = interpretedCode.apply(args, callContext); + // Eval STRING is an execution boundary: resolve a goto &sub + // marker here so its eval-string restriction is caught and + // stored in $@ instead of escaping to the outer caller. + result = resolveTailCalls(interpretedCode.apply(args, callContext), callContext); evalTrace("evalStringWithInterpreter exec ok tag=" + evalTag + " ctx=" + callContext + " resultClass=" + (result != null ? result.getClass().getSimpleName() : "null") + @@ -5022,6 +5025,11 @@ private static String gotoErrorPrefix(String subroutineName) { return "tailcall".equals(subroutineName) ? "Goto u" : "U"; } + private static String undefinedSubroutineMessage(String subroutineName, String fullSubName) { + String message = gotoErrorPrefix(subroutineName) + "ndefined subroutine &" + fullSubName; + return "tailcall".equals(subroutineName) ? message : message + " called"; + } + /** * Extracts Java class names from a Throwable's stack trace, parallel to * how ExceptionFormatter.formatException produces Perl frames. @@ -5216,6 +5224,10 @@ public static RuntimeList apply(RuntimeScalar runtimeScalar, RuntimeArray a, int continue; } } + if ("tailcall".equals(subroutineName)) { + throw new PerlCompilerException("Goto undefined subroutine &" + + code.packageName + "::" + code.subName); + } throw new PerlCompilerException("Undefined subroutine &" + subroutineName + " called"); } String resolvedSubroutineName = code.packageName != null && code.subName != null @@ -5265,6 +5277,7 @@ public static RuntimeList apply(RuntimeScalar runtimeScalar, RuntimeArray a, int // Java-stack growth on long `goto &func` chains. RuntimeScalar nextTailCode = null; RuntimeArray nextTailArgs = null; + boolean returnedTailCall = false; boolean cleanupArgsAfterCall = curArgsFromTailCall; RuntimeScalar codeRefForCall = curScalar; RuntimeArray argsForCall = curArgs; @@ -5275,9 +5288,16 @@ public static RuntimeList apply(RuntimeScalar runtimeScalar, RuntimeArray a, int // JVM-generated bytecode has its own trampoline; this handles calls from Java code. if (result instanceof RuntimeControlFlowList cfList && cfList.getControlFlowType() == ControlFlowType.TAILCALL) { + returnedTailCall = true; nextTailCode = cfList.getTailCallCodeRef(); RuntimeArray tailArgs = cfList.getTailCallArgs(); nextTailArgs = tailArgs != null ? tailArgs : curArgs; + // Retire only deferred owners belonging to the source + // argument frame before its replacement runs. The broad + // scope flush below deliberately cannot do this: it must + // leave caller-owned weak-schema aliases intact. + MortalList.drainPendingTailCallArgs(tailArgs, cfList.marker.argumentFrame); + MortalList.releaseLastOwnedTailCallArgs(tailArgs); // Fall through to finally; outer loop will re-enter apply() // with the new code ref. We stay inside this apply() // invocation, so enterCall/exitCall depth tracking is @@ -5334,6 +5354,12 @@ public static RuntimeList apply(RuntimeScalar runtimeScalar, RuntimeArray a, int } throw e; } finally { + if (returnedTailCall) { + // A goto &sub retires this frame before the replacement + // executes. Drain only this frame's scope exits, not the + // caller's deferred coderef metadata. + MortalList.flushAboveMark(); + } if (cleanupArgsAfterCall) { cleanupTailCallArgs(argsForCall); cleanupTailCallCodeRef(codeRefForCall); @@ -5423,6 +5449,7 @@ public static RuntimeList applyEval(RuntimeScalar runtimeScalar, RuntimeArray a, incrementEvalDepth(); try { RuntimeList result = apply(runtimeScalar, a, callContext); + result = resolveTailCalls(result, callContext); // Perl clears $@ on successful eval (even if nested evals previously set it). GlobalVariable.setGlobalVariable("main::@", ""); return result; @@ -5647,9 +5674,12 @@ public static RuntimeList apply(RuntimeScalar runtimeScalar, String subroutineNa WarningBitsRegistry.setCallSiteHints(code.lexicalHints); int cleanupMark = MyVarCleanupStack.pushMark(); MortalList.pushMark(); + boolean returnedTailCall = false; try { // Cast the value to RuntimeCode and call apply() RuntimeList result = code.apply(subroutineName, a, callContext); + returnedTailCall = result instanceof RuntimeControlFlowList cfList + && cfList.getControlFlowType() == ControlFlowType.TAILCALL; // Flush deferred DESTROY decrements for void-context calls. // See the 3-arg apply() overload for detailed rationale. if (effectiveContext == RuntimeContextType.VOID) { @@ -5678,6 +5708,9 @@ public static RuntimeList apply(RuntimeScalar runtimeScalar, String subroutineNa } throw e; } finally { + if (returnedTailCall) { + MortalList.flushAboveMark(); + } if ("tailcall".equals(subroutineName)) { cleanupTailCallArgs(a); cleanupTailCallCodeRef(runtimeScalar); @@ -5736,7 +5769,7 @@ public static RuntimeList apply(RuntimeScalar runtimeScalar, String subroutineNa // Call AUTOLOAD return apply(autoload, a, callContext); } - throw new PerlCompilerException(gotoErrorPrefix(subroutineName) + "ndefined subroutine &" + fullSubName + " called"); + throw new PerlCompilerException(undefinedSubroutineMessage(subroutineName, fullSubName)); } } @@ -5796,12 +5829,34 @@ public static RuntimeList resolveTailCalls(RuntimeList result, int callContext) RuntimeArray args = cfList.getTailCallArgs(); // args may theoretically be null (defensive); treat as empty args list RuntimeArray tailArgs = args != null ? args : new RuntimeArray(); + String namedTarget = cfList.marker.namedTarget; + if (namedTarget != null) { + codeRef = GlobalVariable.getGlobalCodeRefForFreshLookup(namedTarget); + if (codeRef.type == RuntimeScalarType.CODE && codeRef.value instanceof RuntimeCode code + && !code.defined() && !hasAutoload(code)) { + cleanupTailCallArgs(cfList.marker.ownedArgs); + cleanupTailCallCodeRef(cfList.getTailCallCodeRef()); + throw new PerlCompilerException("Goto undefined subroutine &" + namedTarget + + " at " + cfList.marker.fileName + " line " + cfList.marker.lineNumber); + } + } try { + if (cfList.marker.evalScope != null) { + throw new PerlCompilerException("Can't goto subroutine from an " + cfList.marker.evalScope); + } result = apply(codeRef, "tailcall", tailArgs, callContext); - } finally { - cleanupTailCallArgs(tailArgs); - cleanupTailCallCodeRef(codeRef); + } catch (RuntimeException e) { + cleanupTailCallArgs(cfList.marker.ownedArgs); + cleanupTailCallCodeRef(cfList.getTailCallCodeRef()); + throw e; } + // Drain only queued decrements whose original owner is an alias + // in the abandoned source @_ frame. This keeps caller-owned + // referents (including DBIC schema aliases) out of the handoff. + MortalList.drainPendingTailCallArgs(cfList.getTailCallArgs(), cfList.marker.argumentFrame); + MortalList.releaseLastOwnedTailCallArgs(cfList.getTailCallArgs()); + cleanupTailCallArgs(cfList.marker.ownedArgs); + cleanupTailCallCodeRef(cfList.getTailCallCodeRef()); } return result; } @@ -5929,9 +5984,12 @@ private static RuntimeList applyImpl(RuntimeScalar runtimeScalar, String subrout WarningBitsRegistry.setCallSiteHints(code.lexicalHints); int cleanupMark = MyVarCleanupStack.pushMark(); MortalList.pushMark(); + boolean returnedTailCall = false; try { // Cast the value to RuntimeCode and call apply() RuntimeList result = code.apply(subroutineName, a, callContext); + returnedTailCall = result instanceof RuntimeControlFlowList cfList + && cfList.getControlFlowType() == ControlFlowType.TAILCALL; // Flush deferred DESTROY decrements for void-context calls. // See the 3-arg apply() overload for detailed rationale. if (effectiveContext == RuntimeContextType.VOID) { @@ -5958,6 +6016,9 @@ private static RuntimeList applyImpl(RuntimeScalar runtimeScalar, String subrout } throw e; } finally { + if (returnedTailCall) { + MortalList.flushAboveMark(); + } if ("tailcall".equals(subroutineName)) { cleanupTailCallArgs(a); cleanupTailCallCodeRef(runtimeScalar); @@ -6449,6 +6510,9 @@ public RuntimeList apply(RuntimeArray a, int callContext) { getGlobalVariable(autoloadVarFor(autoload, lookupPkg)).set(fullSubName); return apply(autoload, a, callContext); } + if (PerlRuntime.current().executionState().tailCallTrampolineDepth > 0) { + throw new PerlCompilerException("Goto undefined subroutine &" + fullSubName); + } throw new PerlCompilerException("Undefined subroutine &" + fullSubName + " called"); } throw new PerlCompilerException("Undefined subroutine called at "); diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeControlFlowList.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeControlFlowList.java index 545bbd798..88de498ed 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeControlFlowList.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeControlFlowList.java @@ -61,28 +61,14 @@ public RuntimeControlFlowList(RuntimeScalar codeRef, RuntimeArray args, String f * @param evalScope The eval scope type ("eval-block", "eval-string", or null if not in eval) */ public RuntimeControlFlowList(RuntimeScalar codeRef, RuntimeArray args, String fileName, int lineNumber, String evalScope) { + this(codeRef, args, fileName, lineNumber, evalScope, null); + } + + public RuntimeControlFlowList(RuntimeScalar codeRef, RuntimeArray args, String fileName, int lineNumber, + String evalScope, String namedTarget) { super(); - // Validate that the code reference is defined before creating the tail call marker - // This produces the "Goto undefined subroutine" error at the goto site, matching Perl semantics - // BUT: we must allow undefined subs if AUTOLOAD exists in the package - if (codeRef.type == RuntimeScalarType.CODE) { - RuntimeCode code = (RuntimeCode) codeRef.value; - // Run compilerSupplier if present - if (code.compilerSupplier != null) { - code.compilerSupplier.get(); - } - if (!code.defined() && !RuntimeCode.hasAutoload(code)) { - String fullSubName = code.packageName != null && code.subName != null - ? code.packageName + "::" + code.subName - : ""; - throw new PerlCompilerException("Goto undefined subroutine &" + fullSubName); - } - } - // Check eval context AFTER sub validation - Perl 5 checks undefined sub first - if (evalScope != null) { - throw new PerlCompilerException("Can't goto subroutine from an " + evalScope); - } - this.marker = new ControlFlowMarker(retainTailCallCodeRef(codeRef), args, fileName, lineNumber); + this.marker = new ControlFlowMarker(retainTailCallCodeRef(codeRef), args, fileName, lineNumber, + namedTarget, evalScope); this.returnValue = null; if (DEBUG_TAILCALL) { System.err.println("[DEBUG-0b] RuntimeControlFlowList constructor (codeRef,args): codeRef=" + codeRef + diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeGlob.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeGlob.java index 9a78339da..125039747 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeGlob.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeGlob.java @@ -1559,16 +1559,13 @@ public RuntimeGlob undefine() { GlobalVariable.aliasGlobalVariable(this.globName, new RuntimeScalar()); // Undefine ARRAY - Perl detaches the AV from the typeglob, so - // `defined *Pkg::name{ARRAY}` becomes false afterwards. The container - // itself only dies when nothing else refers to it; when a Perl-level - // reference was taken (\@Pkg::name) the body must survive so that - // re-installing it through `*Pkg::name = $ref` restores the contents - // (Symbol::Util::delete_glob backs slots up exactly this way). - // With no outstanding reference, clear the old array first so blessed - // elements still run DESTROY via MortalList. + // `defined *Pkg::name{ARRAY}` becomes false afterwards. The container + // itself only dies when nothing else refers to it; a Perl-level + // reference must retain the body so installing it through + // `*Pkg::name = $ref` restores the contents. RuntimeArray oldArray = GlobalVariable.globalArrays.remove(this.globName); if (oldArray != null && oldArray.refCount == -1) oldArray.undefine(); - // Keep an empty @ISA slot after undefining a glob. A later + // Keep an empty @ISA slot after undefining a glob. A later // `*Class::ISA = *Empty` must alias that empty source rather than // rediscovering Class's former inheritance array through the alias // group. @@ -1579,7 +1576,7 @@ public RuntimeGlob undefine() { } GlobalVariable.invalidatePackageRootSnapshot(); - // Undefine HASH - same reasoning as ARRAY above. + // HASH follows the same detached-but-live-reference semantics. RuntimeHash oldHash = GlobalVariable.globalHashes.remove(this.globName); if (oldHash != null && oldHash.refCount == -1) oldHash.undefine(); GlobalVariable.invalidatePackageRootSnapshot(); diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java index 848748d0d..61ce4af50 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java @@ -212,6 +212,10 @@ private static boolean mightBeInteger(String s) { /** Active call-frame provenance for copies extracted from aliased arguments. */ private Object copiedFromArgumentFrame; + boolean copiedFromArgumentFrame(Object frame) { + return frame != null && copiedFromArgumentFrame == frame; + } + /** * When {@link #type} is {@link RuntimeScalarType#STRING}, true if this value was produced by * {@code Encode::_utf8_on} on a {@link RuntimeScalarType#BYTE_STRING} without decoding octets. diff --git a/src/test/resources/unit/closed_stderr_unhandled_die.t b/src/test/resources/unit/closed_stderr_unhandled_die.t new file mode 100644 index 000000000..1b76a4b04 --- /dev/null +++ b/src/test/resources/unit/closed_stderr_unhandled_die.t @@ -0,0 +1,16 @@ +use strict; +use warnings; +use Test::More tests => 2; +use IPC::Open3; +use Symbol qw(gensym); + +my $err = gensym(); +my $out = gensym(); +my $pid = open3(undef, $out, $err, $^X, '-e', 'close STDERR; die;'); +local $/; +my $stdout = <$out> // ''; +my $stderr = <$err> // ''; +waitpid($pid, 0); + +is($stdout, '', 'closed STDERR does not leak an unhandled die to stdout'); +is($stderr, '', 'closed STDERR suppresses the unhandled die diagnostic'); diff --git a/src/test/resources/unit/file_temp_stat_mode.t b/src/test/resources/unit/file_temp_stat_mode.t new file mode 100644 index 000000000..44c27b78f --- /dev/null +++ b/src/test/resources/unit/file_temp_stat_mode.t @@ -0,0 +1,18 @@ +use strict; +use warnings; +use Test::More; +use File::Temp qw(tempfile); + +my ($fh, $path) = tempfile('perlonjava-file-temp-XXXXXX', UNLINK => 0); +my @handle_stat = stat $fh; +my @path_stat = stat $path; + +is($handle_stat[0], $path_stat[0], 'tempfile handle and path have the same device'); +is($handle_stat[1], $path_stat[1], 'tempfile handle and path have the same inode'); +is($handle_stat[2], $path_stat[2], 'tempfile handle and path have the same mode'); +is($handle_stat[3], $path_stat[3], 'tempfile handle and path have the same link count'); + +close $fh; +unlink $path; + +done_testing; diff --git a/src/test/resources/unit/goto_tailcall_cleanup.t b/src/test/resources/unit/goto_tailcall_cleanup.t new file mode 100644 index 000000000..5d2a837da --- /dev/null +++ b/src/test/resources/unit/goto_tailcall_cleanup.t @@ -0,0 +1,113 @@ +use strict; +use warnings; +use Test::More; + +{ + package GotoCleanupTarget; + sub target { } + sub DESTROY { undef &target } + eval { sub { my $guard = bless []; goto &target }->() }; + ::like($@, qr/^Goto undefined subroutine &GotoCleanupTarget::target at /, + 'goto reports a target undefed during source cleanup'); +} + +{ + package GotoCleanupDestroy; + our @destroyed; + sub DESTROY { push @destroyed, $_[0][0] } + sub target { } + sub trampoline { + push @_, 'sentinel'; + goto ⌖ + } + trampoline(bless [$_]) for 1 .. 3; + ::is_deeply(\@destroyed, [1, 2, 3], + 'goto releases temporary incoming arguments at each tail call'); +} + +{ + package GotoCleanupStatementBoundary; + our ($iteration, @destroyed); + sub DESTROY { push @destroyed, $_[0][0] } + sub target { + ::is(scalar @destroyed, $iteration - 1, + 'goto destroys the prior call temporary before the next target'); + } + sub trampoline { + push @_, 'sentinel', {}; + goto ⌖ + } + for $iteration (1 .. 3) { + trampoline(bless([$iteration], 'GotoCleanupStatementBoundary'), 'argument'); + } + ::is_deeply(\@destroyed, [1, 2, 3], + 'goto destroys each argument temporary at its completed handoff'); +} + +{ + package GotoCleanupEval; + sub target { } + eval 'goto &target'; + ::like($@, qr/^Can't goto subroutine from an eval-string/, + 'goto reports the eval-string restriction'); +} + +{ + package GotoCleanupDynamicEval; + sub TIESCALAR { bless [pop] } + sub FETCH { $_[0][0] } + tie my $target, 'GotoCleanupDynamicEval', sub { 'dynamic tail target' }; + ::is(eval { sub { goto $target }->() }, 'dynamic tail target', + 'dynamic goto in a normal sub remains valid when called from eval'); +} + +package main; + +{ + use utf8; + eval { goto &因 }; + ::like($@, qr/Goto undefined subroutine &main::因/, + 'eval block catches an undefined Unicode goto target'); +} + +{ + package GotoCleanupAutoload; + our $called; + our $AUTOLOAD; + sub trampoline { goto &missing } + sub AUTOLOAD { $called = $AUTOLOAD } + trampoline('argument'); + ::is($called, 'GotoCleanupAutoload::missing', + 'goto resolves a named target through AUTOLOAD after source cleanup'); +} + +{ + no warnings 'uninitialized'; + my $source = sub { goto &utf8::encode }; + local @_ = (); + $#_++; + &$source; + ::is($_[0], '', 'goto to utf8::encode reifies a sparse argument slot'); +} + +{ + package GotoCleanupSlots; + our $absent_after_undef; + my $source = sub { goto sub { $absent_after_undef = !defined *_{ARRAY} } }; + undef *_; + eval { &$source }; + ::ok($absent_after_undef, + 'goto preserves an absent ARRAY slot after undef glob'); +} + +{ + sub { + local *_; + goto sub { ::is(*_{ARRAY}, undef, + 'goto preserves an absent ARRAY slot after local glob') }; + }->(); +} + +package main; + +done_testing; diff --git a/src/test/resources/unit/goto_tailcall_core_destroy_order.t b/src/test/resources/unit/goto_tailcall_core_destroy_order.t new file mode 100644 index 000000000..7a4672e00 --- /dev/null +++ b/src/test/resources/unit/goto_tailcall_core_destroy_order.t @@ -0,0 +1,24 @@ +use strict; +use warnings; + +my $test = 1; +sub is ($$) { + my ($got, $expected) = @_; + if (defined($got) && defined($expected) && $got eq $expected) { + print "ok $test\n"; + } else { + print "not ok $test - got ", (defined $got ? $got : 'undef'), + ", expected ", (defined $expected ? $expected : 'undef'), "\n"; + } + $test++; +} + +print "1..6\n"; +{ + my $i; + package Foo; + sub DESTROY { my $self = shift; ::is($self->[0], $i) } + sub show { ::is(+@_, 5) } + sub start { push @_, 1, 'foo', {}; goto &show } + for (1 .. 3) { $i = $_; start(bless([$_]), 'bar') } +} diff --git a/src/test/resources/unit/top_level_coderef_call.t b/src/test/resources/unit/top_level_coderef_call.t new file mode 100644 index 000000000..92c9f7b0f --- /dev/null +++ b/src/test/resources/unit/top_level_coderef_call.t @@ -0,0 +1,18 @@ +use strict; +use warnings; +use Test::More; + +my $called = 0; +&{sub { $called = 1 }}; +is($called, 1, 'top-level &{sub {...}} invokes the anonymous coderef'); + +my $value = &{sub { 'value from anonymous coderef' }}; +is($value, 'value from anonymous coderef', + 'top-level &{sub {...}} returns the anonymous coderef value'); + +my $reference = \&{sub { 'reference-only anonymous coderef' }}; +is(ref($reference), 'CODE', '\\&{sub {...}} takes an anonymous coderef'); +is($reference->(), 'reference-only anonymous coderef', + '\\&{sub {...}} defers invocation until called'); + +done_testing;