From df54e6904d51ff396d5d863836528b34960eccbd Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Mon, 20 Apr 2026 15:07:28 +0200 Subject: [PATCH] fix: make Tie::File test suite pass Takes ./jcpan -t Tie::File from 336 failures / 16 failing test files to all 4725 tests passing. Six related bugs in tied-array and $. handling: 1. $. numeric reads stale zero after local $. + reads. ScalarSpecialVariable.set() cached this.type=INTEGER, this.value=0 on the proxy. Readline mutates currentLineNumber directly, so the cache goes stale. Numeric comparison fast paths (arg.type==INTEGER -> (int)arg.value) then read 0. Removed the sync; $. always delegates through getValueAsScalar(). 2. $. not incremented for multi-char $/. readUntilString only bumped currentLineNumber on '\n' in the line. Custom separators with no newline left $. at 0. Now increments once per record read, regardless of separator content. 3. Tied push/unshift returned the tie method's raw return value. Perl's av.c ignores the PUSH/UNSHIFT return and reports FETCHSIZE. Tie::File's PUSH returns nothing on purpose. tiedPush/tiedUnshift now call the handler and then return FETCHSIZE. 4. Tied SPLICE always called in scalar context. tieCall hardcoded SCALAR, so @r = splice(@tied, ...) got back the scalar count. Context now flows through Operator.splice and TieArray.tiedSplice to the user's SPLICE; the bytecode handler unwraps a tied scalar return directly. 5. Negative subscripts on tied arrays passed raw to FETCH/STORE. Perl normalizes negative indices to FETCHSIZE+idx before dispatch. If the result is still negative (e.g. $tied[-100] on a size-3 array), Perl does NOT call FETCH/STORE: reads yield undef, writes throw "Modification of non-creatable array value attempted, subscript -N". Implemented via an outOfRangeOriginalIndex flag on RuntimeTiedArrayProxyEntry, with matching normalization in exists/delete. 6. @tied = (...) didn't call EXTEND. Perl calls EXTEND on tied arrays before the STORE loop. Tie::File relies on this to extend the backing file in autodefer mode. Generated with [Devin](https://cli.devin.ai/docs) Co-Authored-By: Devin <158243242+devin-ai-integration[bot]@users.noreply.github.com> --- .../backend/bytecode/SlowOpcodeHandler.java | 21 ++++++-- .../org/perlonjava/core/Configuration.java | 4 +- .../runtime/operators/Operator.java | 13 ++++- .../runtime/operators/Readline.java | 10 ++-- .../runtime/runtimetypes/RuntimeArray.java | 46 +++++++++++++++-- .../RuntimeTiedArrayProxyEntry.java | 33 ++++++++++++- .../runtimetypes/ScalarSpecialVariable.java | 13 ++--- .../runtime/runtimetypes/TieArray.java | 49 +++++++++++++++++-- 8 files changed, 159 insertions(+), 30 deletions(-) diff --git a/src/main/java/org/perlonjava/backend/bytecode/SlowOpcodeHandler.java b/src/main/java/org/perlonjava/backend/bytecode/SlowOpcodeHandler.java index 4c4d78d56..2bb0c68a4 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/SlowOpcodeHandler.java +++ b/src/main/java/org/perlonjava/backend/bytecode/SlowOpcodeHandler.java @@ -697,11 +697,24 @@ public static int executeSplice( RuntimeArray array = (RuntimeArray) registers[arrayReg]; RuntimeList args = (RuntimeList) registers[argsReg]; - RuntimeList result = Operator.splice(array, args); - - // In scalar context, return last element removed (Perl semantics) + // For tied arrays, the user's SPLICE method returns its own scalar value + // when called in scalar context (typically the last removed element, + // already unwrapped by the handler). Pass context through so it sees the + // right wantarray, and trust its scalar return directly rather than + // taking "last element" of a list that was built from a scalar result. + boolean isTied = array.type == RuntimeArray.TIED_ARRAY; + + RuntimeList result = Operator.splice(array, args, context); + + // In scalar context, return last element removed (Perl semantics). + // For tied arrays in scalar context, the handler's scalar return + // (wrapped as a one-element RuntimeList) is already the caller's value. if (context == RuntimeContextType.SCALAR) { - if (result.elements.isEmpty()) { + if (isTied) { + registers[rd] = result.elements.isEmpty() + ? new RuntimeScalar() + : result.elements.get(0).scalar(); + } else if (result.elements.isEmpty()) { registers[rd] = new RuntimeScalar(); // undef } else { registers[rd] = result.elements.get(result.elements.size() - 1); diff --git a/src/main/java/org/perlonjava/core/Configuration.java b/src/main/java/org/perlonjava/core/Configuration.java index bec167c66..594805953 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 = "5fbadc806"; + public static final String gitCommitId = "077ce69bd"; /** * 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 14:34:31"; + public static final String buildTimestamp = "Apr 20 2026 15:31:29"; // Prevent instantiation private Configuration() { diff --git a/src/main/java/org/perlonjava/runtime/operators/Operator.java b/src/main/java/org/perlonjava/runtime/operators/Operator.java index d6338f4d2..4d48a26d9 100644 --- a/src/main/java/org/perlonjava/runtime/operators/Operator.java +++ b/src/main/java/org/perlonjava/runtime/operators/Operator.java @@ -413,6 +413,15 @@ private static RuntimeScalar substrImpl(int ctx, boolean warnEnabled, RuntimeBas * @return a RuntimeList containing the elements that were removed */ public static RuntimeList splice(RuntimeArray runtimeArray, RuntimeList list) { + return splice(runtimeArray, list, RuntimeContextType.LIST); + } + + /** + * Context-aware splice. Context only matters for tied arrays, where the + * user-defined SPLICE method's return value differs between scalar and + * list context. + */ + public static RuntimeList splice(RuntimeArray runtimeArray, RuntimeList list, int ctx) { return switch (runtimeArray.type) { case PLAIN_ARRAY -> { RuntimeList removedElements = new RuntimeList(); @@ -480,9 +489,9 @@ public static RuntimeList splice(RuntimeArray runtimeArray, RuntimeList list) { } case AUTOVIVIFY_ARRAY -> { AutovivificationArray.vivify(runtimeArray); - yield splice(runtimeArray, list); // Recursive call after vivification + yield splice(runtimeArray, list, ctx); // Recursive call after vivification } - case TIED_ARRAY -> TieArray.tiedSplice(runtimeArray, list); + case TIED_ARRAY -> TieArray.tiedSplice(runtimeArray, list, ctx); default -> throw new IllegalStateException("Unknown array type: " + runtimeArray.type); }; diff --git a/src/main/java/org/perlonjava/runtime/operators/Readline.java b/src/main/java/org/perlonjava/runtime/operators/Readline.java index a4d95863e..d4fab91f0 100644 --- a/src/main/java/org/perlonjava/runtime/operators/Readline.java +++ b/src/main/java/org/perlonjava/runtime/operators/Readline.java @@ -261,14 +261,10 @@ private static RuntimeScalar readUntilString(RuntimeIO runtimeIO, String separat } } - // Increment the line number counter if a line was read and contains newlines + // Increment the line number counter once per record read. + // In Perl, $. counts records (not newlines) regardless of the value of $/. if (!line.isEmpty()) { - String lineStr = line.toString(); - for (int i = 0; i < lineStr.length(); i++) { - if (lineStr.charAt(i) == '\n') { - runtimeIO.currentLineNumber++; - } - } + runtimeIO.currentLineNumber++; } // Return undef if we've reached EOF and no characters were read diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeArray.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeArray.java index 081e60e4b..9c0629370 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeArray.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeArray.java @@ -339,7 +339,16 @@ public RuntimeScalar exists(int index) { yield (element == null) ? scalarFalse : scalarTrue; } case AUTOVIVIFY_ARRAY -> scalarFalse; - case TIED_ARRAY -> TieArray.tiedExists(this, getScalarInt(index)); + case TIED_ARRAY -> { + int idx = index; + if (idx < 0 && !TieArray.negativeIndicesAllowed(this)) { + idx = TieArray.tiedFetchSize(this).getInt() + idx; + if (idx < 0) { + yield scalarFalse; // still negative: doesn't exist + } + } + yield TieArray.tiedExists(this, getScalarInt(idx)); + } case READONLY_ARRAY -> { if (index < 0) { index = elements.size() + index; // Handle negative indices @@ -381,7 +390,16 @@ public RuntimeScalar delete(int index) { yield previous; } case AUTOVIVIFY_ARRAY -> scalarUndef; - case TIED_ARRAY -> TieArray.tiedDelete(this, getScalarInt(index)); + case TIED_ARRAY -> { + int idx = index; + if (idx < 0 && !TieArray.negativeIndicesAllowed(this)) { + idx = TieArray.tiedFetchSize(this).getInt() + idx; + if (idx < 0) { + yield scalarUndef; // still negative: nothing to delete + } + } + yield TieArray.tiedDelete(this, getScalarInt(idx)); + } case READONLY_ARRAY -> throw new PerlCompilerException("Modification of a read-only value attempted"); default -> throw new IllegalStateException("Unknown array type: " + type); }; @@ -569,9 +587,24 @@ public RuntimeScalar get(int index) { public RuntimeScalar get(RuntimeScalar value) { if (this.type == TIED_ARRAY) { + int idx = value.getInt(); + Integer outOfRangeOriginal = null; + if (idx < 0 && !TieArray.negativeIndicesAllowed(this)) { + // Perl normalizes negative indices (idx + FETCHSIZE) before dispatching + // to FETCH, unless the tied package opts out via $Pkg::NEGATIVE_INDICES. + // If the normalized result is STILL negative, Perl does not call FETCH + // at all: reads yield undef, writes throw "Modification of non- + // creatable array value attempted". + int normalized = TieArray.tiedFetchSize(this).getInt() + idx; + if (normalized < 0) { + outOfRangeOriginal = idx; + } else { + value = new RuntimeScalar(normalized); + } + } RuntimeScalar v = new RuntimeScalar(); v.type = TIED_SCALAR; - v.value = new RuntimeTiedArrayProxyEntry(this, value); + v.value = new RuntimeTiedArrayProxyEntry(this, value, outOfRangeOriginal); return v; } @@ -683,6 +716,13 @@ public RuntimeArray setFromList(RuntimeList list) { // Now clear and repopulate from the materialized list TieArray.tiedClear(this); + // Perl calls EXTEND on the tied array before the STORE loop so + // implementations can preallocate. Tie::File relies on this to + // extend the backing file in autodefer mode. + int extendTo = materializedList.elements.size(); + if (extendTo > 0) { + TieArray.tiedExtend(this, getScalarInt(extendTo)); + } int index = 0; for (RuntimeScalar element : materializedList) { TieArray.tiedStore(this, getScalarInt(index), element); diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeTiedArrayProxyEntry.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeTiedArrayProxyEntry.java index 6a764de30..e0699c53c 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeTiedArrayProxyEntry.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeTiedArrayProxyEntry.java @@ -7,19 +7,33 @@ public class RuntimeTiedArrayProxyEntry extends TiedVariableBase { // Reference to the parent RuntimeArray (which is tied) private final RuntimeArray parent; - // Index associated with this proxy in the parent array + // Index associated with this proxy in the parent array (already normalized) private final RuntimeScalar key; + // Original (unnormalized) negative index, when the normalized key would still be + // negative. In that case FETCH is not dispatched (read yields undef) and STORE + // throws "Modification of non-creatable array value attempted", matching Perl. + private final Integer outOfRangeOriginalIndex; /** * Constructs a RuntimeTiedArrayProxyEntry for a given index in the specified tied array. * * @param parent the parent RuntimeArray that is tied - * @param key the index in the array for which this proxy is created + * @param key the (already normalized) index in the array for which this proxy is created */ public RuntimeTiedArrayProxyEntry(RuntimeArray parent, RuntimeScalar key) { + this(parent, key, null); + } + + /** + * Constructs a proxy that represents an out-of-range (still-negative after + * normalization) subscript. Reads return undef without touching the tie + * handler; writes throw the usual Perl "non-creatable" error. + */ + public RuntimeTiedArrayProxyEntry(RuntimeArray parent, RuntimeScalar key, Integer outOfRangeOriginalIndex) { super(null, null); this.parent = parent; this.key = key; + this.outOfRangeOriginalIndex = outOfRangeOriginalIndex; } /** @@ -28,6 +42,13 @@ public RuntimeTiedArrayProxyEntry(RuntimeArray parent, RuntimeScalar key) { */ @Override void vivify() { + if (outOfRangeOriginalIndex != null) { + // Negative subscript that normalizes to a still-negative index: Perl + // does not dispatch FETCH; the value is simply undef. + this.type = RuntimeScalarType.UNDEF; + this.value = null; + return; + } // Always fetch the current value from the tied object RuntimeScalar fetchedValue = TieArray.tiedFetch(parent, key); this.type = fetchedValue.type; @@ -42,11 +63,19 @@ void vivify() { */ @Override public RuntimeScalar tiedStore(RuntimeScalar value) { + if (outOfRangeOriginalIndex != null) { + throw new PerlCompilerException( + "Modification of non-creatable array value attempted, subscript " + + outOfRangeOriginalIndex); + } return TieArray.tiedStore(parent, key, value); } @Override public RuntimeScalar tiedFetch() { + if (outOfRangeOriginalIndex != null) { + return new RuntimeScalar(); + } return TieArray.tiedFetch(parent, key); } } \ No newline at end of file diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/ScalarSpecialVariable.java b/src/main/java/org/perlonjava/runtime/runtimetypes/ScalarSpecialVariable.java index b6bd44db2..1517e4f27 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/ScalarSpecialVariable.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/ScalarSpecialVariable.java @@ -90,8 +90,11 @@ public RuntimeScalar set(RuntimeScalar value) { } else { lvalue.set(value); } - this.type = lvalue.type; - this.value = lvalue.value; + // Intentionally do NOT sync this.type / this.value from lvalue. + // $. is a PROXY whose canonical value lives in lastAccesseddHandle.currentLineNumber, + // which is mutated directly by readline. Caching the value on the proxy here would + // make fast-path code (e.g. the INTEGER/INTEGER fast path in numeric comparisons) + // read a stale value after subsequent readline calls bump currentLineNumber. return lvalue; } if (variableId == Id.HINTS) { @@ -449,10 +452,8 @@ public void dynamicRestoreState() { previous.lastHandle.currentLineNumber = previous.lastLineNumber; } lvalue = previous.localValue; - if (lvalue != null) { - this.type = lvalue.type; - this.value = lvalue.value; - } + // Do not sync this.type/value from lvalue here; $. reads always + // delegate to currentLineNumber via getValueAsScalar(). } return; } diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/TieArray.java b/src/main/java/org/perlonjava/runtime/runtimetypes/TieArray.java index e0db9dfd7..22fc770ee 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/TieArray.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/TieArray.java @@ -74,6 +74,10 @@ public TieArray(String tiedPackage, RuntimeArray previousValue, RuntimeScalar se * Helper method to call methods on the tied object. */ private static RuntimeList tieCall(RuntimeArray array, String method, RuntimeBase... args) { + return tieCall(array, method, RuntimeContextType.SCALAR, args); + } + + private static RuntimeList tieCall(RuntimeArray array, String method, int ctx, RuntimeBase... args) { TieArray tieArray = (TieArray) array.elements; RuntimeScalar self = tieArray.getSelf(); String className = tieArray.getTiedPackage(); @@ -84,7 +88,7 @@ private static RuntimeList tieCall(RuntimeArray array, String method, RuntimeBas new RuntimeScalar(method), null, new RuntimeArray(args), - RuntimeContextType.SCALAR + ctx ); } @@ -166,9 +170,15 @@ public static RuntimeScalar tiedClear(RuntimeArray array) { /** * Pushes elements onto the end of a tied array (delegates to PUSH). + * + *

