From 10631d752a488e115dad7fdcf30467ebfe25ca31 Mon Sep 17 00:00:00 2001 From: Flavio Soibelmann Glock Date: Mon, 20 Apr 2026 18:14:47 +0200 Subject: [PATCH] fix: improve Memoize test pass rate MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Two independent fixes targeting failures seen in `jcpan -t Memoize`: 1. Storable::last_op_in_netorder: implement the flag that reports whether the most recent freeze/store used network byte order. Set by nfreeze()/nstore(), cleared by freeze()/store(). Unblocks t/tie_storable.t. 2. "Deep recursion on subroutine" warning: RuntimeCode now tracks per-sub recursion depth and warns (under the "recursion" category) the first time depth exceeds 100, matching Perl's PERL_SUB_DEPTH_WARN behavior. Map/grep/eval blocks and builtins are exempt. Unblocks t/correctness.t (which relied on the warning firing before StackOverflowError). Test results for `jcpan -t Memoize` on this branch: - Before: t/correctness.t crashed with StackOverflowError after test 16; t/tie_storable.t died at test 6 with "Undefined subroutine &Storable::last_op_in_netorder". - After: correctness.t 17/17 pass; tie_storable.t 5/6 pass (test 6 requires tied-hash DESTROY at scope exit, a separate pre-existing limitation). threads->new / ->join stubs were considered but rejected: running a thread body synchronously in the current thread silently produces incorrect results whenever the code relies on thread isolation (as Memoize's t/threadsafe.t test 8 demonstrated — unmemoize ran for real on the main thread). Leaving t/threadsafe.t failing loudly is safer than shipping a convincing-but-wrong stub. t/tie.t and t/tie_db.t failures are caused by a broken user-local DB_File.pm AUTOLOAD (CPAN-installed; DB_File needs XS and is not supported on PerlOnJava) and are not addressed here. Generated with [Devin](https://cli.devin.ai/docs) Co-Authored-By: Devin <158243242+devin-ai-integration[bot]@users.noreply.github.com> --- .../org/perlonjava/core/Configuration.java | 4 +- .../runtime/perlmodule/Storable.java | 24 +++- .../runtime/runtimetypes/RuntimeCode.java | 105 +++++++++++++++++- 3 files changed, 128 insertions(+), 5 deletions(-) diff --git a/src/main/java/org/perlonjava/core/Configuration.java b/src/main/java/org/perlonjava/core/Configuration.java index 65ac902be..33ac2f76e 100644 --- a/src/main/java/org/perlonjava/core/Configuration.java +++ b/src/main/java/org/perlonjava/core/Configuration.java @@ -33,7 +33,7 @@ public final class Configuration { * Automatically populated by Gradle/Maven during build. * DO NOT EDIT MANUALLY - this value is replaced at build time. */ - public static final String gitCommitId = "c9b8e05dd"; + public static final String gitCommitId = "fb4614791"; /** * Git commit date of the build (ISO format: YYYY-MM-DD). @@ -48,7 +48,7 @@ public final class Configuration { * Parsed by App::perlbrew and other tools via: perl -V | grep "Compiled at" * DO NOT EDIT MANUALLY - this value is replaced at build time. */ - public static final String buildTimestamp = "Apr 20 2026 17:15:38"; + public static final String buildTimestamp = "Apr 20 2026 18:52:44"; // Prevent instantiation private Configuration() { diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/Storable.java b/src/main/java/org/perlonjava/runtime/perlmodule/Storable.java index fce85952e..cd37dcf6d 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/Storable.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/Storable.java @@ -54,6 +54,7 @@ public static void initialize() { storable.registerMethod("retrieve", null); storable.registerMethod("nstore", null); storable.registerMethod("dclone", null); + storable.registerMethod("last_op_in_netorder", null); storable.defineExport("EXPORT", "store", "retrieve", "nstore", "freeze", "thaw", "nfreeze", "dclone"); @@ -82,12 +83,26 @@ public static void initialize() { // Magic byte to identify binary format (distinguishes from old YAML+GZIP format) private static final char BINARY_MAGIC = '\u00FF'; + // Tracks whether the last freeze/store operation used network byte order. + // Set true by nfreeze()/nstore(); set false by freeze()/store(). + // Exposed via Storable::last_op_in_netorder(). + private static volatile boolean lastOpInNetorder = false; + + /** + * Returns 1 if the last freeze/store operation used network byte order + * (i.e. was nfreeze or nstore), 0 otherwise. + */ + public static RuntimeList last_op_in_netorder(RuntimeArray args, int ctx) { + return new RuntimeScalar(lastOpInNetorder ? 1 : 0).getList(); + } + /** * Freezes data to a binary format matching Perl 5 Storable's sort order. * Uses type bytes compatible with Perl 5's Storable so that string comparison * of frozen output produces the same ordering as Perl 5. */ public static RuntimeList freeze(RuntimeArray args, int ctx) { + lastOpInNetorder = false; if (args.isEmpty()) { return WarnDie.die(new RuntimeScalar("freeze: not enough arguments"), new RuntimeScalar("\n")).getList(); } @@ -432,13 +447,16 @@ private static long readLong(String data, int[] pos) { * Network freeze (same as freeze for now). */ public static RuntimeList nfreeze(RuntimeArray args, int ctx) { - return freeze(args, ctx); + RuntimeList result = freeze(args, ctx); + lastOpInNetorder = true; + return result; } /** * Stores data to file using YAML format. */ public static RuntimeList store(RuntimeArray args, int ctx) { + lastOpInNetorder = false; if (args.size() < 2) { return WarnDie.die(new RuntimeScalar("store: not enough arguments"), new RuntimeScalar("\n")).getList(); } @@ -479,7 +497,9 @@ public static RuntimeList retrieve(RuntimeArray args, int ctx) { * Network store (same as store). */ public static RuntimeList nstore(RuntimeArray args, int ctx) { - return store(args, ctx); + RuntimeList result = store(args, ctx); + lastOpInNetorder = true; + return result; } /** diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java index ee0703f78..94ddbdea0 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java @@ -343,6 +343,72 @@ public static void clearInlineMethodCache() { public boolean isMapGrepBlock = false; // Flag to indicate this code is an eval BLOCK - non-local return should propagate through it public boolean isEvalBlock = false; + + // Depth of active recursive calls to this subroutine, used by the + // "Deep recursion on subroutine" warning. Incremented on entry and + // decremented in a finally-block on exit. + public transient int callDepth = 0; + // Whether a "Deep recursion" warning has already been emitted for the + // currently-active recursion chain. Reset when callDepth returns to 0. + public transient boolean deepRecursionWarned = false; + + // Depth threshold for the "Deep recursion on subroutine" warning. + // Matches Perl's default PERL_SUB_DEPTH_WARN value. + public static final int DEEP_RECURSION_WARN_DEPTH = 100; + + // When the tail-call trampoline in the static apply() re-enters a sub, + // we want to skip the "Deep recursion" tracking for that entry. + // The goto &sub caller's `no warnings 'recursion'` scope has already + // unwound by the time the trampoline runs, so we can't honor it; and + // tail calls don't consume real Java stack, so a depth warning for + // them is misleading anyway. Nested tail-call trampolines use an int + // counter so re-entries only skip tracking for the outermost trampoline. + private static final ThreadLocal inTailCallTrampoline = + ThreadLocal.withInitial(() -> 0); + + /** + * Increment the recursion depth counter and, if we've just crossed the + * "Deep recursion on subroutine" threshold for the first time in this + * recursion chain, emit a warning under the "recursion" warnings category. + * Must be matched with a call to exitCall() in a finally-block. + * + * Map/grep/eval blocks are exempt so that map { ... } and eval { ... } + * don't report their dispatch wrapper. Tail-call trampoline re-entries + * are also exempt — see inTailCallTrampoline. + */ + private void enterCall() { + if (isMapGrepBlock || isEvalBlock || isBuiltin) { + return; + } + if (inTailCallTrampoline.get() > 0) { + return; + } + int depth = ++callDepth; + if (depth > DEEP_RECURSION_WARN_DEPTH && !deepRecursionWarned) { + deepRecursionWarned = true; + String name = (packageName != null && subName != null) + ? packageName + "::" + subName + : (subName != null ? subName : "__ANON__"); + WarnDie.warnWithCategory( + new RuntimeScalar("Deep recursion on subroutine \"" + name + "\""), + RuntimeScalarCache.scalarEmptyString, + "recursion"); + } + } + + /** Paired with enterCall() — decrements the recursion counter. */ + private void exitCall() { + if (isMapGrepBlock || isEvalBlock || isBuiltin) { + return; + } + if (inTailCallTrampoline.get() > 0) { + return; + } + if (--callDepth <= 0) { + callDepth = 0; + deepRecursionWarned = false; + } + } // State variables public Map stateVariableInitialized = new HashMap<>(); public Map stateVariable = new HashMap<>(); @@ -2330,7 +2396,16 @@ public static RuntimeList apply(RuntimeScalar runtimeScalar, RuntimeArray a, int && cfList.getControlFlowType() == ControlFlowType.TAILCALL) { RuntimeScalar tailCodeRef = cfList.getTailCallCodeRef(); RuntimeArray tailArgs = cfList.getTailCallArgs(); - result = apply(tailCodeRef, tailArgs != null ? tailArgs : a, callContext); + // Mark trampoline re-entry so enterCall/exitCall skip depth + // tracking (tail calls don't consume real Java stack, and the + // goto site's lexical `no warnings 'recursion'` scope has + // already unwound — see enterCall() comments). + inTailCallTrampoline.set(inTailCallTrampoline.get() + 1); + try { + result = apply(tailCodeRef, tailArgs != null ? tailArgs : a, callContext); + } finally { + inTailCallTrampoline.set(inTailCallTrampoline.get() - 1); + } } // Mortal-ize blessed refs with refCount==0 in void-context calls. // These are objects that were created but never stored in a named @@ -2669,6 +2744,23 @@ public static RuntimeList apply(RuntimeScalar runtimeScalar, String subroutineNa // Method to apply (execute) a subroutine reference (legacy method for compatibility) public static RuntimeList apply(RuntimeScalar runtimeScalar, String subroutineName, RuntimeBase list, int callContext) { + // If this is a tail-call trampoline re-entry (emitted by the JVM bytecode + // trampoline for `goto &sub`), mark it so enterCall/exitCall skip depth + // tracking. See enterCall() / inTailCallTrampoline for the rationale. + boolean isTailCall = "tailcall".equals(subroutineName); + if (isTailCall) { + inTailCallTrampoline.set(inTailCallTrampoline.get() + 1); + try { + return applyImpl(runtimeScalar, subroutineName, list, callContext); + } finally { + inTailCallTrampoline.set(inTailCallTrampoline.get() - 1); + } + } + return applyImpl(runtimeScalar, subroutineName, list, callContext); + } + + private static RuntimeList applyImpl(RuntimeScalar runtimeScalar, String subroutineName, RuntimeBase list, int callContext) { + // Handle tied scalars - fetch the underlying value first if (runtimeScalar.type == RuntimeScalarType.TIED_SCALAR) { return apply(runtimeScalar.tiedFetch(), subroutineName, list, callContext); @@ -3163,6 +3255,11 @@ public RuntimeList apply(RuntimeArray a, int callContext) { // See also: the 3-arg instance method apply(name, array, ctx) which pushes true. hasArgsStack.get().push(false); + // Check deep recursion BEFORE pushing the callee's warning bits, + // so the "Deep recursion on subroutine" warning is gated on the + // caller's lexical warning bits (matching Perl's ckWARN at the + // call site, not inside the callee). + enterCall(); // Push warning bits for FATAL warnings support String warningBits = getWarningBitsForCode(this); if (warningBits != null) { @@ -3183,6 +3280,7 @@ public RuntimeList apply(RuntimeArray a, int callContext) { if (warningBits != null) { WarningBitsRegistry.popCurrent(); } + exitCall(); popArgs(); // also pops hasArgsStack — see popArgs() implementation if (DebugState.debugMode) { DebugHooks.exitSubroutine(); @@ -3268,6 +3366,10 @@ public RuntimeList apply(String subroutineName, RuntimeArray a, int callContext) // See also: the 2-arg instance method apply(array, ctx) which pushes false. hasArgsStack.get().push(true); + // Check deep recursion BEFORE pushing the callee's warning bits, + // so the "Deep recursion on subroutine" warning is gated on the + // caller's lexical warning bits. + enterCall(); // Push warning bits for FATAL warnings support String warningBits = getWarningBitsForCode(this); if (warningBits != null) { @@ -3288,6 +3390,7 @@ public RuntimeList apply(String subroutineName, RuntimeArray a, int callContext) if (warningBits != null) { WarningBitsRegistry.popCurrent(); } + exitCall(); popArgs(); // also pops hasArgsStack — see popArgs() implementation if (DebugState.debugMode) { DebugHooks.exitSubroutine();