From b865f9beef302eedcd9c93d48b9b40da37d264b0 Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Fri, 18 Sep 2026 14:01:37 +0200 Subject: [PATCH] fix: complete io scalar and open compatibility Fix scalar-backed IO behavior and open() compatibility cases, including aggregate filehandle warning context and readonly numbered captures. Generated with Codex (https://openai.com/codex) Co-Authored-By: Codex --- .../backend/bytecode/BytecodeInterpreter.java | 5 ++ .../bytecode/CompileBinaryOperator.java | 10 +++ .../backend/bytecode/CompileOperator.java | 23 +++++++ .../backend/bytecode/Disassemble.java | 5 ++ .../perlonjava/backend/bytecode/Opcodes.java | 3 + .../perlonjava/backend/jvm/EmitOperator.java | 27 ++++++++ .../runtime/io/LayeredIOHandle.java | 2 +- .../perlonjava/runtime/io/ScalarBackedIO.java | 49 +++++++++++--- .../runtime/operators/ChownOperator.java | 11 +++- .../runtime/operators/IOOperator.java | 48 ++++++++++++++ .../runtime/operators/Readline.java | 17 +++++ .../perlonjava/runtime/operators/WarnDie.java | 33 +++++++++- .../runtime/runtimetypes/GlobalVariable.java | 11 ++++ .../runtimetypes/RuntimeArrayProxyEntry.java | 3 + .../runtime/runtimetypes/RuntimeIO.java | 65 +++++++++++++++---- .../runtimetypes/ScalarSpecialVariable.java | 5 ++ ...n_aggregate_context_and_readonly_capture.t | 28 ++++++++ 17 files changed, 319 insertions(+), 26 deletions(-) create mode 100644 src/test/resources/unit/io_open_aggregate_context_and_readonly_capture.t diff --git a/src/main/java/org/perlonjava/backend/bytecode/BytecodeInterpreter.java b/src/main/java/org/perlonjava/backend/bytecode/BytecodeInterpreter.java index c1750f4c5b..115aefb535 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/BytecodeInterpreter.java +++ b/src/main/java/org/perlonjava/backend/bytecode/BytecodeInterpreter.java @@ -2424,6 +2424,11 @@ private static RuntimeList execute(SuspendedInterpreterFrame frame) { pc = OpcodeHandlerExtended.executeReadline(bytecode, pc, registers); } + case Opcodes.SET_LAST_READLINE_HANDLE_NAME -> { + int nameIndex = bytecode[pc++]; + RuntimeIO.setLastReadlineHandleName(code.stringPool[nameIndex]); + } + case Opcodes.MATCH_REGEX -> { // Match regex // Format: MATCH_REGEX rd stringReg regexReg ctx bytesMode targetNameIndex diff --git a/src/main/java/org/perlonjava/backend/bytecode/CompileBinaryOperator.java b/src/main/java/org/perlonjava/backend/bytecode/CompileBinaryOperator.java index 88573b88a0..65b4dc4ce6 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/CompileBinaryOperator.java +++ b/src/main/java/org/perlonjava/backend/bytecode/CompileBinaryOperator.java @@ -787,6 +787,16 @@ else if (node.right instanceof BinaryOperatorNode rightCall) { bytecodeCompiler.compileNode(node.left, -1, leftCtx); int rs1 = bytecodeCompiler.lastResultReg; + // Anonymous lexical and aggregate-element handles have no globName, + // but Perl includes their source spelling in $.-context diagnostics. + if (node.operator.equals("readline")) { + Object handleName = node.getAnnotation("handleName"); + if (handleName instanceof String name) { + bytecodeCompiler.emit(Opcodes.SET_LAST_READLINE_HANDLE_NAME); + bytecodeCompiler.emit(bytecodeCompiler.addToStringPool(name)); + } + } + int rightCtx; if (isListOp) { rightCtx = RuntimeContextType.LIST; diff --git a/src/main/java/org/perlonjava/backend/bytecode/CompileOperator.java b/src/main/java/org/perlonjava/backend/bytecode/CompileOperator.java index a8e07b65cc..51a146a721 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/CompileOperator.java +++ b/src/main/java/org/perlonjava/backend/bytecode/CompileOperator.java @@ -450,6 +450,11 @@ private static void visitOpen(BytecodeCompiler bc, OperatorNode node) { bc.throwCompilerException("open requires arguments"); return; } + String fileHandleName = openTargetName(argsList.elements.getFirst()); + if (fileHandleName != null) { + bc.emit(Opcodes.SET_LAST_READLINE_HANDLE_NAME); + bc.emit(bc.addToStringPool(fileHandleName)); + } int argsReg = bc.allocateRegister(); bc.emit(Opcodes.NEW_ARRAY); bc.emitReg(argsReg); @@ -492,6 +497,24 @@ private static void visitOpen(BytecodeCompiler bc, OperatorNode node) { bc.lastResultReg = rd; } + private static String openTargetName(Node node) { + if (node instanceof OperatorNode wrapper && wrapper.operator.equals("scalar")) { + node = wrapper.operand; + } + if (node instanceof BinaryOperatorNode element + && (element.operator.equals("[") || element.operator.equals("{")) + && element.left instanceof OperatorNode scalar + && scalar.operator.equals("$") + && scalar.operand instanceof IdentifierNode identifier) { + return "$" + identifier.name + (element.operator.equals("[") ? "[...]" : "{...}"); + } + if (node instanceof OperatorNode scalar && scalar.operator.equals("$") + && scalar.operand instanceof IdentifierNode identifier) { + return "$" + identifier.name; + } + return null; + } + private static void visitSubstr(BytecodeCompiler bc, OperatorNode node) { if (node.operand == null || !(node.operand instanceof ListNode args) || args.elements.size() < 2) { bc.throwCompilerException("substr requires at least 2 arguments"); diff --git a/src/main/java/org/perlonjava/backend/bytecode/Disassemble.java b/src/main/java/org/perlonjava/backend/bytecode/Disassemble.java index 3e52b985e6..8e3dad21a1 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/Disassemble.java +++ b/src/main/java/org/perlonjava/backend/bytecode/Disassemble.java @@ -868,6 +868,11 @@ public static String disassemble(InterpretedCode interpretedCode) { int readCtx = interpretedCode.bytecode[pc++]; sb.append("READLINE r").append(rd).append(" = readline(r").append(fhReg).append(", ctx=").append(readCtx).append(")\n"); break; + case Opcodes.SET_LAST_READLINE_HANDLE_NAME: + int handleNameIndex = interpretedCode.bytecode[pc++]; + sb.append("SET_LAST_READLINE_HANDLE_NAME ") + .append(interpretedCode.stringPool[handleNameIndex]).append("\n"); + break; case Opcodes.MATCH_REGEX: rd = interpretedCode.bytecode[pc++]; int strReg = 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 494ab2792b..77ff072ba6 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/Opcodes.java +++ b/src/main/java/org/perlonjava/backend/bytecode/Opcodes.java @@ -2566,6 +2566,9 @@ public class Opcodes { /** Array element fetch that preserves tied-array lvalue semantics for local(). */ public static final short ARRAY_GET_FOR_LOCAL = 562; + /** Record a readline handle's source spelling for $. diagnostics. Format: nameStringIdx. */ + public static final short SET_LAST_READLINE_HANDLE_NAME = 566; + /** * Resolve a statically named CODE reference at runtime. This preserves the * current CV snapshot while allowing an earlier runtime glob assignment in diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitOperator.java b/src/main/java/org/perlonjava/backend/jvm/EmitOperator.java index a7fddfc521..f9a78e2ff5 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitOperator.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitOperator.java @@ -397,6 +397,15 @@ static void handleSubstrOperator(EmitterVisitor emitterVisitor, OperatorNode nod index++; } + String openTargetName = node.operator.equals("open") && !operand.elements.isEmpty() + ? openTargetName(operand.elements.getFirst()) : null; + if (openTargetName != null) { + mv.visitLdcInsn(openTargetName); + mv.visitMethodInsn(Opcodes.INVOKESTATIC, + "org/perlonjava/runtime/runtimetypes/RuntimeIO", + "setLastReadlineHandleName", "(Ljava/lang/String;)V", false); + } + emitterVisitor.pushCallContext(); mv.visitVarInsn(Opcodes.ALOAD, argsArraySlot); @@ -426,6 +435,24 @@ static void handleSubstrOperator(EmitterVisitor emitterVisitor, OperatorNode nod } } + private static String openTargetName(Node node) { + if (node instanceof OperatorNode wrapper && wrapper.operator.equals("scalar")) { + node = wrapper.operand; + } + if (node instanceof BinaryOperatorNode element + && (element.operator.equals("[") || element.operator.equals("{")) + && element.left instanceof OperatorNode scalar + && scalar.operator.equals("$") + && scalar.operand instanceof IdentifierNode identifier) { + return "$" + identifier.name + (element.operator.equals("[") ? "[...]" : "{...}"); + } + if (node instanceof OperatorNode scalar && scalar.operator.equals("$") + && scalar.operand instanceof IdentifierNode identifier) { + return "$" + identifier.name; + } + return null; + } + // Handle an operator that was parsed using a Perl prototype. static void handleOperator(EmitterVisitor emitterVisitor, OperatorNode node) { EmitterVisitor scalarVisitor = emitterVisitor.with(RuntimeContextType.SCALAR); diff --git a/src/main/java/org/perlonjava/runtime/io/LayeredIOHandle.java b/src/main/java/org/perlonjava/runtime/io/LayeredIOHandle.java index 15c8e16bd5..8d4eecdcb7 100644 --- a/src/main/java/org/perlonjava/runtime/io/LayeredIOHandle.java +++ b/src/main/java/org/perlonjava/runtime/io/LayeredIOHandle.java @@ -510,7 +510,7 @@ private void addLayer(String layerSpec) { ViaLayer layer = new ViaLayer(className, currentLowerHandle(), currentMode()); activeLayers.add(layer); } else { - throw new IllegalArgumentException("Unknown layer: " + layerSpec); + throw new IllegalArgumentException("Unknown PerlIO layer \"" + layerSpec + "\""); } } } diff --git a/src/main/java/org/perlonjava/runtime/io/ScalarBackedIO.java b/src/main/java/org/perlonjava/runtime/io/ScalarBackedIO.java index dc1652c1c9..8cef482a7a 100644 --- a/src/main/java/org/perlonjava/runtime/io/ScalarBackedIO.java +++ b/src/main/java/org/perlonjava/runtime/io/ScalarBackedIO.java @@ -4,11 +4,17 @@ import org.perlonjava.runtime.runtimetypes.RuntimeIO; import org.perlonjava.runtime.runtimetypes.RuntimeScalar; import org.perlonjava.runtime.runtimetypes.RuntimeScalarCache; +import org.perlonjava.runtime.runtimetypes.GlobalVariable; +import org.perlonjava.runtime.runtimetypes.WarningFlags; +import org.perlonjava.runtime.operators.WarnDie; +import org.perlonjava.runtime.perlmodule.Warnings; import java.nio.charset.Charset; import java.nio.charset.StandardCharsets; public class ScalarBackedIO implements IOHandle { + private static final String NON_BYTE_SCALAR_MESSAGE = + "Strings with code points over 0xFF may not be mapped into in-memory file handles\n"; private final RuntimeScalar backingScalar; private int position = 0; private boolean isEOF = false; @@ -45,6 +51,10 @@ public RuntimeScalar doRead(int maxBytes, Charset charset) { } String content = backingScalar.toString(); + if (!isByteMappable(content)) { + reportNonByteScalar(); + return RuntimeScalarCache.scalarUndef; + } byte[] contentBytes = content.getBytes(StandardCharsets.ISO_8859_1); if (position >= contentBytes.length) { @@ -77,6 +87,10 @@ public RuntimeScalar write(String string) { } String currentContent = backingScalar.toString(); + if (!isByteMappable(currentContent)) { + reportNonByteScalar(); + return RuntimeScalarCache.scalarFalse; + } byte[] currentBytes = currentContent.getBytes(StandardCharsets.ISO_8859_1); if (appendMode) { @@ -88,8 +102,9 @@ public RuntimeScalar write(String string) { int newLength = Math.max(position + newBytes.length, currentBytes.length); byte[] resultBytes = new byte[newLength]; - // Copy existing content - System.arraycopy(currentBytes, 0, resultBytes, 0, Math.min(position, currentBytes.length)); + // Preserve all existing bytes. In particular, a seek beyond EOF leaves a + // gap which PerlIO::scalar fills with NULs on the following write. + System.arraycopy(currentBytes, 0, resultBytes, 0, currentBytes.length); // Write new content at position System.arraycopy(newBytes, 0, resultBytes, position, newBytes.length); @@ -139,9 +154,6 @@ public RuntimeScalar tell() { */ @Override public RuntimeScalar seek(long pos, int whence) { - String content = backingScalar.toString(); - int contentLength = content.getBytes(StandardCharsets.ISO_8859_1).length; - long newPosition; switch (whence) { @@ -152,16 +164,25 @@ public RuntimeScalar seek(long pos, int whence) { newPosition = position + pos; break; case SEEK_END: // from end + // SEEK_END is the sole form which needs the current scalar + // length. SEEK_SET/CUR must not FETCH a tied scalar merely to + // move its file position. + int contentLength = backingScalar.toString().getBytes(StandardCharsets.ISO_8859_1).length; newPosition = contentLength + pos; break; default: return RuntimeIO.handleIOError("Invalid whence value: " + whence); } - // Clamp position to valid range [0, contentLength] - position = (int) Math.max(0, Math.min(newPosition, contentLength)); + if (newPosition < 0 || newPosition > Integer.MAX_VALUE) { + GlobalVariable.getGlobalVariable("main::!").set(22); // EINVAL + return RuntimeScalarCache.scalarFalse; + } - isEOF = position >= contentLength; + // Perl permits seeking past EOF. The gap is materialized as NUL bytes + // only if a subsequent write reaches it. + position = (int) newPosition; + isEOF = false; return RuntimeScalarCache.scalarTrue; } @@ -286,4 +307,16 @@ public void setAppendMode(boolean appendMode) { position = currentContent.getBytes(StandardCharsets.ISO_8859_1).length; } } + + /** Whether a Perl scalar can be represented by PerlIO::scalar's byte buffer. */ + public static boolean isByteMappable(String value) { + return value.codePoints().noneMatch(codePoint -> codePoint > 0xFF); + } + + /** Report the EINVAL/warnings::utf8 contract shared by open, read and write. */ + public static void reportNonByteScalar() { + GlobalVariable.getGlobalVariable("main::!").set(22); // EINVAL + WarnDie.warnWithCategory(new RuntimeScalar(NON_BYTE_SCALAR_MESSAGE), + new RuntimeScalar(""), "utf8"); + } } diff --git a/src/main/java/org/perlonjava/runtime/operators/ChownOperator.java b/src/main/java/org/perlonjava/runtime/operators/ChownOperator.java index 442ddaff00..5df1c36097 100644 --- a/src/main/java/org/perlonjava/runtime/operators/ChownOperator.java +++ b/src/main/java/org/perlonjava/runtime/operators/ChownOperator.java @@ -42,8 +42,15 @@ public static RuntimeScalar chown(int ctx, RuntimeBase... args) { // before taking this no-op fast path. for (int i = 2; i < args.length; i++) { for (RuntimeScalar fileArg : args[i]) { - RuntimeScalar.checkTaint( - RuntimeScalar.dereferenceAndFetchOnce(fileArg), "chown"); + RuntimeScalar pathArg = RuntimeScalar.dereferenceAndFetchOnce(fileArg); + RuntimeScalar.checkTaint(pathArg, "chown"); + if (pathArg.type != RuntimeScalarType.GLOB + && pathArg.type != RuntimeScalarType.GLOBREFERENCE) { + Path path = RuntimeIO.resolvePath(pathArg.toString(), "chown"); + if (path == null || !Files.exists(path)) { + GlobalVariable.getGlobalVariable("main::!").set(2); // ENOENT + } + } } } return new RuntimeScalar(0); diff --git a/src/main/java/org/perlonjava/runtime/operators/IOOperator.java b/src/main/java/org/perlonjava/runtime/operators/IOOperator.java index 3b8109cc32..0f13bd09f6 100644 --- a/src/main/java/org/perlonjava/runtime/operators/IOOperator.java +++ b/src/main/java/org/perlonjava/runtime/operators/IOOperator.java @@ -658,6 +658,22 @@ public static RuntimeScalar open(int ctx, RuntimeBase... args) { // For array/hash elements like $fh0[0], this is the actual lvalue that can be modified // We assert it's a RuntimeScalar rather than calling .scalar() which would create a copy RuntimeScalar fileHandle = (RuntimeScalar) args[0]; + String openTargetSource = RuntimeIO.getLastReadlineHandleName(); + // The compiler uses this one-shot channel to preserve the source + // spelling of open's first argument. Do not let it leak into a + // later, unrelated open/readline operation. + RuntimeIO.setLastReadlineHandleName(null); + // Numbered capture variables are readonly aliases. Unlike a numeric + // literal used as a one-argument handle name, an attempt to install an + // IO slot into one must report Perl's normal readonly-lvalue error. + if (fileHandle.type == RuntimeScalarType.READONLY_SCALAR + || fileHandle instanceof RuntimeScalarReadOnly + || fileHandle instanceof ScalarSpecialVariable specialVariable + && specialVariable.isNumberedCapture() + || openTargetSource != null && openTargetSource.matches("\\$[0-9]+") + || fileHandle == scalarUndef) { + throw new PerlCompilerException("Modification of a read-only value attempted"); + } if (args.length < 2) { // 1-argument open: open FILEHANDLE // Per Perl semantics, the global scalar variable of the same name as the @@ -958,11 +974,43 @@ else if (secondArg.type == RuntimeScalarType.GLOB || secondArg.type == RuntimeSc RuntimeScalar assignedHandle = fileHandle.set(newGlob); RuntimeScalar.retainUnstashedIoForDurableSlot(assignedHandle); } + String aggregateName = aggregateHandleName(fileHandle); + if (aggregateName != null) { + fh.setDiagnosticReadlineHandleName(aggregateName); + } else { + String diagnosticName = normalizeAggregateHandleName(openTargetSource); + if (diagnosticName != null) { + fh.setDiagnosticReadlineHandleName(diagnosticName); + } + } long pid = fh.getPid(); if (pid > 0) return new RuntimeScalar(pid); return scalarTrue; } + private static String aggregateHandleName(RuntimeScalar fileHandle) { + RuntimeBase aggregate = fileHandle instanceof RuntimeArrayProxyEntry arrayEntry + ? arrayEntry.getParent() + : fileHandle instanceof RuntimeHashProxyEntry hashEntry ? hashEntry.getParent() : null; + if (aggregate == null) return null; + String name = RuntimeCode.findActiveLexicalName(aggregate); + if (name == null) name = GlobalVariable.findGlobalAggregateName(aggregate); + if (name == null || name.length() < 2) return null; + return "$" + name.substring(1) + (aggregate instanceof RuntimeArray ? "[...]" : "{...}"); + } + + private static String normalizeAggregateHandleName(String sourceName) { + if (sourceName == null) return null; + int array = sourceName.indexOf('['); + int hash = sourceName.indexOf('{'); + int delimiter = array >= 0 ? array : hash; + if (delimiter < 0) return null; + String base = sourceName.substring(0, delimiter); + if (base.startsWith("@") || base.startsWith("%")) base = "$" + base.substring(1); + if (!base.startsWith("$")) return null; + return base + (array >= 0 && (hash < 0 || array < hash) ? "[...]" : "{...}"); + } + /** * Close a file handle. * diff --git a/src/main/java/org/perlonjava/runtime/operators/Readline.java b/src/main/java/org/perlonjava/runtime/operators/Readline.java index ba4a9b774d..c66fa7b25a 100644 --- a/src/main/java/org/perlonjava/runtime/operators/Readline.java +++ b/src/main/java/org/perlonjava/runtime/operators/Readline.java @@ -17,6 +17,10 @@ public class Readline { * @return A RuntimeBase with the line(s). */ public static RuntimeBase readline(RuntimeScalar fileHandle, int ctx) { + // Resolving a lexical/aggregate element can retire statement-temporary + // diagnostic state. Save the compiler-provided source spelling before + // that resolution and attach it to the resulting IO below. + String sourceName = RuntimeIO.getLastReadlineHandleName(); if (fileHandle == null || fileHandle.type == RuntimeScalarType.UNDEF) { RuntimeIO.setLastAccessedHandle(null); } @@ -59,6 +63,17 @@ public static RuntimeBase readline(RuntimeScalar fileHandle, int ctx) { return ctx == RuntimeContextType.LIST ? new RuntimeList() : scalarUndef; } + if (sourceName != null && (fh.getDiagnosticReadlineHandleName() == null + || !(fh.getDiagnosticReadlineHandleName().contains("[") + || fh.getDiagnosticReadlineHandleName().contains("{")))) { + fh.setDiagnosticReadlineHandleName(sourceName); + } + // Perl's delayed warn/die filehandle context follows a scalar readline. + // A list read is consumed as a scoped aggregate and must not leave + // context after its lexical handle is released. + RuntimeIO.setLastReadlineHandle( + ctx == RuntimeContextType.LIST ? null : fh); + if (fh instanceof TieHandle tieHandle) { return TieHandle.tiedReadline(tieHandle, ctx); } @@ -70,6 +85,7 @@ public static RuntimeBase readline(RuntimeScalar fileHandle, int ctx) { while ((line = readline(fh)).type != RuntimeScalarType.UNDEF) { lines.elements.add(line); } + RuntimeIO.setLastReadlineHandle(null); return lines; } else { // Handle SCALAR context (original behavior) @@ -84,6 +100,7 @@ public static RuntimeScalar readline(RuntimeIO runtimeIO) { // Check if the IO object is set up for reading // Set this as the last accessed handle for $. (INPUT_LINE_NUMBER) special variable RuntimeIO.setLastAccessedHandle(runtimeIO); + RuntimeIO.setLastReadlineHandle(runtimeIO); // Get the input record separator (equivalent to Perl's $/) RuntimeScalar rsScalar = getGlobalVariable("main::/"); diff --git a/src/main/java/org/perlonjava/runtime/operators/WarnDie.java b/src/main/java/org/perlonjava/runtime/operators/WarnDie.java index 35ec495569..719862a3be 100644 --- a/src/main/java/org/perlonjava/runtime/operators/WarnDie.java +++ b/src/main/java/org/perlonjava/runtime/operators/WarnDie.java @@ -329,6 +329,20 @@ public static RuntimeBase warn(RuntimeBase message, RuntimeScalar where, String whereStr = getPerlLocationFromStack(); } out += whereStr; + if (sig.getDefinedBoolean() && !isReservedSigString(sig)) { + RuntimeIO lastRead = RuntimeIO.getLastReadlineHandle(); + String diagnosticName = lastRead == null ? null : lastRead.getDiagnosticReadlineHandleName(); + // Only a source-level lexical filehandle expression retains + // readline context for a subsequent custom warning handler. + // Named handles such as DATA are used internally while loading + // source and must not decorate unrelated warnings. + if (diagnosticName != null && diagnosticName.startsWith("$")) { + String filehandleContext = getFilehandleContext(); + if (filehandleContext != null && !filehandleContext.isEmpty()) { + out += filehandleContext; + } + } + } // Add period and newline if location info was added if (!whereStr.isEmpty()) { out += ".\n"; @@ -815,8 +829,14 @@ public static RuntimeScalar exit(RuntimeScalar runtimeScalar) { * @return String with filehandle context (including leading ", "), or null if no context */ public static String getFilehandleContext() { - if (RuntimeIO.getLastAccessedHandle() != null && RuntimeIO.getLastAccessedHandle().currentLineNumber > 0) { - String handleName = findFilehandleName(RuntimeIO.getLastAccessedHandle()); + RuntimeIO handle = RuntimeIO.getLastAccessedHandle(); + boolean usingRetainedReadlineHandle = false; + if (handle == null || handle.currentLineNumber == 0) { + handle = RuntimeIO.getLastReadlineHandle(); + usingRetainedReadlineHandle = handle != null; + } + if (handle != null && handle.currentLineNumber > 0) { + String handleName = findFilehandleName(handle); if (handleName != null) { // Perl 5 uses "line" only when $/ is exactly "\n". // Everything else (undef, "", custom separator, ref) uses "chunk". @@ -829,7 +849,11 @@ public static String getFilehandleContext() { } catch (Exception ignored) { // Default to "chunk" if we can't read $/ } - return ", <" + handleName + "> " + unit + " " + RuntimeIO.getLastAccessedHandle().currentLineNumber; + String context = ", <" + handleName + "> " + unit + " " + handle.currentLineNumber; + if (usingRetainedReadlineHandle) { + RuntimeIO.setLastReadlineHandle(null); + } + return context; } } return null; @@ -855,6 +879,9 @@ private static String findFilehandleName(RuntimeIO handle) { } return name; } + if (handle.getDiagnosticReadlineHandleName() != null) { + return handle.getDiagnosticReadlineHandleName(); + } // Fall back to the variable name set during the last readline (e.g., "$f") return RuntimeIO.getLastReadlineHandleName(); } diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalVariable.java b/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalVariable.java index 3187865e85..f082df6f6d 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalVariable.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalVariable.java @@ -1223,6 +1223,17 @@ public static String findGlobalScalarName(RuntimeScalar scalar) { return null; } + /** Return the Perl spelling for an exact global aggregate cell. */ + public static String findGlobalAggregateName(RuntimeBase aggregate) { + for (Map.Entry entry : globalArrays.entrySet()) { + if (entry.getValue() == aggregate) return "@" + entry.getKey().replaceFirst("^main::", ""); + } + for (Map.Entry entry : globalHashes.entrySet()) { + if (entry.getValue() == aggregate) return "%" + entry.getKey().replaceFirst("^main::", ""); + } + return null; + } + private static void tagGeneratedLexicalSubStorage(String key, RuntimeScalar scalar) { if (scalar == null || scalar.lexicalSubName != null) { return; diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeArrayProxyEntry.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeArrayProxyEntry.java index cc136135f5..5d3ec2e220 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeArrayProxyEntry.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeArrayProxyEntry.java @@ -37,6 +37,9 @@ public RuntimeArrayProxyEntry(RuntimeArray parent, int key) { // Note: this.type is RuntimeScalarType.UNDEF } + /** Parent aggregate, used for diagnostics that retain an element's identity. */ + public RuntimeArray getParent() { return parent; } + @Override public RuntimeScalar set(RuntimeScalar value) { if (parent.threadShared) SharedPerlStorage.validateStoredValue(value); diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeIO.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeIO.java index 892a8be970..6c1669799a 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeIO.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeIO.java @@ -71,6 +71,7 @@ Handling pipes (e.g., |- or -| modes). * @see RuntimeScalarReference */ public class RuntimeIO extends RuntimeScalar { + private static final ThreadLocal lastReadlineHandle = new ThreadLocal<>(); // Platform-specific ENOTEMPTY (only errno that differs across platforms in handleIOException) private static final int ENOTEMPTY; @@ -108,13 +109,21 @@ public class RuntimeIO extends RuntimeScalar { public static RuntimeIO getLastAccessedHandle() { return PerlRuntime.current().ioLastAccessedHandle; } public static void setLastAccessedHandle(RuntimeIO io) { PerlRuntime.current().ioLastAccessedHandle = io; } public static String getLastReadlineHandleName() { return PerlRuntime.current().ioLastReadlineHandleName; } + public static RuntimeIO getLastReadlineHandle() { return lastReadlineHandle.get(); } + public static void setLastReadlineHandle(RuntimeIO io) { lastReadlineHandle.set(io); } private boolean ioError; + // An anonymous lexical handle has no glob name. Preserve the source + // expression used for its most recent readline so later warn/die context + // can still name it after statement-temporary cleanup. + private String diagnosticReadlineHandleName; public void markError() { ioError = true; } public RuntimeScalar error() { return new RuntimeScalar(ioError); } public static void setLastReadlineHandleName(String name) { PerlRuntime.current().ioLastReadlineHandleName = name; } + public String getDiagnosticReadlineHandleName() { return diagnosticReadlineHandleName; } + public void setDiagnosticReadlineHandleName(String name) { diagnosticReadlineHandleName = name; } public static RuntimeIO getLastWrittenHandle() { return PerlRuntime.current().ioLastWrittenHandle; } public static void setLastWrittenHandle(RuntimeIO io) { PerlRuntime.current().ioLastWrittenHandle = io; } public static RuntimeIO getSelectedHandle() { return PerlRuntime.current().ioSelectedHandle; } @@ -791,6 +800,14 @@ public static RuntimeIO open(String fileName, String mode) { mode = normalizeOpenMode(mode); RuntimeIO fh = new RuntimeIO(); try { + if (mode.equals(">>>")) { + WarnDie.warn(new RuntimeScalar("Invalid separator character '>' in PerlIO layer spec"), + new RuntimeScalar("")); + throw new PerlCompilerException("Unknown open() mode '>>>'"); + } + if (mode.equals(":c")) { + throw new PerlCompilerException("Unknown open() mode ':c'"); + } String ioLayers = ""; // Check if mode contains IO layers (indicated by ':') int colonIndex = mode.indexOf(':'); @@ -963,10 +980,10 @@ public static RuntimeIO open(RuntimeScalar scalarRef, String mode) { } // Handle different modes - if (mode.equals(">") || mode.equals(">>")) { + if (mode.equals(">") || mode.equals(">>") || mode.equals("+<") || mode.equals("+>")) { // Check if the scalar is read-only before attempting write operations try { - if (mode.equals(">")) { + if (mode.equals(">") || mode.equals("+>")) { // Truncate for write mode - this will throw if read-only // Match Perl behavior: if scalar was undef, keep it undef; // if it was defined, truncate to empty string @@ -976,8 +993,10 @@ public static RuntimeIO open(RuntimeScalar scalarRef, String mode) { // Still need to check read-only for undef scalars targetScalar.set(new RuntimeScalar()); } - } else if (mode.equals(">>")) { - // For append mode, test if scalar is writable by setting it to itself + } else if (mode.equals("+<")) { + // Read/write and append modes need a writable referent too. + // Besides enforcing that rule, this preserves tie FETCH/STORE + // side effects at open time. targetScalar.set(targetScalar.toString()); } } catch (RuntimeException e) { @@ -985,17 +1004,31 @@ public static RuntimeIO open(RuntimeScalar scalarRef, String mode) { // Handle read-only scalar gracefully // Set $! to EACCES (13) - Permission denied GlobalVariable.getGlobalVariable("main::!").set(13); - // Issue warning if $^W is set (lexical warning support for runtime is TODO) - // $^W is stored as main::W (W is ASCII 87, so 87 - 'A' + 1 = 23) - if (GlobalVariable.getGlobalVariable("main::" + Character.toString('W' - 'A' + 1)).getBoolean()) { - WarnDie.warn(new RuntimeScalar("Modification of a read-only value attempted"), new RuntimeScalar("")); - } + // A scalar handle write is in the lexical "layer" + // warning category. Honour both dynamic $^W and the + // compile-time warning bit used by `use warnings 'layer'`. + // $^W is stored as main::W (W is ASCII 87, so 87 - 'A' + 1 = 23). + WarnDie.warnWithCategory(new RuntimeScalar("Modification of a read-only value attempted"), + new RuntimeScalar(""), "layer"); return null; } throw e; // Re-throw if it's a different error } + } else if (mode.equals("<")) { + // Opening PerlIO::scalar reads a magical referent once, even when + // no subsequent read is issued. This also establishes the normal + // tied-scalar FETCH side effect without warning for an undef value. + targetScalar.toString(); + } + + // Avoid a second FETCH for tied scalar referents. Plain scalar + // values are directly available here; tied values are validated by + // ScalarBackedIO at their actual read/write operation. + if (targetScalar.value instanceof String value + && !ScalarBackedIO.isByteMappable(value)) { + ScalarBackedIO.reportNonByteScalar(); + return null; } - // For "<" (read) mode, no special handling needed // Create ScalarBackedIO ScalarBackedIO scalarIO = new ScalarBackedIO(targetScalar); @@ -1407,10 +1440,14 @@ public static String sanitizePathname(String opName, String fileName) { && !WarningFlags.isWarningSuppressedAtRuntime("syscalls")) { String display = fileName.replace("\0", "\\0"); WarnDie.warn( - new RuntimeScalar("Invalid \\\\0 character in pathname for " + opName + ": " + display), + new RuntimeScalar("Invalid \\0 character in pathname for " + opName + ": " + display), new RuntimeScalar("") ); } + // Perl rejects an embedded NUL before calling the OS. Its file + // operation contract still exposes ENOENT for the failed pathname + // (including when several invalid names are supplied). + getGlobalVariable("main::!").set(2); return null; } return s; @@ -1431,10 +1468,11 @@ public static String sanitizeGlobPattern(String pattern) { && !WarningFlags.isWarningSuppressedAtRuntime("syscalls")) { String display = pattern.replace("\0", "\\0"); WarnDie.warn( - new RuntimeScalar("Invalid \\\\0 character in pattern for glob: " + display), + new RuntimeScalar("Invalid \\0 character in pattern for glob: " + display), new RuntimeScalar("") ); } + getGlobalVariable("main::!").set(2); return null; } return s; @@ -1626,6 +1664,9 @@ public RuntimeScalar close() { // This ensures $. becomes 0 and error messages don't include // stale filehandle context after close. currentLineNumber = 0; + if (getLastReadlineHandle() == this) { + setLastReadlineHandle(null); + } return ret; } diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/ScalarSpecialVariable.java b/src/main/java/org/perlonjava/runtime/runtimetypes/ScalarSpecialVariable.java index 3129ada422..002c404c4d 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/ScalarSpecialVariable.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/ScalarSpecialVariable.java @@ -58,6 +58,11 @@ public ScalarSpecialVariable(Id variableId, int position) { this.position = position; } + /** Whether this proxy is a numbered regex capture such as $1 or $99. */ + public boolean isNumberedCapture() { + return variableId == Id.CAPTURE; + } + /** * Throws an exception as this variable represents a constant item * and cannot be modified. diff --git a/src/test/resources/unit/io_open_aggregate_context_and_readonly_capture.t b/src/test/resources/unit/io_open_aggregate_context_and_readonly_capture.t new file mode 100644 index 0000000000..99591dc353 --- /dev/null +++ b/src/test/resources/unit/io_open_aggregate_context_and_readonly_capture.t @@ -0,0 +1,28 @@ +use strict; +use warnings; +use Test::More tests => 3; + +my @handles; +my $input = "line\n"; +open($handles[0], '<', \$input) or die "open: $!"; + +my $warning; +{ + local $SIG{__WARN__} = sub { $warning = shift }; + sub read_then_warn { + my ($handle) = @_; + scalar <$handle>; + warn "context"; + } + read_then_warn($handles[0]); +} +like($warning, qr/<\$handles\[\.\.\.\]> line 1\./, + 'warn retains the original aggregate filehandle context'); + +my $capture_open; +eval { open $99, '<', \$input }; +$capture_open = $@; +like($capture_open, qr/Modification of a read-only value attempted/, + 'open rejects a numbered capture as its filehandle lvalue'); + +ok(close($handles[0]), 'aggregate filehandle remains closable');