From 0cfcea59ad5801c1aaed0b8fed6f841b1ea108ac Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Sun, 1 Mar 2026 23:53:19 +0100 Subject: [PATCH 1/6] Fix undef CODE ref semantics, add Compress::Zlib, fix binary data handling - Fix undef $coderef: ref() now returns "" and boolean is false for undefined CODE scalars, matching Perl 5 behavior. undef &foo still correctly reports "Undefined subroutine" on call. - Add Compress::Zlib module using java.util.zip for inflate/deflate, enabling ExifTool's PNG, PDF, and other compressed format support. - Fix Encode::is_utf8/utf8::is_utf8 to only return true for strings with actual wide characters (>255), preventing binary data corruption in ExifTool's ParseArguments. - Fix slurp-mode readline when $/ is undef (local $/), preserving BYTE_STRING type for binary data. - Fix named sub definition return values: skip compile-time-only nodes when computing block return value, fixing modules without explicit 1; before __END__. Generated with [Devin](https://cli.devin.ai/docs) Co-Authored-By: Devin --- .../backend/bytecode/BytecodeCompiler.java | 13 +- .../org/perlonjava/backend/jvm/EmitBlock.java | 12 +- .../runtime/operators/Readline.java | 23 +- .../runtime/operators/ReferenceOperators.java | 4 + .../runtime/perlmodule/CompressZlib.java | 241 ++++++++++++++++++ .../perlonjava/runtime/perlmodule/Encode.java | 26 +- .../perlonjava/runtime/perlmodule/Utf8.java | 20 +- .../runtime/runtimetypes/RuntimeScalar.java | 2 + src/main/perl/lib/Compress/Zlib.pm | 25 ++ 9 files changed, 332 insertions(+), 34 deletions(-) create mode 100644 src/main/java/org/perlonjava/runtime/perlmodule/CompressZlib.java create mode 100644 src/main/perl/lib/Compress/Zlib.pm diff --git a/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java b/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java index 85177bc6c..02a78a04b 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java +++ b/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java @@ -707,6 +707,17 @@ public void visit(BlockNode node) { // Visit each statement in the block int numStatements = node.elements.size(); + + int lastMeaningfulIndex = -1; + for (int i = numStatements - 1; i >= 0; i--) { + Node elem = node.elements.get(i); + if (elem == null) continue; + if (elem instanceof ListNode ln && ln.elements.isEmpty()) continue; + lastMeaningfulIndex = i; + break; + } + if (lastMeaningfulIndex == -1) lastMeaningfulIndex = numStatements - 1; + for (int i = 0; i < numStatements; i++) { // Skip the 'local $_' child when For1Node handles it via LOCAL_SCALAR_SAVE_LEVEL if (i == 0 && skipFirstChild) continue; @@ -724,7 +735,7 @@ public void visit(BlockNode node) { // If this is not an assignment or other value-using construct, use VOID context // EXCEPT for the last statement in a block, which should use the block's context - boolean isLastStatement = (i == numStatements - 1); + boolean isLastStatement = (i == lastMeaningfulIndex); if (!isLastStatement && !(stmt instanceof BinaryOperatorNode && ((BinaryOperatorNode) stmt).operator.equals("="))) { currentCallContext = RuntimeContextType.VOID; } diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitBlock.java b/src/main/java/org/perlonjava/backend/jvm/EmitBlock.java index a1c02eb1c..2e57374ec 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitBlock.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitBlock.java @@ -116,9 +116,15 @@ public static void emitBlock(EmitterVisitor emitterVisitor, BlockNode node) { int lastNonNullIndex = -1; for (int i = list.size() - 1; i >= 0; i--) { - if (list.get(i) != null) { - lastNonNullIndex = i; - break; + Node elem = list.get(i); + if (elem == null) continue; + if (elem instanceof ListNode ln && ln.elements.isEmpty()) continue; + lastNonNullIndex = i; + break; + } + if (lastNonNullIndex == -1) { + for (int i = list.size() - 1; i >= 0; i--) { + if (list.get(i) != null) { lastNonNullIndex = i; break; } } } diff --git a/src/main/java/org/perlonjava/runtime/operators/Readline.java b/src/main/java/org/perlonjava/runtime/operators/Readline.java index c086f54ca..28f85beb9 100644 --- a/src/main/java/org/perlonjava/runtime/operators/Readline.java +++ b/src/main/java/org/perlonjava/runtime/operators/Readline.java @@ -63,23 +63,32 @@ public static RuntimeScalar readline(RuntimeIO runtimeIO) { } // Handle different modes of $/ - if (rs != null && rs.isSlurpMode()) { - // Handle slurp mode when $/ = undef + boolean isSlurp = (rs != null && rs.isSlurpMode()) || + (rs == null && rsScalar.type == RuntimeScalarType.UNDEF); + if (isSlurp) { StringBuilder content = new StringBuilder(); - String readChar; - while (!(readChar = runtimeIO.ioHandle.read(1).toString()).isEmpty()) { - content.append(readChar.charAt(0)); + boolean isByteData = true; + RuntimeScalar chunk; + while (true) { + chunk = runtimeIO.ioHandle.read(8192); + String chunkStr = chunk.toString(); + if (chunkStr.isEmpty()) break; + if (chunk.type != RuntimeScalarType.BYTE_STRING) isByteData = false; + content.append(chunkStr); } if (content.length() > 0) { - // Count newlines for line number tracking String contentStr = content.toString(); for (int i = 0; i < contentStr.length(); i++) { if (contentStr.charAt(i) == '\n') { runtimeIO.currentLineNumber++; } } - return new RuntimeScalar(contentStr); + RuntimeScalar result = new RuntimeScalar(contentStr); + if (isByteData) { + result.type = RuntimeScalarType.BYTE_STRING; + } + return result; } else if (runtimeIO.eof().getBoolean()) { return scalarUndef; } diff --git a/src/main/java/org/perlonjava/runtime/operators/ReferenceOperators.java b/src/main/java/org/perlonjava/runtime/operators/ReferenceOperators.java index e9448cd46..26e91ecd4 100644 --- a/src/main/java/org/perlonjava/runtime/operators/ReferenceOperators.java +++ b/src/main/java/org/perlonjava/runtime/operators/ReferenceOperators.java @@ -53,6 +53,10 @@ public static RuntimeScalar ref(RuntimeScalar runtimeScalar) { str = ref(runtimeScalar.tiedFetch()).toString(); break; case CODE: + if (!((RuntimeCode) runtimeScalar.value).defined()) { + str = ""; + break; + } blessId = ((RuntimeBase) runtimeScalar.value).blessId; str = blessId == 0 ? "CODE" : NameNormalizer.getBlessStr(blessId); break; diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/CompressZlib.java b/src/main/java/org/perlonjava/runtime/perlmodule/CompressZlib.java new file mode 100644 index 000000000..6b79fbaf3 --- /dev/null +++ b/src/main/java/org/perlonjava/runtime/perlmodule/CompressZlib.java @@ -0,0 +1,241 @@ +package org.perlonjava.runtime.perlmodule; + +import org.perlonjava.runtime.runtimetypes.*; + +import java.nio.charset.StandardCharsets; +import java.util.zip.DataFormatException; +import java.util.zip.Deflater; +import java.util.zip.Inflater; + +import org.perlonjava.runtime.operators.ReferenceOperators; + +import static org.perlonjava.runtime.runtimetypes.RuntimeScalarCache.*; + +public class CompressZlib extends PerlModuleBase { + + private static final String INFLATER_KEY = "_inflater"; + private static final String DEFLATER_KEY = "_deflater"; + + public CompressZlib() { + super("Compress::Zlib", false); + } + + public static void initialize() { + CompressZlib cz = new CompressZlib(); + try { + cz.registerMethod("inflateInit", null); + cz.registerMethod("deflateInit", null); + cz.registerMethod("Z_OK", null); + cz.registerMethod("Z_STREAM_END", null); + cz.registerMethod("Z_STREAM_ERROR", null); + cz.registerMethod("Z_DATA_ERROR", null); + cz.registerMethod("Z_BUF_ERROR", null); + cz.registerMethod("MAX_WBITS", null); + cz.registerMethod("inflate", "inflateMethod", null); + cz.registerMethod("deflate", "deflateMethod", null); + cz.registerMethod("flush", null); + } catch (NoSuchMethodException e) { + System.err.println("Warning: Missing Compress::Zlib method: " + e.getMessage()); + } + } + + public static RuntimeList Z_OK(RuntimeArray args, int ctx) { + return new RuntimeScalar(0).getList(); + } + + public static RuntimeList Z_STREAM_END(RuntimeArray args, int ctx) { + return new RuntimeScalar(1).getList(); + } + + public static RuntimeList Z_STREAM_ERROR(RuntimeArray args, int ctx) { + return new RuntimeScalar(-2).getList(); + } + + public static RuntimeList Z_DATA_ERROR(RuntimeArray args, int ctx) { + return new RuntimeScalar(-3).getList(); + } + + public static RuntimeList Z_BUF_ERROR(RuntimeArray args, int ctx) { + return new RuntimeScalar(-5).getList(); + } + + public static RuntimeList MAX_WBITS(RuntimeArray args, int ctx) { + return new RuntimeScalar(15).getList(); + } + + public static RuntimeList inflateInit(RuntimeArray args, int ctx) { + boolean nowrap = false; + + for (int i = 0; i < args.size() - 1; i++) { + String key = args.get(i).toString(); + if (key.equals("-WindowBits") || key.equals("WindowBits")) { + int wbits = args.get(i + 1).getInt(); + if (wbits < 0) { + nowrap = true; + } + break; + } + } + + try { + Inflater inflater = new Inflater(nowrap); + RuntimeHash self = new RuntimeHash(); + self.put(INFLATER_KEY, new RuntimeScalar(inflater)); + RuntimeScalar ref = self.createReference(); + ReferenceOperators.bless(ref, new RuntimeScalar("Compress::Zlib")); + return ref.getList(); + } catch (Exception e) { + return scalarUndef.getList(); + } + } + + public static RuntimeList deflateInit(RuntimeArray args, int ctx) { + int level = Deflater.DEFAULT_COMPRESSION; + + for (int i = 0; i < args.size() - 1; i++) { + String key = args.get(i).toString(); + if (key.equals("-Level") || key.equals("Level")) { + level = args.get(i + 1).getInt(); + break; + } + } + + try { + Deflater deflater = new Deflater(level); + RuntimeHash self = new RuntimeHash(); + self.put(DEFLATER_KEY, new RuntimeScalar(deflater)); + RuntimeScalar ref = self.createReference(); + ReferenceOperators.bless(ref, new RuntimeScalar("Compress::Zlib")); + return ref.getList(); + } catch (Exception e) { + return scalarUndef.getList(); + } + } + + public static RuntimeList inflateMethod(RuntimeArray args, int ctx) { + if (args.size() < 2) { + RuntimeList result = new RuntimeList(); + result.add(scalarUndef); + result.add(new RuntimeScalar(-2)); + return result; + } + + RuntimeHash self = args.get(0).hashDeref(); + RuntimeScalar dataScalar = args.get(1); + + RuntimeScalar inflaterScalar = self.get(INFLATER_KEY); + if (inflaterScalar == null || inflaterScalar.type != RuntimeScalarType.JAVAOBJECT + || !(inflaterScalar.value instanceof Inflater)) { + RuntimeList result = new RuntimeList(); + result.add(scalarUndef); + result.add(new RuntimeScalar(-2)); + return result; + } + + Inflater inflater = (Inflater) inflaterScalar.value; + String dataStr = dataScalar.toString(); + byte[] input = dataStr.getBytes(StandardCharsets.ISO_8859_1); + inflater.setInput(input); + + byte[] outputBuf = new byte[input.length * 4 + 1024]; + java.io.ByteArrayOutputStream baos = new java.io.ByteArrayOutputStream(); + int status = 0; // Z_OK + + try { + while (!inflater.finished() && !inflater.needsInput()) { + int count = inflater.inflate(outputBuf); + if (count > 0) { + baos.write(outputBuf, 0, count); + } else if (count == 0 && !inflater.finished()) { + break; + } + } + if (inflater.finished()) { + status = 1; // Z_STREAM_END + } + } catch (DataFormatException e) { + RuntimeList result = new RuntimeList(); + result.add(scalarUndef); + result.add(new RuntimeScalar(-3)); // Z_DATA_ERROR + return result; + } + + byte[] outputBytes = baos.toByteArray(); + String outputStr = new String(outputBytes, StandardCharsets.ISO_8859_1); + + RuntimeList result = new RuntimeList(); + RuntimeScalar outputScalar = new RuntimeScalar(outputStr); + outputScalar.type = RuntimeScalarType.BYTE_STRING; + result.add(outputScalar); + result.add(new RuntimeScalar(status)); + return result; + } + + public static RuntimeList deflateMethod(RuntimeArray args, int ctx) { + if (args.size() < 2) { + return scalarUndef.getList(); + } + + RuntimeHash self = args.get(0).hashDeref(); + RuntimeScalar dataScalar = args.get(1); + + RuntimeScalar deflaterScalar = self.get(DEFLATER_KEY); + if (deflaterScalar == null || deflaterScalar.type != RuntimeScalarType.JAVAOBJECT + || !(deflaterScalar.value instanceof Deflater)) { + return scalarUndef.getList(); + } + + Deflater deflater = (Deflater) deflaterScalar.value; + String dataStr = dataScalar.toString(); + byte[] input = dataStr.getBytes(StandardCharsets.ISO_8859_1); + deflater.setInput(input); + + byte[] outputBuf = new byte[input.length + 256]; + java.io.ByteArrayOutputStream baos = new java.io.ByteArrayOutputStream(); + + int count; + while ((count = deflater.deflate(outputBuf, 0, outputBuf.length, Deflater.SYNC_FLUSH)) > 0) { + baos.write(outputBuf, 0, count); + } + + byte[] outputBytes = baos.toByteArray(); + String outputStr = new String(outputBytes, StandardCharsets.ISO_8859_1); + RuntimeScalar outputScalar = new RuntimeScalar(outputStr); + outputScalar.type = RuntimeScalarType.BYTE_STRING; + return outputScalar.getList(); + } + + public static RuntimeList flush(RuntimeArray args, int ctx) { + if (args.isEmpty()) { + return scalarUndef.getList(); + } + + RuntimeHash self = args.get(0).hashDeref(); + RuntimeScalar deflaterScalar = self.get(DEFLATER_KEY); + if (deflaterScalar == null || deflaterScalar.type != RuntimeScalarType.JAVAOBJECT + || !(deflaterScalar.value instanceof Deflater)) { + return scalarUndef.getList(); + } + + Deflater deflater = (Deflater) deflaterScalar.value; + deflater.finish(); + + byte[] outputBuf = new byte[1024]; + java.io.ByteArrayOutputStream baos = new java.io.ByteArrayOutputStream(); + + while (!deflater.finished()) { + int count = deflater.deflate(outputBuf); + if (count > 0) { + baos.write(outputBuf, 0, count); + } else { + break; + } + } + + byte[] outputBytes = baos.toByteArray(); + String outputStr = new String(outputBytes, StandardCharsets.ISO_8859_1); + RuntimeScalar outputScalar = new RuntimeScalar(outputStr); + outputScalar.type = RuntimeScalarType.BYTE_STRING; + return outputScalar.getList(); + } +} diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/Encode.java b/src/main/java/org/perlonjava/runtime/perlmodule/Encode.java index ff1adcede..595d7c1ed 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/Encode.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/Encode.java @@ -175,21 +175,17 @@ public static RuntimeList is_utf8(RuntimeArray args, int ctx) { throw new IllegalStateException("Bad number of arguments for is_utf8"); } - return RuntimeScalarCache.getScalarBoolean(args.get(0).type != BYTE_STRING).getList(); - -// // In PerlOnJava, strings are always internally Unicode (Java strings) -// // So we'll check if the string contains any non-ASCII characters -// String string = args.get(0).toString(); -// boolean hasNonAscii = false; -// -// for (int i = 0; i < string.length(); i++) { -// if (string.charAt(i) > 127) { -// hasNonAscii = true; -// break; -// } -// } -// -// return new RuntimeScalar(hasNonAscii).getList(); + RuntimeScalar arg = args.get(0); + if (arg.type == BYTE_STRING) { + return RuntimeScalarCache.scalarFalse.getList(); + } + String s = arg.toString(); + for (int i = 0; i < s.length(); i++) { + if (s.charAt(i) > 255) { + return RuntimeScalarCache.scalarTrue.getList(); + } + } + return RuntimeScalarCache.scalarFalse.getList(); } /** diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/Utf8.java b/src/main/java/org/perlonjava/runtime/perlmodule/Utf8.java index 61469c090..6686b0032 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/Utf8.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/Utf8.java @@ -322,14 +322,18 @@ public static RuntimeList isUtf8(RuntimeArray args, int ctx) { throw new IllegalStateException("Bad number of arguments for is_utf8() method"); } RuntimeScalar scalar = args.get(0); - return RuntimeScalarCache.getScalarBoolean(scalar.type == STRING).getList(); - -// String string = scalar.toString(); -// CharsetDetector detector = new CharsetDetector(); -// detector.setText(string.getBytes()); -// CharsetMatch match = detector.detect(); -// boolean isUtf8 = match != null && "UTF-8".equalsIgnoreCase(match.getName()); -// return new RuntimeScalar(isUtf8).getList(); + if (scalar.type == BYTE_STRING) { + return RuntimeScalarCache.scalarFalse.getList(); + } + if (scalar.type == STRING) { + String s = scalar.toString(); + for (int i = 0; i < s.length(); i++) { + if (s.charAt(i) > 255) { + return RuntimeScalarCache.scalarTrue.getList(); + } + } + } + return RuntimeScalarCache.scalarFalse.getList(); } /** diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java index c877844d3..d7529526b 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java @@ -587,6 +587,7 @@ private boolean getBooleanLarge() { case JAVAOBJECT -> value != null; case TIED_SCALAR -> this.tiedFetch().getBoolean(); case DUALVAR -> ((DualVar) this.value).stringValue().getBoolean(); + case CODE -> ((RuntimeCode) value).defined(); default -> Overload.boolify(this).getBoolean(); }; } @@ -755,6 +756,7 @@ private String toStringLarge() { case JAVAOBJECT -> value.toString(); case TIED_SCALAR -> this.tiedFetch().toString(); case DUALVAR -> ((DualVar) this.value).stringValue().toString(); + case CODE -> ((RuntimeCode) value).defined() ? Overload.stringify(this).toString() : ""; default -> { if (type == REGEX) yield value.toString(); yield Overload.stringify(this).toString(); diff --git a/src/main/perl/lib/Compress/Zlib.pm b/src/main/perl/lib/Compress/Zlib.pm new file mode 100644 index 000000000..944982e0d --- /dev/null +++ b/src/main/perl/lib/Compress/Zlib.pm @@ -0,0 +1,25 @@ +package Compress::Zlib; +use strict; +use warnings; + +our $VERSION = '2.106'; + +use Exporter; +our @ISA = qw(Exporter); + +XSLoader::load('Compress::Zlib'); + +our @EXPORT = qw( + inflateInit + deflateInit + Z_OK + Z_STREAM_END + Z_STREAM_ERROR + Z_DATA_ERROR + Z_BUF_ERROR + MAX_WBITS +); + +our @EXPORT_OK = @EXPORT; + +1; From 4276ed1f1b4f1ee1b81b6e0358feaed275e47bae Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Mon, 2 Mar 2026 00:23:05 +0100 Subject: [PATCH 2/6] Fix \&foo code reference for forward-declared subs MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit \&foo where foo was only forward-declared (sub foo;) was returning undef instead of a CODE reference. This broke ExifTool's AUTOLOAD mechanism for lazily loading write modules (WriteExif.pl, etc), causing all TIFF/EXIF write operations to fail. The fix adds an IdentifierNode case in EmitOperator's backslash handler that creates a RuntimeScalar with the sub name and calls createCodeReference, matching how Perl 5 handles \& on stash entries. Also make Utf8.java is_utf8 consistent (true for all non-BYTE_STRING) and fix perl_test_runner.pl to not chdir for ExifTool tests. ExifTool test improvements vs baseline: GIF: 2→5, IPTC: 7→8, GeoTiff: 3→4, PLUS: 2→3, PPM: 2→3, Writer: 30→33, CanonVRD: 13→21, XMP: 40→41, PNG: 4+crash→5 Generated with [Devin](https://cli.devin.ai/docs) Co-Authored-By: Devin --- dev/tools/perl_test_runner.pl | 3 ++- .../perlonjava/backend/jvm/EmitOperator.java | 17 ++++++++++++++++- .../org/perlonjava/runtime/perlmodule/Utf8.java | 10 +--------- 3 files changed, 19 insertions(+), 11 deletions(-) diff --git a/dev/tools/perl_test_runner.pl b/dev/tools/perl_test_runner.pl index ac53c28d9..2a2da2874 100755 --- a/dev/tools/perl_test_runner.pl +++ b/dev/tools/perl_test_runner.pl @@ -291,7 +291,8 @@ sub run_single_test { } # For tests in t/ directory (t/op/, t/base/, etc.), change to t/ # so they can find ./test.pl via require - elsif ($test_file =~ m{^t/}) { + # But not for ExifTool tests which need to run from their root dir + elsif ($test_file =~ m{^t/} && !-f 't/TestLib.pm') { $local_test_dir = 't'; } diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitOperator.java b/src/main/java/org/perlonjava/backend/jvm/EmitOperator.java index f8cde803e..274d311fe 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitOperator.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitOperator.java @@ -1196,7 +1196,22 @@ static void handleCreateReference(EmitterVisitor emitterVisitor, OperatorNode no if (node.operand instanceof OperatorNode operatorNode && operatorNode.operator.equals("&")) { emitterVisitor.ctx.logDebug("Handle \\& " + operatorNode.operand); - if (operatorNode.operand instanceof OperatorNode || + if (operatorNode.operand instanceof IdentifierNode identifierNode) { + emitterVisitor.ctx.mv.visitTypeInsn(Opcodes.NEW, "org/perlonjava/runtime/runtimetypes/RuntimeScalar"); + emitterVisitor.ctx.mv.visitInsn(Opcodes.DUP); + emitterVisitor.ctx.mv.visitLdcInsn(identifierNode.name); + emitterVisitor.ctx.mv.visitMethodInsn(Opcodes.INVOKESPECIAL, + "org/perlonjava/runtime/runtimetypes/RuntimeScalar", + "", + "(Ljava/lang/String;)V", + false); + emitterVisitor.pushCurrentPackage(); + emitterVisitor.ctx.mv.visitMethodInsn(Opcodes.INVOKESTATIC, + "org/perlonjava/runtime/runtimetypes/RuntimeCode", + "createCodeReference", + "(Lorg/perlonjava/runtime/runtimetypes/RuntimeScalar;Ljava/lang/String;)Lorg/perlonjava/runtime/runtimetypes/RuntimeScalar;", + false); + } else if (operatorNode.operand instanceof OperatorNode || operatorNode.operand instanceof BlockNode) { operatorNode.operand.accept(emitterVisitor.with(RuntimeContextType.SCALAR)); emitterVisitor.pushCurrentPackage(); diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/Utf8.java b/src/main/java/org/perlonjava/runtime/perlmodule/Utf8.java index 6686b0032..a4711b5bd 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/Utf8.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/Utf8.java @@ -325,15 +325,7 @@ public static RuntimeList isUtf8(RuntimeArray args, int ctx) { if (scalar.type == BYTE_STRING) { return RuntimeScalarCache.scalarFalse.getList(); } - if (scalar.type == STRING) { - String s = scalar.toString(); - for (int i = 0; i < s.length(); i++) { - if (s.charAt(i) > 255) { - return RuntimeScalarCache.scalarTrue.getList(); - } - } - } - return RuntimeScalarCache.scalarFalse.getList(); + return RuntimeScalarCache.scalarTrue.getList(); } /** From c9fb1475d439afdef991c4c3e07c94b6639f601f Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Mon, 2 Mar 2026 09:23:44 +0100 Subject: [PATCH 3/6] Revert EmitBlock empty ListNode skipping that broke signatures MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The previous change to skip empty ListNodes when finding the last expression in a block caused sub foo($a) { } to return the argument value instead of undef. The \&foo code reference fix was the actual solution for the ExifTool named sub return issue. Fixes 13 regressions in op/signatures.t (589→602). Generated with [Devin](https://cli.devin.ai/docs) Co-Authored-By: Devin --- .../java/org/perlonjava/backend/jvm/EmitBlock.java | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitBlock.java b/src/main/java/org/perlonjava/backend/jvm/EmitBlock.java index 2e57374ec..a1c02eb1c 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitBlock.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitBlock.java @@ -116,15 +116,9 @@ public static void emitBlock(EmitterVisitor emitterVisitor, BlockNode node) { int lastNonNullIndex = -1; for (int i = list.size() - 1; i >= 0; i--) { - Node elem = list.get(i); - if (elem == null) continue; - if (elem instanceof ListNode ln && ln.elements.isEmpty()) continue; - lastNonNullIndex = i; - break; - } - if (lastNonNullIndex == -1) { - for (int i = list.size() - 1; i >= 0; i--) { - if (list.get(i) != null) { lastNonNullIndex = i; break; } + if (list.get(i) != null) { + lastNonNullIndex = i; + break; } } From 52f740935a09d1364218354334bb947a526a3198 Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Mon, 2 Mar 2026 09:40:37 +0100 Subject: [PATCH 4/6] Fix can() for forward-declared subs: CODE type always truthy in boolean context In Perl 5, all code references are truthy regardless of whether the sub body is defined. Changed getBooleanLarge() CODE case to return true (zero memory cost). This fixes can() returning falsy for forward-declared subs (uni/universal.t test 16) while preserving identity comparison (mro/basic.t test 56). Generated with [Devin](https://cli.devin.ai/docs) Co-Authored-By: Devin --- .../java/org/perlonjava/runtime/perlmodule/Universal.java | 6 ++---- .../org/perlonjava/runtime/runtimetypes/RuntimeScalar.java | 2 +- 2 files changed, 3 insertions(+), 5 deletions(-) diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/Universal.java b/src/main/java/org/perlonjava/runtime/perlmodule/Universal.java index 5879e68b9..77c1d8153 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/Universal.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/Universal.java @@ -130,12 +130,10 @@ public static RuntimeList can(RuntimeArray args, int ctx) { return method.getList(); } - // Forward declarations (sub foo;) exist in the stash but are not "defined" in the - // Perl sense, so findMethodInHierarchy skips them (falling through to AUTOLOAD). - // However, can() should still return the coderef for forward declarations. String normalizedName = NameNormalizer.normalizeVariableName(methodName, perlClassName); if (GlobalVariable.existsGlobalCodeRef(normalizedName)) { - return GlobalVariable.getGlobalCodeRef(normalizedName).getList(); + RuntimeScalar codeRef = GlobalVariable.getGlobalCodeRef(normalizedName); + return codeRef.getList(); } // Fallback: if either the class name or method name was stored as UTF-8 octets diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java index d7529526b..c5aedd092 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java @@ -587,7 +587,7 @@ private boolean getBooleanLarge() { case JAVAOBJECT -> value != null; case TIED_SCALAR -> this.tiedFetch().getBoolean(); case DUALVAR -> ((DualVar) this.value).stringValue().getBoolean(); - case CODE -> ((RuntimeCode) value).defined(); + case CODE -> true; default -> Overload.boolify(this).getBoolean(); }; } From 7b705dc09cfe513a3c2fc2e36d69d4aea95e70ba Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Mon, 2 Mar 2026 10:39:17 +0100 Subject: [PATCH 5/6] Add alarm bytecode opcode for interpreter mode Previously alarm only worked in the JVM codegen path. Add ALARM_OP (opcode 155) with compilation, interpretation, and disassembly support so alarm works correctly in eval STRING contexts. Generated with [Devin](https://cli.devin.ai/docs) Co-Authored-By: Devin --- .../backend/bytecode/BytecodeInterpreter.java | 3 +++ .../backend/bytecode/CompileOperator.java | 18 ++++++++++++++++++ .../backend/bytecode/InterpretedCode.java | 5 +++++ .../perlonjava/backend/bytecode/Opcodes.java | 2 ++ .../backend/bytecode/SlowOpcodeHandler.java | 11 +++++++++++ 5 files changed, 39 insertions(+) diff --git a/src/main/java/org/perlonjava/backend/bytecode/BytecodeInterpreter.java b/src/main/java/org/perlonjava/backend/bytecode/BytecodeInterpreter.java index d45a8f3e4..c052bbe8b 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/BytecodeInterpreter.java +++ b/src/main/java/org/perlonjava/backend/bytecode/BytecodeInterpreter.java @@ -2030,6 +2030,7 @@ public static RuntimeList execute(InterpretedCode code, RuntimeArray args, int c case Opcodes.SELECT_OP: case Opcodes.LOAD_GLOB: case Opcodes.SLEEP_OP: + case Opcodes.ALARM_OP: case Opcodes.DEREF_GLOB: case Opcodes.LOAD_GLOB_DYNAMIC: case Opcodes.DEREF_SCALAR_STRICT: @@ -3143,6 +3144,8 @@ private static int executeSpecialIO(int opcode, int[] bytecode, int pc, return SlowOpcodeHandler.executeLoadGlob(bytecode, pc, registers, code); case Opcodes.SLEEP_OP: return SlowOpcodeHandler.executeSleep(bytecode, pc, registers); + case Opcodes.ALARM_OP: + return SlowOpcodeHandler.executeAlarm(bytecode, pc, registers); case Opcodes.DEREF_GLOB: return SlowOpcodeHandler.executeDerefGlob(bytecode, pc, registers, code); case Opcodes.LOAD_GLOB_DYNAMIC: diff --git a/src/main/java/org/perlonjava/backend/bytecode/CompileOperator.java b/src/main/java/org/perlonjava/backend/bytecode/CompileOperator.java index bde09565d..e4a05573a 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/CompileOperator.java +++ b/src/main/java/org/perlonjava/backend/bytecode/CompileOperator.java @@ -448,6 +448,24 @@ public static void visitOperator(BytecodeCompiler bytecodeCompiler, OperatorNode bytecodeCompiler.emitReg(maxReg); } + bytecodeCompiler.lastResultReg = rd; + } else if (op.equals("alarm")) { + int rd = bytecodeCompiler.allocateRegister(); + if (node.operand != null) { + node.operand.accept(bytecodeCompiler); + int argReg = bytecodeCompiler.lastResultReg; + bytecodeCompiler.emit(Opcodes.ALARM_OP); + bytecodeCompiler.emitReg(rd); + bytecodeCompiler.emitReg(argReg); + } else { + int zeroReg = bytecodeCompiler.allocateRegister(); + bytecodeCompiler.emit(Opcodes.LOAD_INT); + bytecodeCompiler.emitReg(zeroReg); + bytecodeCompiler.emitInt(0); + bytecodeCompiler.emit(Opcodes.ALARM_OP); + bytecodeCompiler.emitReg(rd); + bytecodeCompiler.emitReg(zeroReg); + } bytecodeCompiler.lastResultReg = rd; } else if (op.equals("study")) { // study $var diff --git a/src/main/java/org/perlonjava/backend/bytecode/InterpretedCode.java b/src/main/java/org/perlonjava/backend/bytecode/InterpretedCode.java index ac2f5af32..683cdf271 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/InterpretedCode.java +++ b/src/main/java/org/perlonjava/backend/bytecode/InterpretedCode.java @@ -1359,6 +1359,11 @@ public String disassemble() { rs = bytecode[pc++]; sb.append("SLEEP_OP r").append(rd).append(" = sleep(r").append(rs).append(")\n"); break; + case Opcodes.ALARM_OP: + rd = bytecode[pc++]; + rs = bytecode[pc++]; + sb.append("ALARM_OP r").append(rd).append(" = alarm(r").append(rs).append(")\n"); + break; case Opcodes.DEREF_GLOB: rd = bytecode[pc++]; rs = 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 b110638c1..cdb872985 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/Opcodes.java +++ b/src/main/java/org/perlonjava/backend/bytecode/Opcodes.java @@ -603,6 +603,8 @@ public class Opcodes { public static final short LOAD_GLOB = 153; /** rd = Time.sleep(seconds) - sleep for specified seconds */ public static final short SLEEP_OP = 154; + /** rd = Time.alarm(seconds) - set alarm timer */ + public static final short ALARM_OP = 155; // ================================================================= // PHASE 3: OPERATORHANDLER PROMOTIONS (400-499) - Math Operators diff --git a/src/main/java/org/perlonjava/backend/bytecode/SlowOpcodeHandler.java b/src/main/java/org/perlonjava/backend/bytecode/SlowOpcodeHandler.java index f68db44ea..4fdb11f3a 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/SlowOpcodeHandler.java +++ b/src/main/java/org/perlonjava/backend/bytecode/SlowOpcodeHandler.java @@ -492,6 +492,17 @@ public static int executeSleep( return pc; } + public static int executeAlarm( + int[] bytecode, + int pc, + RuntimeBase[] registers) { + int rd = bytecode[pc++]; + int secondsReg = bytecode[pc++]; + RuntimeScalar seconds = registers[secondsReg].scalar(); + registers[rd] = Time.alarm(RuntimeContextType.SCALAR, seconds); + return pc; + } + /** * Dereference array reference for multidimensional array access. * Handles: $array[0][1] which is really $array[0]->[1] From 94389ebd8c52515c7519266fbe8609f0c88cd897 Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Mon, 2 Mar 2026 10:47:28 +0100 Subject: [PATCH 6/6] Fix signal dispatch: select interrupt handling, kill-self routing, system alarm, stale flag cleanup - select(undef,undef,undef,timeout): dispatch pending signals on InterruptedException, clear stale interrupt before sleeping (fixes sigdispatch.t tests 22-23) - kill to self-PID: route through PerlSignalQueue instead of sending real OS signals that crash the JVM (fixes sigdispatch.t test 28) - PerlSignalQueue: clear thread interrupt flag and update hasPendingSignal before handler invocation so die in handlers does not leave stale state - system(): dispatch pending signals on InterruptedException instead of throwing PerlCompilerException (fixes alarm.t tests 3-4) sigdispatch.t: 23/29 -> 26/29, alarm.t: 3/5 -> 5/5 Generated with [Devin](https://cli.devin.ai/docs) Co-Authored-By: Devin --- .../runtime/operators/IOOperator.java | 7 +++-- .../runtime/operators/KillOperator.java | 26 ++++++++++++++++++- .../runtime/operators/SystemOperator.java | 8 +++--- .../perlonjava/runtime/operators/Time.java | 6 ----- .../runtime/runtimetypes/PerlSignalQueue.java | 7 +++-- 5 files changed, 35 insertions(+), 19 deletions(-) diff --git a/src/main/java/org/perlonjava/runtime/operators/IOOperator.java b/src/main/java/org/perlonjava/runtime/operators/IOOperator.java index 93d44cac2..254c05196 100644 --- a/src/main/java/org/perlonjava/runtime/operators/IOOperator.java +++ b/src/main/java/org/perlonjava/runtime/operators/IOOperator.java @@ -46,15 +46,14 @@ public static RuntimeScalar select(RuntimeList runtimeList, int ctx) { if (!rbits.getDefinedBoolean() && !wbits.getDefinedBoolean() && !ebits.getDefinedBoolean()) { double sleepTime = timeout.getDouble(); if (sleepTime > 0) { + Thread.interrupted(); try { - // Convert seconds to milliseconds long millis = (long) (sleepTime * 1000); int nanos = (int) ((sleepTime * 1000 - millis) * 1_000_000); Thread.sleep(millis, nanos); } catch (InterruptedException e) { - // Restore interrupted status - Thread.currentThread().interrupt(); - // Return remaining time (we don't track it precisely, so return 0) + PerlSignalQueue.checkPendingSignals(); + Thread.interrupted(); return new RuntimeScalar(0); } } diff --git a/src/main/java/org/perlonjava/runtime/operators/KillOperator.java b/src/main/java/org/perlonjava/runtime/operators/KillOperator.java index 9e48dd929..c9c674b97 100644 --- a/src/main/java/org/perlonjava/runtime/operators/KillOperator.java +++ b/src/main/java/org/perlonjava/runtime/operators/KillOperator.java @@ -6,9 +6,11 @@ import com.sun.jna.platform.win32.Wincon; import org.perlonjava.runtime.nativ.NativeUtils; import org.perlonjava.runtime.nativ.PosixLibrary; +import org.perlonjava.runtime.runtimetypes.PerlSignalQueue; import org.perlonjava.runtime.runtimetypes.RuntimeBase; import org.perlonjava.runtime.runtimetypes.RuntimeScalar; +import static org.perlonjava.runtime.runtimetypes.GlobalVariable.getGlobalHash; import static org.perlonjava.runtime.runtimetypes.GlobalVariable.getGlobalVariable; /** @@ -68,8 +70,30 @@ public static RuntimeScalar kill(int ctx, RuntimeBase... args) { return new RuntimeScalar(successCount); } - // Helper method for sending signals to a single process + private static String getSignalName(int signal) { + return switch (signal) { + case 1 -> "HUP"; case 2 -> "INT"; case 3 -> "QUIT"; case 4 -> "ILL"; + case 5 -> "TRAP"; case 6 -> "ABRT"; case 7 -> "BUS"; case 8 -> "FPE"; + case 9 -> "KILL"; case 10 -> "USR1"; case 11 -> "SEGV"; case 12 -> "USR2"; + case 13 -> "PIPE"; case 14 -> "ALRM"; case 15 -> "TERM"; + default -> null; + }; + } + private static boolean sendSignalToPid(int pid, int signal) { + long myPid = ProcessHandle.current().pid(); + if (pid == myPid && signal != 0) { + String sigName = getSignalName(signal); + if (sigName != null) { + RuntimeScalar handler = getGlobalHash("main::SIG").get(sigName); + if (handler.getDefinedBoolean()) { + PerlSignalQueue.enqueue(sigName, handler); + PerlSignalQueue.checkPendingSignals(); + return true; + } + } + return true; + } if (NativeUtils.IS_WINDOWS) { switch (signal) { case 0: // Check if process exists diff --git a/src/main/java/org/perlonjava/runtime/operators/SystemOperator.java b/src/main/java/org/perlonjava/runtime/operators/SystemOperator.java index 596541d44..f5646c550 100644 --- a/src/main/java/org/perlonjava/runtime/operators/SystemOperator.java +++ b/src/main/java/org/perlonjava/runtime/operators/SystemOperator.java @@ -184,8 +184,8 @@ private static CommandResult executeCommand(String command, boolean captureOutpu setGlobalVariable("main::!", e.getMessage()); exitCode = -1; } catch (InterruptedException e) { - Thread.currentThread().interrupt(); - throw new PerlCompilerException("Command execution interrupted: " + e.getMessage()); + PerlSignalQueue.checkPendingSignals(); + Thread.interrupted(); } finally { // Readers are closed automatically by try-with-resources in threads if (process != null) { @@ -236,8 +236,8 @@ private static CommandResult executeCommandDirect(List commandArgs) { setGlobalVariable("main::!", e.getMessage()); exitCode = -1; } catch (InterruptedException e) { - Thread.currentThread().interrupt(); - throw new PerlCompilerException("Command execution interrupted: " + e.getMessage()); + PerlSignalQueue.checkPendingSignals(); + Thread.interrupted(); } finally { closeQuietly(reader); closeQuietly(errorReader); diff --git a/src/main/java/org/perlonjava/runtime/operators/Time.java b/src/main/java/org/perlonjava/runtime/operators/Time.java index 85b5931da..06a9d7b83 100644 --- a/src/main/java/org/perlonjava/runtime/operators/Time.java +++ b/src/main/java/org/perlonjava/runtime/operators/Time.java @@ -212,13 +212,7 @@ public static RuntimeScalar alarm(int ctx, RuntimeBase... args) { * This method should be called at safe execution points in the interpreter. */ public static void checkPendingSignals() { - // Process any queued signals PerlSignalQueue.processSignals(); - - // Clear interrupt flag if it was set by alarm - if (Thread.interrupted()) { - // The interrupt was handled via signal processing - } } /** diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/PerlSignalQueue.java b/src/main/java/org/perlonjava/runtime/runtimetypes/PerlSignalQueue.java index cbcae32b4..5aa28775e 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/PerlSignalQueue.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/PerlSignalQueue.java @@ -52,16 +52,15 @@ public static void processSignals() { * Internal implementation of signal processing. */ private static void processSignalsImpl() { + Thread.interrupted(); SignalEvent event; while ((event = signalQueue.poll()) != null) { - // Execute the handler - this may throw PerlCompilerException (from die) + hasPendingSignal = !signalQueue.isEmpty(); RuntimeArray args = new RuntimeArray(); args.push(new RuntimeScalar(event.signal)); RuntimeCode.apply(event.handler, args, RuntimeContextType.VOID); - // Note: If the handler throws an exception, it will propagate immediately - // and we won't process remaining signals in the queue } - hasPendingSignal = false; // Clear flag after processing all signals + hasPendingSignal = false; } /**