From a6dbc2ae084ee5b52ba2baf0019b9e300781efbf Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Sat, 24 Oct 2026 14:32:35 +0200 Subject: [PATCH 1/3] fix: warn on undefined right operand of concat assignment Match Perl's `.=` warning behavior while keeping an undefined left operand quiet. Add system-Perl-compatible coverage for warnings, fatal warnings, source locations, and localized STDOUT capture. Generated with [Codex](https://openai.com/codex) Co-Authored-By: Codex <158243242+codex@users.noreply.github.com> --- docs/about/changelog.md | 1 + .../runtime/operators/StringOperators.java | 19 +++++--- .../unit/concat_assign_rhs_undef_warning.t | 45 +++++++++++++++++++ .../unit/io_localized_stdout_capture.t | 17 +++++++ 4 files changed, 76 insertions(+), 6 deletions(-) create mode 100644 src/test/resources/unit/concat_assign_rhs_undef_warning.t create mode 100644 src/test/resources/unit/io_localized_stdout_capture.t diff --git a/docs/about/changelog.md b/docs/about/changelog.md index 0b1ced7ae1..814052a5f2 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -6,6 +6,7 @@ priorities and future plans. ## Work in progress +- Warn for undefined right operands of `.=` while keeping an undefined left operand quiet (#1382). - Snapshot mutable array entries while marking package roots and during reachability walks so concurrent thread teardown cannot fail with `ConcurrentModificationException`. - Enforce restricted-hash key access and implement `Hash::Util` key, value, and hash locking (#1502, #1172). diff --git a/src/main/java/org/perlonjava/runtime/operators/StringOperators.java b/src/main/java/org/perlonjava/runtime/operators/StringOperators.java index 18c705684d..52b95613bb 100644 --- a/src/main/java/org/perlonjava/runtime/operators/StringOperators.java +++ b/src/main/java/org/perlonjava/runtime/operators/StringOperators.java @@ -594,9 +594,9 @@ public static RuntimeScalar stringConcat(RuntimeScalar runtimeScalar, RuntimeSca /** * Implements {@code .=}. Perl treats an undefined left operand as the empty - * string without issuing the uninitialized warning that ordinary {@code .} - * emits. Keep this as a distinct entry point so eval-time warning changes do - * not turn concat-assignment into warning-aware concatenation. + * string without a warning, but still warns when the right operand is + * undefined. Keep the two warning checks separate from ordinary {@code .} + * so eval-time warning changes preserve that distinction. */ public static RuntimeScalar stringConcatAssign(RuntimeScalar runtimeScalar, RuntimeScalar b) { // Typeglobs stringify when merely observed, but they cannot be used as @@ -626,7 +626,7 @@ public static RuntimeScalar stringConcatAssign(RuntimeScalar runtimeScalar, Runt && runtimeScalar.type != RuntimeScalarType.BYTE_STRING) || (b.type != RuntimeScalarType.STRING && b.type != RuntimeScalarType.BYTE_STRING)) { - return stringConcat(runtimeScalar, b, false); + return stringConcat(runtimeScalar, b, false, true); } String bStr = b.toString(); @@ -640,6 +640,12 @@ public static RuntimeScalar stringConcatAssign(RuntimeScalar runtimeScalar, Runt private static RuntimeScalar stringConcat(RuntimeScalar runtimeScalar, RuntimeScalar b, boolean warnUninitialized) { + return stringConcat(runtimeScalar, b, warnUninitialized, warnUninitialized); + } + + private static RuntimeScalar stringConcat(RuntimeScalar runtimeScalar, RuntimeScalar b, + boolean warnLeftUninitialized, + boolean warnRightUninitialized) { RuntimeScalar overloaded = tryStringConcatOverload(runtimeScalar, b); if (overloaded != null) return overloaded; @@ -654,8 +660,9 @@ private static RuntimeScalar stringConcat(RuntimeScalar runtimeScalar, RuntimeSc boolean callSiteWarnsUninitialized = callSiteWarningBits == null || WarningFlags.areWarningsForcedOn() || WarningFlags.isEnabledInBits(callSiteWarningBits, "uninitialized"); - if (warnUninitialized && callSiteWarnsUninitialized - && (!aResolved.getDefinedBoolean() || !bResolved.getDefinedBoolean())) { + boolean leftIsUndefined = warnLeftUninitialized && !aResolved.getDefinedBoolean(); + boolean rightIsUndefined = warnRightUninitialized && !bResolved.getDefinedBoolean(); + if (callSiteWarnsUninitialized && (leftIsUndefined || rightIsUndefined)) { WarnDie.warnWithCategory( new RuntimeScalar("Use of uninitialized value in concatenation (.)"), RuntimeScalarCache.scalarEmptyString, "uninitialized"); diff --git a/src/test/resources/unit/concat_assign_rhs_undef_warning.t b/src/test/resources/unit/concat_assign_rhs_undef_warning.t new file mode 100644 index 0000000000..592579d3d7 --- /dev/null +++ b/src/test/resources/unit/concat_assign_rhs_undef_warning.t @@ -0,0 +1,45 @@ +use strict; +use warnings; +use Test::More tests => 5; + +my @warnings; +my $output = 'prefix'; +my $missing; +{ + local $SIG{__WARN__} = sub { push @warnings, @_ }; + $output .= $missing; +} +like(join('', @warnings), qr/Use of uninitialized value.*concatenation/, + '.= warns when its right operand is undefined'); +is($output, 'prefix', '.= keeps the defined left value when its right side is undef'); + +@warnings = (); +my $undefined_output; +{ + local $SIG{__WARN__} = sub { push @warnings, @_ }; + $undefined_output .= 'value'; +} +is_deeply(\@warnings, [], '.= does not warn for an undefined left operand'); + +# Exercise warning locations in generated template code. +#line 1 "generated-template.html" +my $template_output = ''; +my $template_value; +{ + local $SIG{__WARN__} = sub { push @warnings, @_ }; + $template_output .= $template_value; +} +like(join('', @warnings), qr/at generated-template\.html line 5\./, + '.= warning retains a generated source location'); + +my $fatal_error; +{ + use warnings FATAL => qw(uninitialized); + my $fatal_output = 'prefix'; + my $fatal_value; + eval { $fatal_output .= $fatal_value }; + $fatal_error = $@; +} +like($fatal_error, qr/Use of uninitialized value.*concatenation/, + 'fatal uninitialized warning from .= throws'); + diff --git a/src/test/resources/unit/io_localized_stdout_capture.t b/src/test/resources/unit/io_localized_stdout_capture.t new file mode 100644 index 0000000000..f65d19fc02 --- /dev/null +++ b/src/test/resources/unit/io_localized_stdout_capture.t @@ -0,0 +1,17 @@ +use strict; +use warnings; +use Test::More tests => 1; +use File::Temp qw(tempfile); + +my ($capture, $path) = tempfile(UNLINK => 1); +{ + local *STDOUT; + open STDOUT, '>>', $path or die "open captured STDOUT: $!"; + print "captured through localized STDOUT\n"; +} + +seek $capture, 0, 0 or die "seek capture file: $!"; +my $captured = <$capture>; +is($captured, "captured through localized STDOUT\n", + 'implicit print follows a localized and reopened STDOUT glob'); + From ff827e4e21959269c5babcf7c7b683eb2926d066 Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Sat, 24 Oct 2026 17:43:48 +0200 Subject: [PATCH 2/3] fix: preserve nested Rose form argument ownership Keep intermediate list-valued call results alive with counted scalar owners while later argument expressions run. This preserves Rose form weak parent links until add_forms consumes its arguments. Add regression coverage for nested weak parent links and qualified form and field names, and record the Rose fix in the changelog. Generated with [OpenAI Codex](https://openai.com/codex) Co-Authored-By: OpenAI Codex --- docs/about/changelog.md | 1 + .../backend/bytecode/BytecodeCompiler.java | 17 ++ .../backend/bytecode/BytecodeInterpreter.java | 37 ++- .../bytecode/CompileBinaryOperator.java | 10 +- .../backend/bytecode/Disassemble.java | 14 ++ .../perlonjava/backend/bytecode/Opcodes.java | 6 + .../perlonjava/backend/jvm/Dereference.java | 13 +- .../runtimetypes/ExecutionRuntimeState.java | 3 + .../runtimetypes/LifecycleRuntimeState.java | 2 + .../runtime/runtimetypes/MortalList.java | 50 +++- .../runtime/runtimetypes/RuntimeCode.java | 173 +++++++++++++ .../unit/weak_nested_form_argument_lifetime.t | 229 ++++++++++++++++++ 12 files changed, 537 insertions(+), 18 deletions(-) create mode 100644 src/test/resources/unit/weak_nested_form_argument_lifetime.t diff --git a/docs/about/changelog.md b/docs/about/changelog.md index 814052a5f2..3d07c844e9 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -6,6 +6,7 @@ priorities and future plans. ## Work in progress +- Keep nested Rose::HTML::Objects form results alive with counted argument owners so weak parent links and qualified field names survive argument evaluation (#1851). - Warn for undefined right operands of `.=` while keeping an undefined left operand quiet (#1382). - Snapshot mutable array entries while marking package roots and during reachability walks so concurrent thread teardown cannot fail with `ConcurrentModificationException`. diff --git a/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java b/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java index e64b5a131b..64db38185f 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java +++ b/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java @@ -6738,6 +6738,23 @@ void emitAliasWithTarget(int destReg, int srcReg) { } } + int compileCallArguments(Node argsNode) { + List arguments = argsNode instanceof ListNode list + ? list.elements : (argsNode == null ? List.of() : List.of(argsNode)); + int argsReg = allocateRegister(); + emit(Opcodes.NEW_CALL_ARGUMENTS); + emitReg(argsReg); + emit(arguments.size()); + for (Node argument : arguments) { + compileNode(argument, -1, RuntimeContextType.LIST); + int valueReg = lastResultReg; + emit(Opcodes.ADD_CALL_ARGUMENT); + emitReg(argsReg); + emitReg(valueReg); + } + return argsReg; + } + void compileNode(Node node, int targetReg, int callContext) { if (node == null) { // Skip null nodes (e.g., from format declarations that produce empty statements) diff --git a/src/main/java/org/perlonjava/backend/bytecode/BytecodeInterpreter.java b/src/main/java/org/perlonjava/backend/bytecode/BytecodeInterpreter.java index eb98acc7c9..9de201e79b 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/BytecodeInterpreter.java +++ b/src/main/java/org/perlonjava/backend/bytecode/BytecodeInterpreter.java @@ -2056,9 +2056,14 @@ private static RuntimeList execute(SuspendedInterpreterFrame frame) { } RuntimeBase argsBase = registers[argsReg]; + RuntimeCode.CallArguments stagedArgs = + argsBase instanceof RuntimeCode.CallArguments staged + ? staged : null; RuntimeArray callArgs; - if (argsBase instanceof RuntimeArray) { + if (stagedArgs != null) { + callArgs = null; + } else if (argsBase instanceof RuntimeArray) { callArgs = (RuntimeArray) argsBase; } else if (argsBase instanceof RuntimeList) { if (((RuntimeList) argsBase).elements.size() == 1 @@ -2083,7 +2088,11 @@ private static RuntimeList execute(SuspendedInterpreterFrame frame) { // establishes mortal marks, warning/hint stacks, args-stack state, // and void-result cleanup. Bypassing it keeps scope temporaries alive // in large-code interpreter fallbacks (Net::LDAP ref-loop cleanup). - if (shareArgs) { + if (stagedArgs != null) { + result = shareArgs + ? RuntimeCode.apply(codeRef, stagedArgs, context) + : RuntimeCode.apply(codeRef, "", stagedArgs, context); + } else if (shareArgs) { result = RuntimeCode.apply(codeRef, callArgs, context); } else { result = RuntimeCode.apply(codeRef, "", callArgs, context); @@ -2256,9 +2265,14 @@ private static RuntimeList execute(SuspendedInterpreterFrame frame) { RuntimeScalar method = registers[methodReg].scalar(); RuntimeScalar currentSub = registers[currentSubReg].scalar(); RuntimeBase argsBase = registers[argsReg]; + RuntimeCode.CallArguments stagedArgs = + argsBase instanceof RuntimeCode.CallArguments staged + ? staged : null; RuntimeArray callArgs; - if (argsBase instanceof RuntimeArray) { + if (stagedArgs != null) { + callArgs = null; + } else if (argsBase instanceof RuntimeArray) { callArgs = (RuntimeArray) argsBase; } else if (argsBase instanceof RuntimeList) { callArgs = new RuntimeArray(); @@ -2274,7 +2288,9 @@ private static RuntimeList execute(SuspendedInterpreterFrame frame) { CallerStack.pushLazy(lazyPkg, () -> getCallSiteInfo(code, lazyPc, lazyPkg)); RuntimeList result; try { - result = RuntimeCode.call(invocant, method, currentSub, callArgs, context); + result = stagedArgs == null + ? RuntimeCode.call(invocant, method, currentSub, callArgs, context) + : RuntimeCode.call(invocant, method, currentSub, stagedArgs, context); // Keep method calls on the shared tail-call handoff as well. result = RuntimeCode.resolveTailCalls(result, context); @@ -3020,6 +3036,19 @@ private static RuntimeList execute(SuspendedInterpreterFrame frame) { pc = InlineOpcodeHandler.executeCreateList(bytecode, pc, registers); } + case Opcodes.NEW_CALL_ARGUMENTS -> { + int rd = bytecode[pc++]; + int capacity = bytecode[pc++]; + registers[rd] = RuntimeCode.newCallArguments(capacity); + } + + case Opcodes.ADD_CALL_ARGUMENT -> { + int argsReg = bytecode[pc++]; + int valueReg = bytecode[pc++]; + ((RuntimeCode.CallArguments) registers[argsReg]) + .add((RuntimeBase) registers[valueReg]); + } + case Opcodes.SCALAR_IF_WANTARRAY -> { pc = InlineOpcodeHandler.executeScalarIfWantarray(bytecode, pc, registers, callContext); } diff --git a/src/main/java/org/perlonjava/backend/bytecode/CompileBinaryOperator.java b/src/main/java/org/perlonjava/backend/bytecode/CompileBinaryOperator.java index f97a20074e..357aedf823 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/CompileBinaryOperator.java +++ b/src/main/java/org/perlonjava/backend/bytecode/CompileBinaryOperator.java @@ -237,8 +237,7 @@ else if (node.right instanceof ListNode) { bytecodeCompiler.compileNode(node.left, -1, RuntimeContextType.SCALAR); int coderefReg = bytecodeCompiler.lastResultReg; - bytecodeCompiler.compileNode(node.right, -1, RuntimeContextType.LIST); - int argsReg = bytecodeCompiler.lastResultReg; + int argsReg = bytecodeCompiler.compileCallArguments(node.right); // Allocate result register int rd = bytecodeCompiler.allocateOutputRegister(); @@ -344,8 +343,7 @@ else if (node.right instanceof BinaryOperatorNode rightCall) { bytecodeCompiler.emit(subIdx); // Compile arguments in list context - bytecodeCompiler.compileNode(argsNode, -1, RuntimeContextType.LIST); - int argsReg = bytecodeCompiler.lastResultReg; + int argsReg = bytecodeCompiler.compileCallArguments(argsNode); // Allocate result register int rd = bytecodeCompiler.allocateOutputRegister(); @@ -574,12 +572,12 @@ && unwrapScalarAnonymousInvocation(outerArgs.elements.get(0)) instanceof BinaryO if (savedCallerLineOverride <= 0 && node.left != null && node.left.getIndex() > 0) { bytecodeCompiler.callerLineTokenOverride = node.left.getIndex(); } + int rs2; try { - bytecodeCompiler.compileNode(node.right, -1, RuntimeContextType.LIST); + rs2 = bytecodeCompiler.compileCallArguments(node.right); } finally { bytecodeCompiler.callerLineTokenOverride = savedCallerLineOverride; } - int rs2 = bytecodeCompiler.lastResultReg; // Check if this is a &func (no parens) call that should share caller's @_ boolean shareCallerArgs = node.getBooleanAnnotation("shareCallerArgs"); diff --git a/src/main/java/org/perlonjava/backend/bytecode/Disassemble.java b/src/main/java/org/perlonjava/backend/bytecode/Disassemble.java index 82d44f6003..443ade7f68 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/Disassemble.java +++ b/src/main/java/org/perlonjava/backend/bytecode/Disassemble.java @@ -1263,6 +1263,20 @@ public static String disassemble(InterpretedCode interpretedCode) { sb.append("]\n"); break; } + case Opcodes.NEW_CALL_ARGUMENTS: { + rd = interpretedCode.bytecode[pc++]; + int argumentCapacity = interpretedCode.bytecode[pc++]; + sb.append("NEW_CALL_ARGUMENTS r").append(rd) + .append(" capacity=").append(argumentCapacity).append("\n"); + break; + } + case Opcodes.ADD_CALL_ARGUMENT: { + int stagedArgsReg = interpretedCode.bytecode[pc++]; + int stagedValueReg = interpretedCode.bytecode[pc++]; + sb.append("ADD_CALL_ARGUMENT r").append(stagedArgsReg) + .append(" <- r").append(stagedValueReg).append("\n"); + break; + } case Opcodes.CALL_SUB: case Opcodes.CALL_SUB_SHARE_ARGS: rd = interpretedCode.bytecode[pc++]; diff --git a/src/main/java/org/perlonjava/backend/bytecode/Opcodes.java b/src/main/java/org/perlonjava/backend/bytecode/Opcodes.java index 5ae5f7b66f..2f18b0ca5d 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/Opcodes.java +++ b/src/main/java/org/perlonjava/backend/bytecode/Opcodes.java @@ -2148,6 +2148,12 @@ public class Opcodes { */ public static final short CALL_SUB_SHARE_ARGS = 401; + /** Start collecting evaluated call arguments with temporary lifetimes. */ + public static final short NEW_CALL_ARGUMENTS = 637; + + /** Append one evaluated expression to a staged call-argument list. */ + public static final short ADD_CALL_ARGUMENT = 638; + // Missing system operators needed for interpreter fallback of large files (e.g. taint.t) public static final short SYMLINK = 402; public static final short CHROOT = 403; diff --git a/src/main/java/org/perlonjava/backend/jvm/Dereference.java b/src/main/java/org/perlonjava/backend/jvm/Dereference.java index c0940ac5df..95dbea6751 100644 --- a/src/main/java/org/perlonjava/backend/jvm/Dereference.java +++ b/src/main/java/org/perlonjava/backend/jvm/Dereference.java @@ -1084,8 +1084,9 @@ static void handleArrowOperator(EmitterVisitor emitterVisitor, BinaryOperatorNod } else { if (argCount <= 127) mv.visitIntInsn(Opcodes.BIPUSH, argCount); else mv.visitIntInsn(Opcodes.SIPUSH, argCount); - mv.visitTypeInsn(Opcodes.ANEWARRAY, - "org/perlonjava/runtime/runtimetypes/RuntimeBase"); + mv.visitMethodInsn(Opcodes.INVOKESTATIC, + "org/perlonjava/runtime/runtimetypes/RuntimeCode", "newCallArguments", + "(I)Lorg/perlonjava/runtime/runtimetypes/RuntimeCode$CallArguments;", false); mv.visitVarInsn(Opcodes.ASTORE, argsArraySlot); for (int index = 0; index < argCount; index++) { @@ -1095,10 +1096,10 @@ static void handleArrowOperator(EmitterVisitor emitterVisitor, BinaryOperatorNod paramList.elements.get(index).accept(listVisitor); mv.visitVarInsn(Opcodes.ASTORE, argSlot); mv.visitVarInsn(Opcodes.ALOAD, argsArraySlot); - if (index <= 127) mv.visitIntInsn(Opcodes.BIPUSH, index); - else mv.visitIntInsn(Opcodes.SIPUSH, index); mv.visitVarInsn(Opcodes.ALOAD, argSlot); - mv.visitInsn(Opcodes.AASTORE); + mv.visitMethodInsn(Opcodes.INVOKEVIRTUAL, + "org/perlonjava/runtime/runtimetypes/RuntimeCode$CallArguments", "add", + "(Lorg/perlonjava/runtime/runtimetypes/RuntimeBase;)V", false); if (pooledArg) emitterVisitor.ctx.javaClassInfo.releaseSpillSlot(); } } @@ -1147,7 +1148,7 @@ static void handleArrowOperator(EmitterVisitor emitterVisitor, BinaryOperatorNod } String argsDescriptor = directRuntimeArray ? "Lorg/perlonjava/runtime/runtimetypes/RuntimeArray;" - : "[Lorg/perlonjava/runtime/runtimetypes/RuntimeBase;"; + : "Lorg/perlonjava/runtime/runtimetypes/RuntimeCode$CallArguments;"; mv.visitMethodInsn( Opcodes.INVOKESTATIC, "org/perlonjava/runtime/runtimetypes/RuntimeCode", diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/ExecutionRuntimeState.java b/src/main/java/org/perlonjava/runtime/runtimetypes/ExecutionRuntimeState.java index c7effab7c7..87c4d3a9e0 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/ExecutionRuntimeState.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/ExecutionRuntimeState.java @@ -72,6 +72,9 @@ public final class ExecutionRuntimeState { public final Deque activeEvalSources = new ArrayDeque<>(); public final ArrayDeque> syntheticCallerFrames = new ArrayDeque<>(); public final Deque argsStack = new ArrayDeque<>(); + /** Weak roots for JVM call arguments while their expressions are evaluated. */ + final ArrayList> callArgumentFrames = + new ArrayList<>(); public final Deque activeCodeStack = new ArrayDeque<>(); /** Perl source callsites aligned with the active Perl code frames. */ public final Deque activeCodeCallSites = new ArrayDeque<>(); diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/LifecycleRuntimeState.java b/src/main/java/org/perlonjava/runtime/runtimetypes/LifecycleRuntimeState.java index fe6324b1d2..1e1390b7a5 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/LifecycleRuntimeState.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/LifecycleRuntimeState.java @@ -27,6 +27,8 @@ final class LifecycleRuntimeState { // 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<>(); + final ArrayList deferredArgumentOwnerReleases = + new ArrayList<>(); final ArrayList pendingTiedReleases = new ArrayList<>(); final ArrayList pendingIoReleases = new ArrayList<>(); final ArrayList deferredCaptures = new ArrayList<>(); diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/MortalList.java b/src/main/java/org/perlonjava/runtime/runtimetypes/MortalList.java index 9488f1261e..3f496e2b6f 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/MortalList.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/MortalList.java @@ -22,6 +22,23 @@ public class MortalList { private static final int MAX_UNBLESSED_AGGREGATE_DRAIN_ROOTS = 50_000; private static final AtomicInteger runtimesWithBoundaryWork = new AtomicInteger(); + static final class DeferredArgumentOwnerRelease { + final RuntimeBase base; + final RuntimeBase.PendingOwnerRelease ownerRelease; + final String transientOwnerKind; + final java.lang.ref.WeakReference ownerScalar; + + DeferredArgumentOwnerRelease(RuntimeBase base, + RuntimeBase.PendingOwnerRelease ownerRelease, + String transientOwnerKind, + RuntimeScalar ownerScalar) { + this.base = base; + this.ownerRelease = ownerRelease; + this.transientOwnerKind = transientOwnerKind; + this.ownerScalar = new java.lang.ref.WeakReference<>(ownerScalar); + } + } + static final class ReachabilityQueryMeasurement implements AutoCloseable { private final LifecycleRuntimeState state; private final ReachabilityQueryStats stats; @@ -1220,8 +1237,19 @@ private static void processDeferredEntriesFrom( RuntimeBase.PendingOwnerRelease ownerRelease = state.pendingOwnerReleases.get(pendingIdx); String transientOwnerKind = state.pendingTransientOwnerKinds.get(pendingIdx); - processDeferredBase(state.pending.get(pendingIdx++), false, ownerRelease, - transientOwnerKind); + RuntimeBase base = state.pending.get(pendingIdx); + java.lang.ref.WeakReference ownerRef = + state.pendingOwnerScalars.get(pendingIdx++); + RuntimeScalar ownerScalar = ownerRef == null ? null : ownerRef.get(); + if (base.blessId != 0 + && WeakRefRegistry.hasWeakRefsTo(base) + && RuntimeCode.hasActiveArgumentOwner(ownerScalar)) { + state.deferredArgumentOwnerReleases.add( + new DeferredArgumentOwnerRelease(base, ownerRelease, + transientOwnerKind, ownerScalar)); + } else { + processDeferredBase(base, false, ownerRelease, transientOwnerKind); + } } while (ioReleaseIdx < state.pendingIoReleases.size()) { RuntimeScalar.releaseIoOwner(state.pendingIoReleases.get(ioReleaseIdx++)); @@ -1231,6 +1259,24 @@ private static void processDeferredEntriesFrom( state.reachabilityDrainDepth--; state.deferCaptureReachabilityToBoundarySweep = previousCaptureSweepDeferral; } + drainDeferredArgumentOwnerReleases(); + } + + static void drainDeferredArgumentOwnerReleases() { + LifecycleRuntimeState state = state(); + if (state.deferredArgumentOwnerReleases.isEmpty()) return; + ArrayList pending = + new ArrayList<>(state.deferredArgumentOwnerReleases); + state.deferredArgumentOwnerReleases.clear(); + for (DeferredArgumentOwnerRelease deferred : pending) { + RuntimeScalar ownerScalar = deferred.ownerScalar.get(); + if (RuntimeCode.hasActiveArgumentOwner(ownerScalar)) { + state.deferredArgumentOwnerReleases.add(deferred); + } else { + processDeferredBase(deferred.base, false, deferred.ownerRelease, + deferred.transientOwnerKind); + } + } } private static void finalizeDeferredCaptureSweepCandidates( diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java index e990aa35c7..9d02b3bef6 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java @@ -75,6 +75,128 @@ private record SortComparatorFrame(RuntimeCode comparator, int entryDepth) {} private static final ThreadLocal> sortComparatorFrames = ThreadLocal.withInitial(ArrayDeque::new); + /** Values staged while a JVM call site's argument expressions are evaluated. */ + public static final class CallArguments extends RuntimeScalar { + private final RuntimeBase[] values; + private final java.util.ArrayList listResultOwners = new java.util.ArrayList<>(); + private int size; + private final ExecutionRuntimeState ownerState; + private final java.lang.ref.WeakReference registration; + + private CallArguments(int capacity) { + values = new RuntimeBase[Math.max(0, capacity)]; + ownerState = PerlRuntime.current().executionState(); + registration = new java.lang.ref.WeakReference<>(this); + ownerState.callArgumentFrames.add(registration); + } + + public void add(RuntimeBase value) { + if (size == values.length) { + throw new IllegalStateException("too many call arguments"); + } + values[size++] = value; + // A list-valued call result can hold a fresh object returned by + // an inline constructor. The Java staging array keeps that list + // reachable, but it is not a Perl owner and cannot protect the + // returned object's weak observers when later arguments run. + // Give strong references in staged list results ordinary scalar + // owner slots until the enclosing call has consumed its arguments. + if (size < values.length && value instanceof RuntimeList) { + retainListResultOwners(value); + } + } + + private void retainListResultOwners(RuntimeBase value) { + if (value instanceof RuntimeList list) { + for (RuntimeBase element : list.elements) { + retainListResultOwners(element); + } + } else if (value instanceof RuntimeScalar scalar + && scalar.value instanceof RuntimeBase base + && base.blessId != 0 + && WeakRefRegistry.hasWeakRefsTo(base) + && !WeakRefRegistry.isweak(scalar)) { + RuntimeScalar owner = new RuntimeScalar(); + owner.set(scalar); + listResultOwners.add(owner); + } + } + + private boolean containsReferent(RuntimeBase referent) { + for (int i = 0; i < size; i++) { + RuntimeBase value = values[i]; + if (argumentValueOwnsReferent(value, referent)) return true; + } + return false; + } + + private boolean argumentValueOwnsReferent(RuntimeBase value, RuntimeBase referent) { + if (value instanceof RuntimeScalar scalar) { + return scalar.value == referent && !WeakRefRegistry.isweak(scalar); + } + if (value instanceof RuntimeList list) { + for (RuntimeBase element : list.elements) { + if (argumentValueOwnsReferent(element, referent)) return true; + } + } else if (value instanceof RuntimeArray array) { + for (RuntimeScalar element : array.elements) { + if (argumentValueOwnsReferent(element, referent)) return true; + } + } else if (value instanceof RuntimeHash hash) { + for (RuntimeScalar element : hash.elements.values()) { + if (argumentValueOwnsReferent(element, referent)) return true; + } + } + return false; + } + + private RuntimeBase[] argumentValues() { + return Arrays.copyOf(values, size); + } + + public RuntimeArray toRuntimeArray() { + RuntimeArray args = new RuntimeArray(size); + for (RuntimeBase value : argumentValues()) { + value.setArrayOfAlias(args); + } + return args; + } + + public void finish() { + ownerState.callArgumentFrames.remove(registration); + for (RuntimeScalar owner : listResultOwners) { + owner.set((RuntimeScalar) null); + } + listResultOwners.clear(); + MortalList.drainDeferredArgumentOwnerReleases(); + } + } + + static boolean hasActiveArgumentOwner(RuntimeScalar scalar) { + if (scalar == null || !(scalar.value instanceof RuntimeBase referent)) return false; + ExecutionRuntimeState state = PerlRuntime.current().executionState(); + for (RuntimeArray args : state.argsStack) { + for (RuntimeScalar element : args.elements) { + if (element != null && element.value == referent + && !WeakRefRegistry.isweak(element)) return true; + } + } + for (int i = state.callArgumentFrames.size() - 1; i >= 0; i--) { + java.lang.ref.WeakReference reference = state.callArgumentFrames.get(i); + CallArguments frame = reference.get(); + if (frame == null) { + state.callArgumentFrames.remove(i); + } else if (frame.containsReferent(referent)) { + return true; + } + } + return false; + } + + public static CallArguments newCallArguments(int capacity) { + return new CallArguments(capacity); + } + /** * Guard for the generated read-only parameter-unpack fast path. The * runtime validates the argument/hash shape and overload state; stable @@ -1389,6 +1511,7 @@ private static void popArgs(ExecutionRuntimeState executionState) { if (!pStack.isEmpty()) { pStack.pop(); } + MortalList.drainDeferredArgumentOwnerReleases(); cleanupOwnedArgumentAliases(exitedArgs); drainDeferredArgumentAggregateCleanup(executionState); Deque haStack = executionState.hasArgsStack; @@ -5533,6 +5656,33 @@ public static RuntimeList callCached(int callsiteId, methodArgs, callContext); } + public static RuntimeList call(RuntimeScalar runtimeScalar, + RuntimeScalar method, + RuntimeScalar currentSub, + CallArguments args, + int callContext) { + try { + return call(runtimeScalar, method, currentSub, args.argumentValues(), callContext); + } finally { + args.finish(); + } + } + + /** Cached method-call entry for call-site values protected during evaluation. */ + public static RuntimeList callCached(int callsiteId, + RuntimeScalar runtimeScalar, + RuntimeScalar method, + RuntimeScalar currentSub, + CallArguments args, + int callContext) { + try { + return callCached(callsiteId, runtimeScalar, method, currentSub, + args.argumentValues(), callContext); + } finally { + args.finish(); + } + } + /** * Cached method-call entry for JVM call sites that have already expanded * evaluated arguments into their Perl {@code @_} array. @@ -7920,6 +8070,17 @@ public static RuntimeList apply(RuntimeScalar runtimeScalar, RuntimeArray a, int } // end while(true) } + /** Interpreter entry for arguments staged as their expressions were evaluated. */ + public static RuntimeList apply(RuntimeScalar runtimeScalar, + CallArguments args, + int callContext) { + try { + return apply(runtimeScalar, args.toRuntimeArray(), callContext); + } finally { + args.finish(); + } + } + /** Marks a direct {@code @array} argument source before a generated call. */ public static RuntimeBase markDirectArrayCallArgument(RuntimeBase argument) { if (argument instanceof RuntimeArray array) { @@ -8599,6 +8760,18 @@ public static RuntimeList apply(RuntimeScalar runtimeScalar, String subroutineNa throw invalidCodeReference(runtimeScalar); } + /** Interpreter entry for an explicitly named call with staged arguments. */ + public static RuntimeList apply(RuntimeScalar runtimeScalar, + String subroutineName, + CallArguments args, + int callContext) { + try { + return apply(runtimeScalar, subroutineName, args.argumentValues(), callContext); + } finally { + args.finish(); + } + } + /** * Resolve any pending TAILCALL markers in {@code result}, looping until * the call chain terminates or a non-TAILCALL marker is returned. diff --git a/src/test/resources/unit/weak_nested_form_argument_lifetime.t b/src/test/resources/unit/weak_nested_form_argument_lifetime.t new file mode 100644 index 0000000000..3e677e0d66 --- /dev/null +++ b/src/test/resources/unit/weak_nested_form_argument_lifetime.t @@ -0,0 +1,229 @@ +use strict; +use warnings; +use Scalar::Util qw(isweak); +use Test::More tests => 29; + +{ + package NestedForm::Field; + + sub new { + my ($class, $name) = @_; + return bless { name => $name }, $class; + } + + sub parent_form { + my ($self) = shift; + if (@_) { + if (ref $_[0]) { + Scalar::Util::weaken($self->{parent_form} = shift); + return $self->{parent_form}; + } + return $self->{parent_form} = shift; + } + return $self->{parent_form}; + } + + sub fq_moniker { + my ($self) = @_; + my $form = $self->parent_form; + my $context = $form ? $form->fq_form_name : ''; + return length($context) ? "$context.$self->{name}" : $self->{name}; + } +} + +{ + package NestedForm::Child; + + # Mirrors Rose::HTML::Form's inherited no-op DESTROY method. The runtime + # must defer this nested object's weak cleanup until its argument frame ends. + sub DESTROY { } + + sub new { + my ($class) = @_; + my $self = bless { fields => {} }, $class; + $self->build_form; + return $self; + } + + sub build_form { + my ($self) = @_; + my %fields = map { $_ => NestedForm::Field->new($_) } + qw(age name gender birth start); + $self->add_fields(%fields); + } + + sub add_fields { + my $self = shift; + while (@_) { + my $name = shift; + my $field = shift; + $field->parent_form($self); + $self->{fields}{$name} = $field; + $self->{fields_by_name}{$name} = $field; + } + } + + sub form_name { + my ($self) = shift; + $self->{form_name} = shift if @_; + return $self->{form_name}; + } + + sub parent_form { + my ($self) = shift; + if (@_) { + if (ref $_[0]) { + Scalar::Util::weaken($self->{parent_form} = shift); + return $self->{parent_form}; + } + return $self->{parent_form} = shift; + } + return $self->{parent_form}; + } + + sub rank { + my ($self, $rank) = @_; + $self->{rank} = $rank if @_ > 1; + return $self->{rank}; + } + + sub form_depth { + my ($self, $depth) = @_; + $self->{form_depth} = $depth if @_ > 1; + return $self->{form_depth}; + } + + sub resync_field_names { + my ($self) = @_; + $self->{field_names} = [ sort map { $_->fq_moniker } values %{ $self->{fields} } ]; + } + + sub fq_form_name { + my ($self) = @_; + return $self->form_name unless $self->parent_form; + my @parts; + my $form = $self; + while (my $parent = $form->parent_form) { + unshift @parts, $form->form_name; + $form = $parent; + } + return join '.', @parts; + } + + sub recursive_init_fields { 0 } +} + +{ + package NestedForm::Parent; + + sub DESTROY { } + + sub new { + my ($class) = @_; + my $self = bless { forms => {} }, $class; + $self->build_form; + return $self; + } + + sub build_form { + my ($self) = @_; + # Keep both constructors inline to exercise the temporary argument + # frame used by Rose::HTML::Form::add_forms. + my $next_rank = $self->next_form_rank; + $self->add_forms( + person => NestedForm::Child->new, + address => NestedForm::Child->new, + ); + } + + sub add_forms { + my $self = shift; + my @added_forms; + my $next_rank = $self->next_form_rank; + + while (@_) { + my $name = shift; + my $form = shift; + $self->field($name); + $form->empty_is_ok(1) if $self->empty_is_ok; + $form->form_name($name); + $form->parent_form($self); + $self->{forms}{$name} = $form; + push @added_forms, $form; + } + + my $depth = $self->form_depth + 1; + foreach my $form (@added_forms) { + if ($form->recursive_init_fields) { + $self->recursive_init_fields(1); + } + $form->rank($next_rank++) unless defined $form->rank; + $form->form_depth($depth); + $form->resync_field_names; + } + $self->resync_fields_by_name; + } + + sub next_form_rank { 1 } + + sub field { return } + + sub empty_is_ok { 0 } + + sub parent_form { return } + + sub form_depth { 0 } + + sub recursive_init_fields { 0 } + + sub resync_fields_by_name { + my ($self) = @_; + my %fields_by_name; + for my $form_name (sort keys %{ $self->{forms} }) { + for my $field (values %{ $self->{forms}{$form_name}{fields} }) { + $fields_by_name{$field->fq_moniker} = $field; + } + } + $self->{fields_by_name} = \%fields_by_name; + } +} + +my $parent = NestedForm::Parent->new; +for my $form_name (qw(person address)) { + my $form = $parent->{forms}{$form_name}; + is( + $form->fq_form_name, $form_name, + "$form_name fully qualified form name uses its weak parent", + ); + is( + $form->parent_form, $parent, + "$form_name retains its parent form", + ); + ok( + isweak($form->{parent_form}), + "$form_name parent link remains weak", + ); + is_deeply( + $form->{field_names}, + [map { "$form_name.$_" } qw(age birth gender name start)], + "$form_name nested form retains its fields", + ); + + for my $field (values %{ $form->{fields} }) { + is( + $field->{parent_form}, $form, + "$form_name field retains its parent form", + ); + ok( + isweak($field->{parent_form}), + "$form_name field parent link remains weak", + ); + } +} + +is_deeply( + [sort keys %{ $parent->{fields_by_name} }], + [sort map { my $form_name = $_; map { "$form_name.$_" } qw(age birth gender name start) } + qw(person address)], + 'nested field names retain their form prefixes', +); From 4a53a64dbd25f69dfc4e38de8953af5a33ca8c28 Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Sat, 24 Oct 2026 22:43:50 +0200 Subject: [PATCH 3/3] test: make new regression setup Windows-safe Use a platform-native temporary directory for the remove_tree regression and normalize Windows text-mode newlines in the localized STDOUT assertion. Generated with [OpenAI Codex](https://openai.com/codex) Co-Authored-By: OpenAI Codex --- src/test/resources/unit/file_path_remove_tree.t | 7 ++++--- src/test/resources/unit/io_localized_stdout_capture.t | 1 + 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/src/test/resources/unit/file_path_remove_tree.t b/src/test/resources/unit/file_path_remove_tree.t index 6c026f90a2..39fd761c02 100644 --- a/src/test/resources/unit/file_path_remove_tree.t +++ b/src/test/resources/unit/file_path_remove_tree.t @@ -2,10 +2,12 @@ use 5.38.0; use strict; use warnings; use Test::More tests => 2; +use File::Spec; use File::Path qw(remove_tree); +use File::Temp qw(tempdir); -my $root = "/tmp/perlonjava-file-path-remove-tree-$$-" . time(); -my $child = "$root/unreadable"; +my $root = tempdir('perlonjava-file-path-remove-tree-XXXXXX', TMPDIR => 1, CLEANUP => 0); +my $child = File::Spec->catdir($root, 'unreadable'); END { chmod 0700, $child if defined $child && -e $child; @@ -14,7 +16,6 @@ END { rmdir $root if defined $root; } -mkdir($root, 0700) or die "mkdir $root: $!"; mkdir($child, 0100) or die "mkdir $child: $!"; chmod(0100, $child) or die "chmod $child: $!"; diff --git a/src/test/resources/unit/io_localized_stdout_capture.t b/src/test/resources/unit/io_localized_stdout_capture.t index 4e2fdd396d..3de089f196 100644 --- a/src/test/resources/unit/io_localized_stdout_capture.t +++ b/src/test/resources/unit/io_localized_stdout_capture.t @@ -12,5 +12,6 @@ my ($capture, $path) = tempfile(UNLINK => 1); seek $capture, 0, 0 or die "seek capture file: $!"; my $captured = <$capture>; +$captured =~ s/\r\n/\n/g if defined $captured; is($captured, "captured through localized STDOUT\n", 'implicit print follows a localized and reopened STDOUT glob');