In Perl, the return value of PUSH is ignored by av.c; the new array + * size is computed via FETCHSIZE. We follow the same convention so that + * tie classes (like Tie::File) whose PUSH returns nothing still produce + * the expected new length. */ public static RuntimeScalar tiedPush(RuntimeArray array, RuntimeBase elements) { - return tieCall(array, "PUSH", elements).getFirst(); + tieCall(array, "PUSH", elements); + return tiedFetchSize(array); } /** @@ -187,16 +197,30 @@ public static RuntimeScalar tiedShift(RuntimeArray array) { /** * Unshifts elements onto the beginning of a tied array (delegates to UNSHIFT). + * + *

As with PUSH, Perl's av.c ignores the method's return value and + * reports the new array size via FETCHSIZE. */ public static RuntimeScalar tiedUnshift(RuntimeArray array, RuntimeBase elements) { - return tieCall(array, "UNSHIFT", elements).getFirst(); + tieCall(array, "UNSHIFT", elements); + return tiedFetchSize(array); } /** * Performs a splice operation on a tied array (delegates to SPLICE). + * + * @param ctx caller context - SPLICE is one of the few tie methods whose + * behaviour differs between list and scalar context. + */ + public static RuntimeList tiedSplice(RuntimeArray array, RuntimeList list, int ctx) { + return tieCall(array, "SPLICE", ctx, list).getList(); + } + + /** + * Backwards-compat overload assuming list context. */ public static RuntimeList tiedSplice(RuntimeArray array, RuntimeList list) { - return tieCall(array, "SPLICE", list).getList(); + return tiedSplice(array, list, RuntimeContextType.LIST); } /** @@ -225,6 +249,23 @@ public String getTiedPackage() { return tiedPackage; } + /** + * Returns true when the tied package opts out of negative-index + * normalization by setting $Package::NEGATIVE_INDICES to a + * true value. In that case the Perl core passes negative subscripts to + * FETCH/STORE/EXISTS/DELETE unchanged; the handler is responsible for + * translating them itself (see perltie). + */ + public static boolean negativeIndicesAllowed(RuntimeArray array) { + if (array.type != RuntimeArray.TIED_ARRAY) return false; + TieArray tieArray = (TieArray) array.elements; + String pkg = tieArray.getTiedPackage(); + if (pkg == null) return false; + String key = pkg + "::NEGATIVE_INDICES"; + if (!GlobalVariable.existsGlobalVariable(key)) return false; + return GlobalVariable.getGlobalVariable(key).getBoolean(); + } + public int size() { return tiedFetchSize(parent).getInt(); }