From aefb34f7af27a52baffde814f939c69142167da5 Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Sat, 15 Aug 2026 17:36:26 +0200 Subject: [PATCH 1/8] fix: unblock CPAN compiler and tooling paths Close subprocess stdin pipes, support escaped hash keys in interpolation, and harden MakeMaker script and AutoSplit staging. Add Java-backed Text::QRCode and Math::Cephes compatibility plus correct Compress::Zlib streaming context behavior. Generated with [Codex](https://openai.com/codex) Co-Authored-By: Codex --- build.gradle | 1 + docs/reference/xs-compatibility.md | 2 + gradle/libs.versions.toml | 2 + .../encoder/PerlOnJavaByteModeEncoder.java | 60 +++++ .../perlonjava/frontend/parser/Variable.java | 45 ++++ .../runtime/operators/SystemOperator.java | 26 +- .../runtime/perlmodule/CompressZlib.java | 10 +- .../runtime/perlmodule/MathCephes.java | 117 +++++++++ .../runtime/perlmodule/TextQRCode.java | 229 ++++++++++++++++++ src/main/perl/lib/ExtUtils/MakeMaker.pm | 4 +- .../resources/unit/io_compress_regressions.t | 12 +- .../makemaker_autosplit_autoloader_only.t | 13 +- src/test/resources/unit/makemaker_exe_files.t | 4 +- src/test/resources/unit/math_cephes_java_xs.t | 14 ++ .../string_interpolation_escaped_hash_key.t | 11 + .../resources/unit/system_child_stdin_eof.t | 12 + src/test/resources/unit/text_qrcode_java_xs.t | 16 ++ 17 files changed, 561 insertions(+), 17 deletions(-) create mode 100644 src/main/java/com/google/zxing/qrcode/encoder/PerlOnJavaByteModeEncoder.java create mode 100644 src/main/java/org/perlonjava/runtime/perlmodule/MathCephes.java create mode 100644 src/main/java/org/perlonjava/runtime/perlmodule/TextQRCode.java create mode 100644 src/test/resources/unit/math_cephes_java_xs.t create mode 100644 src/test/resources/unit/string_interpolation_escaped_hash_key.t create mode 100644 src/test/resources/unit/system_child_stdin_eof.t create mode 100644 src/test/resources/unit/text_qrcode_java_xs.t diff --git a/build.gradle b/build.gradle index f065399dc..56d4dbbe0 100644 --- a/build.gradle +++ b/build.gradle @@ -217,6 +217,7 @@ dependencies { implementation libs.jing // RELAX NG validation for XML::LibXML implementation libs.snakeyaml.engine // YAML processing implementation libs.tomlj // TOML processing + implementation libs.zxing.core // QR encoding for Text::QRCode implementation libs.commons.csv // CSV processing implementation libs.commonmark // CommonMark rendering implementation libs.commonmark.autolink // GFM autolinks diff --git a/docs/reference/xs-compatibility.md b/docs/reference/xs-compatibility.md index e0d480bb9..e17c9b305 100644 --- a/docs/reference/xs-compatibility.md +++ b/docs/reference/xs-compatibility.md @@ -26,6 +26,8 @@ These modules have optimized Java implementations built into PerlOnJava: | Exporter::Lexical | ExporterLexical.java | 0.02 | Installs lexical subs into the enclosing compile-time scope | | HTML::Content::Extractor | HTMLContentExtractor.java | 0.17 | Uses jsoup's HTML5 parser with a small legacy tree-compatibility layer | | Crypt::Twofish2 | CryptTwofish2.java | 1.03 | Uses BouncyCastle Twofish; ECB, stateful zero-IV CBC, and CFB1 | +| Math::Cephes | MathCephes.java | 0.5308 | Implements the normal and chi-square distribution functions used by CPAN statistics modules | +| Text::QRCode | TextQRCode.java | 0.05 | Uses ZXing in forced byte mode with libqrencode-compatible mask selection | ## Modules with PP Fallbacks or Shims diff --git a/gradle/libs.versions.toml b/gradle/libs.versions.toml index 9c1999f26..70675ff7e 100644 --- a/gradle/libs.versions.toml +++ b/gradle/libs.versions.toml @@ -13,6 +13,7 @@ snappy-java = "1.1.10.8" sqlite-jdbc = "3.53.2.1" tomlj = "1.1.1" zstd-jni = "1.5.7-8" +zxing = "3.5.4" [libraries] asm = { module = "org.ow2.asm:asm", version.ref = "asm" } @@ -37,6 +38,7 @@ snappy-java = { module = "org.xerial.snappy:snappy-java", version.ref = "snappy- sqlite-jdbc = { module = "org.xerial:sqlite-jdbc", version.ref = "sqlite-jdbc" } tomlj = { module = "org.tomlj:tomlj", version.ref = "tomlj" } zstd-jni = { module = "com.github.luben:zstd-jni", version.ref = "zstd-jni" } +zxing-core = { module = "com.google.zxing:core", version.ref = "zxing" } [plugins] cyclonedx = "org.cyclonedx.bom:2.3.0" diff --git a/src/main/java/com/google/zxing/qrcode/encoder/PerlOnJavaByteModeEncoder.java b/src/main/java/com/google/zxing/qrcode/encoder/PerlOnJavaByteModeEncoder.java new file mode 100644 index 000000000..037a19290 --- /dev/null +++ b/src/main/java/com/google/zxing/qrcode/encoder/PerlOnJavaByteModeEncoder.java @@ -0,0 +1,60 @@ +package com.google.zxing.qrcode.encoder; + +import com.google.zxing.WriterException; +import com.google.zxing.common.BitArray; +import com.google.zxing.qrcode.decoder.ErrorCorrectionLevel; +import com.google.zxing.qrcode.decoder.Mode; +import com.google.zxing.qrcode.decoder.Version; + +import java.nio.charset.Charset; + +/** Accesses ZXing's package-level encoder primitives to force QR byte mode. */ +public final class PerlOnJavaByteModeEncoder { + private PerlOnJavaByteModeEncoder() { + } + + public static QRCode encode(String text, Charset charset, ErrorCorrectionLevel level, + int requestedVersion, int mask) throws WriterException { + BitArray data = new BitArray(); + Encoder.append8BitBytes(text, data, charset); + + Version version = requestedVersion > 0 + ? Version.getVersionForNumber(requestedVersion) + : smallestVersion(data, level); + BitArray headerAndData = new BitArray(); + Encoder.appendModeInfo(Mode.BYTE, headerAndData); + Encoder.appendLengthInfo(data.getSizeInBytes(), version, Mode.BYTE, headerAndData); + headerAndData.appendBitArray(data); + + Version.ECBlocks ecBlocks = version.getECBlocksForLevel(level); + int totalCodewords = version.getTotalCodewords(); + int dataCodewords = totalCodewords - ecBlocks.getTotalECCodewords(); + if (!Encoder.willFit(headerAndData.getSize(), version, level)) { + throw new WriterException("Data too big for requested version"); + } + Encoder.terminateBits(dataCodewords, headerAndData); + BitArray finalBits = Encoder.interleaveWithECBytes( + headerAndData, totalCodewords, dataCodewords, ecBlocks.getNumBlocks()); + + ByteMatrix matrix = new ByteMatrix( + version.getDimensionForVersion(), version.getDimensionForVersion()); + MatrixUtil.buildMatrix(finalBits, level, version, mask, matrix); + QRCode result = new QRCode(); + result.setMode(Mode.BYTE); + result.setECLevel(level); + result.setVersion(version); + result.setMaskPattern(mask); + result.setMatrix(matrix); + return result; + } + + private static Version smallestVersion(BitArray data, ErrorCorrectionLevel level) + throws WriterException { + for (int number = 1; number <= 40; number++) { + Version version = Version.getVersionForNumber(number); + int bits = 4 + Mode.BYTE.getCharacterCountBits(version) + data.getSize(); + if (Encoder.willFit(bits, version, level)) return version; + } + throw new WriterException("Data too big"); + } +} diff --git a/src/main/java/org/perlonjava/frontend/parser/Variable.java b/src/main/java/org/perlonjava/frontend/parser/Variable.java index 3b57853bb..8bccdc03e 100644 --- a/src/main/java/org/perlonjava/frontend/parser/Variable.java +++ b/src/main/java/org/perlonjava/frontend/parser/Variable.java @@ -519,6 +519,7 @@ static Node parseArrayHashAccessInBraces(Parser parser, Node operand, boolean is } case "{" -> { // Hash access + preprocessBackslashQuotesInInterpolatedHashAccess(parser, parser.tokenIndex); operand = ParseInfix.parseInfixOperation(parser, operand, 0); if (operand == null) { throw new PerlCompilerException(parser.tokenIndex, "syntax error: Missing closing brace", parser.ctx.errorUtil); @@ -534,6 +535,10 @@ static Node parseArrayHashAccessInBraces(Parser parser, Node operand, boolean is switch (text) { case "[", "{", "@*", "$*", "%*", "&*", "$#", "@", "%" -> { // Dereference followed by access: $var->[0] or $var->{key} + if (text.equals("{")) { + preprocessBackslashQuotesInInterpolatedHashAccess( + parser, parser.tokenIndex); + } parser.tokenIndex = previousIndex; // Re-parse "->" operand = ParseInfix.parseInfixOperation(parser, operand, 0); if (operand == null) { @@ -565,6 +570,41 @@ static Node parseArrayHashAccessInBraces(Parser parser, Node operand, boolean is return operand; } + /** + * Inside a double-quoted string, quotes delimiting an interpolated hash key + * are escaped for the outer string: {@code "$ref->{\"key\"}"}. The string + * lexer preserves those backslashes, but the embedded expression parser must + * see an ordinary quoted key. + */ + private static void preprocessBackslashQuotesInInterpolatedHashAccess( + Parser parser, int openingBraceIndex) { + if (!parser.preprocessBracedBackslashQuotesInInterpolation) { + return; + } + + int scan = openingBraceIndex; + int braceLevel = 0; + while (scan < parser.tokens.size()) { + String text = parser.tokens.get(scan).text; + if ("{".equals(text)) { + braceLevel++; + scan++; + } else if ("}".equals(text)) { + braceLevel--; + if (braceLevel == 0) { + return; + } + scan++; + } else if ("\\".equals(text) + && scan + 1 < parser.tokens.size() + && "\"".equals(parser.tokens.get(scan + 1).text)) { + parser.tokens.remove(scan); + } else { + scan++; + } + } + } + /** * Parses array and hash access operations following a variable. * @@ -640,6 +680,7 @@ static Node parseArrayHashAccess(Parser parser, Node operand, boolean isRegex) { } case "{" -> { // Hash access + preprocessBackslashQuotesInInterpolatedHashAccess(parser, parser.tokenIndex); int savedIndex = parser.tokenIndex; Node result = null; try { @@ -664,6 +705,10 @@ static Node parseArrayHashAccess(Parser parser, Node operand, boolean isRegex) { switch (text) { case "[", "{", "@*", "$*", "%*", "&*", "$#", "@", "%" -> { // Dereference followed by access: $var->[0] or $var->{key} + if (text.equals("{")) { + preprocessBackslashQuotesInInterpolatedHashAccess( + parser, parser.tokenIndex); + } parser.tokenIndex = previousIndex; // Re-parse "->" Node result = ParseInfix.parseInfixOperation(parser, operand, 0); if (result == null) { diff --git a/src/main/java/org/perlonjava/runtime/operators/SystemOperator.java b/src/main/java/org/perlonjava/runtime/operators/SystemOperator.java index 3da32164c..2aadcfa76 100644 --- a/src/main/java/org/perlonjava/runtime/operators/SystemOperator.java +++ b/src/main/java/org/perlonjava/runtime/operators/SystemOperator.java @@ -678,17 +678,15 @@ private static CommandResult executeCommand(String command, boolean captureOutpu // For backticks: stdout will be captured (default behavior), // stderr goes through Perl STDERR handle - // Always redirect stdin from /dev/null to prevent subprocess blocking - // This prevents the subprocess from waiting for input that will never come - try { - processBuilder.redirectInput(ProcessBuilder.Redirect.from(new java.io.File("/dev/null"))); - } catch (Exception e) { - // Fallback for systems where /dev/null might not be available - // This should be rare, but provides robustness - } - process = processBuilder.start(); + // system() and qx// subprocesses are deliberately non-interactive in + // PerlOnJava. Closing the ProcessBuilder pipe is the only portable + // way to guarantee EOF here. Redirect.from("/dev/null") left nested + // jperl launchers waiting forever on macOS (for example an old CPAN + // Makefile.PL which reads configuration answers from STDIN). + closeChildStdin(process); + final Process finalProcess = process; final StringBuilder finalOutput = output; @@ -770,6 +768,7 @@ private static CommandResult executeCommandDirect(List commandArgs) { copyPerlEnvToProcessBuilder(processBuilder); process = processBuilder.start(); + closeChildStdin(process); // Route stdout and stderr through Perl handles so that // Perl-level redirections are honored @@ -824,6 +823,7 @@ private static CommandResult executeCommandDirectCapture(List commandArg // Route stderr through Perl STDERR handle (not INHERIT which bypasses Perl redirections) process = processBuilder.start(); + closeChildStdin(process); final Process finalProcess = process; final StringBuilder finalOutput = output; @@ -917,6 +917,14 @@ private static void closeQuietly(BufferedReader reader) { } } + private static void closeChildStdin(Process process) { + try { + process.getOutputStream().close(); + } catch (IOException ignored) { + // The child may have exited before its stdin was closed. + } + } + /** * Writes bytes to the current Perl-level STDERR handle. * This ensures output goes through any Perl-level redirections (e.g., diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/CompressZlib.java b/src/main/java/org/perlonjava/runtime/perlmodule/CompressZlib.java index c5d40178b..9add47cb7 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/CompressZlib.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/CompressZlib.java @@ -617,7 +617,15 @@ public static RuntimeList inflateMethod(RuntimeArray args, int ctx) { RuntimeScalar outputScalar = new RuntimeScalar(outputStr); outputScalar.type = RuntimeScalarType.BYTE_STRING; result.add(outputScalar); - result.add(new RuntimeScalar(status)); + if (ctx != RuntimeContextType.LIST) { + return result; + } + RuntimeScalar statusScalar = new RuntimeScalar(); + statusScalar.type = RuntimeScalarType.DUALVAR; + statusScalar.value = new DualVar( + new RuntimeScalar(status), + new RuntimeScalar(status == 1 ? "stream end" : "")); + result.add(statusScalar); return result; } diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/MathCephes.java b/src/main/java/org/perlonjava/runtime/perlmodule/MathCephes.java new file mode 100644 index 000000000..5a39aff1b --- /dev/null +++ b/src/main/java/org/perlonjava/runtime/perlmodule/MathCephes.java @@ -0,0 +1,117 @@ +package org.perlonjava.runtime.perlmodule; + +import org.perlonjava.runtime.runtimetypes.RuntimeArray; +import org.perlonjava.runtime.runtimetypes.RuntimeList; +import org.perlonjava.runtime.runtimetypes.RuntimeScalar; + +/** Java implementations of the Cephes distribution functions used by CPAN statistics modules. */ +public final class MathCephes extends PerlModuleBase { + public static final String XS_VERSION = "0.5308"; + + public MathCephes() { + // Math::Cephes.pm aliases its public functions from this SWIG package. + super("Math::Cephesc", false); + } + + public static void initialize() { + MathCephes module = new MathCephes(); + try { + module.registerMethod("ndtr", null); + module.registerMethod("ndtri", null); + module.registerMethod("chdtrc", null); + } catch (NoSuchMethodException e) { + throw new IllegalStateException("Unable to initialize Math::Cephes", e); + } + } + + public static RuntimeList ndtr(RuntimeArray args, int ctx) { + double x = args.get(0).getDouble(); + return scalar(0.5 * regularizedGammaQ(0.5, x * x / 2.0), x < 0.0); + } + + private static RuntimeList scalar(double upperTail, boolean complement) { + return new RuntimeScalar(complement ? upperTail : 1.0 - upperTail).getList(); + } + + public static RuntimeList ndtri(RuntimeArray args, int ctx) { + double p = args.get(0).getDouble(); + if (p <= 0.0) return new RuntimeScalar(Double.NEGATIVE_INFINITY).getList(); + if (p >= 1.0) return new RuntimeScalar(Double.POSITIVE_INFINITY).getList(); + return new RuntimeScalar(inverseNormal(p)).getList(); + } + + public static RuntimeList chdtrc(RuntimeArray args, int ctx) { + double degreesOfFreedom = args.get(0).getDouble(); + double x = args.get(1).getDouble(); + if (degreesOfFreedom <= 0.0 || x < 0.0) return new RuntimeScalar(0.0).getList(); + return new RuntimeScalar(regularizedGammaQ(degreesOfFreedom / 2.0, x / 2.0)).getList(); + } + + private static double regularizedGammaQ(double a, double x) { + if (x == 0.0) return 1.0; + if (x < a + 1.0) { + double sum = 1.0 / a; + double term = sum; + for (int n = 1; n < 10000; n++) { + term *= x / (a + n); + sum += term; + if (Math.abs(term) < Math.abs(sum) * 1.0e-15) break; + } + return 1.0 - sum * Math.exp(-x + a * Math.log(x) - logGamma(a)); + } + + double b = x + 1.0 - a; + double c = 1.0 / 1.0e-300; + double d = 1.0 / b; + double h = d; + for (int i = 1; i < 10000; i++) { + double an = -i * (i - a); + b += 2.0; + d = an * d + b; + if (Math.abs(d) < 1.0e-300) d = 1.0e-300; + c = b + an / c; + if (Math.abs(c) < 1.0e-300) c = 1.0e-300; + d = 1.0 / d; + double delta = d * c; + h *= delta; + if (Math.abs(delta - 1.0) < 1.0e-15) break; + } + return Math.exp(-x + a * Math.log(x) - logGamma(a)) * h; + } + + private static double logGamma(double x) { + double[] coefficients = { + 676.5203681218851, -1259.1392167224028, 771.32342877765313, + -176.61502916214059, 12.507343278686905, -0.13857109526572012, + 9.9843695780195716e-6, 1.5056327351493116e-7 + }; + if (x < 0.5) return Math.log(Math.PI) - Math.log(Math.sin(Math.PI * x)) - logGamma(1.0 - x); + x -= 1.0; + double sum = 0.99999999999980993; + for (int i = 0; i < coefficients.length; i++) sum += coefficients[i] / (x + i + 1.0); + double t = x + coefficients.length - 0.5; + return 0.5 * Math.log(2.0 * Math.PI) + (x + 0.5) * Math.log(t) - t + Math.log(sum); + } + + // Peter J. Acklam's inverse-normal rational approximation. + private static double inverseNormal(double p) { + double[] a = {-39.69683028665376, 220.9460984245205, -275.9285104469687, + 138.3577518672690, -30.66479806614716, 2.506628277459239}; + double[] b = {-54.47609879822406, 161.5858368580409, -155.6989798598866, + 66.80131188771972, -13.28068155288572}; + double[] c = {-0.007784894002430293, -0.3223964580411365, -2.400758277161838, + -2.549732539343734, 4.374664141464968, 2.938163982698783}; + double[] d = {0.007784695709041462, 0.3224671290700398, 2.445134137142996, + 3.754408661907416}; + if (p < 0.02425) { + double q = Math.sqrt(-2.0 * Math.log(p)); + return (((((c[0] * q + c[1]) * q + c[2]) * q + c[3]) * q + c[4]) * q + c[5]) + / ((((d[0] * q + d[1]) * q + d[2]) * q + d[3]) * q + 1.0); + } + if (p > 0.97575) return -inverseNormal(1.0 - p); + double q = p - 0.5; + double r = q * q; + return (((((a[0] * r + a[1]) * r + a[2]) * r + a[3]) * r + a[4]) * r + a[5]) * q + / (((((b[0] * r + b[1]) * r + b[2]) * r + b[3]) * r + b[4]) * r + 1.0); + } +} diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/TextQRCode.java b/src/main/java/org/perlonjava/runtime/perlmodule/TextQRCode.java new file mode 100644 index 000000000..732de2b09 --- /dev/null +++ b/src/main/java/org/perlonjava/runtime/perlmodule/TextQRCode.java @@ -0,0 +1,229 @@ +package org.perlonjava.runtime.perlmodule; + +import com.google.zxing.EncodeHintType; +import com.google.zxing.WriterException; +import com.google.zxing.qrcode.decoder.ErrorCorrectionLevel; +import com.google.zxing.qrcode.encoder.ByteMatrix; +import com.google.zxing.qrcode.encoder.Encoder; +import com.google.zxing.qrcode.encoder.PerlOnJavaByteModeEncoder; +import com.google.zxing.qrcode.encoder.QRCode; +import org.perlonjava.runtime.runtimetypes.PerlCompilerException; +import org.perlonjava.runtime.runtimetypes.RuntimeArray; +import org.perlonjava.runtime.runtimetypes.RuntimeHash; +import org.perlonjava.runtime.runtimetypes.RuntimeList; +import org.perlonjava.runtime.runtimetypes.RuntimeScalar; +import org.perlonjava.runtime.runtimetypes.RuntimeScalarType; + +import java.nio.charset.Charset; +import java.nio.charset.StandardCharsets; +import java.util.EnumMap; +import java.util.Locale; +import java.util.Map; + +/** + * Java replacement for Text::QRCode's libqrencode-backed XS function. + * The Perl wrapper and public API remain the unmodified CPAN implementation. + * ZXing is Apache-2.0 licensed; Text::QRCode is licensed under the same terms + * as Perl itself. + */ +public final class TextQRCode extends PerlModuleBase { + public static final String XS_VERSION = "0.05"; + private static final String MODULE = "Text::QRCode"; + + public TextQRCode() { + super(MODULE, false); + } + + public static void initialize() { + TextQRCode module = new TextQRCode(); + try { + module.registerMethod("_plot", null); + } catch (NoSuchMethodException e) { + throw new IllegalStateException("Unable to initialize " + MODULE, e); + } + } + + public static RuntimeList _plot(RuntimeArray args, int ctx) { + if (args.size() < 2 || args.get(0) == null || !args.get(0).defined().getBoolean()) { + throw new PerlCompilerException("Usage: Text::QRCode::_plot(text, params)"); + } + + String text = args.get(0).toString(); + RuntimeHash params = args.get(1).type == RuntimeScalarType.HASHREFERENCE + ? args.get(1).hashDeref() + : new RuntimeHash(); + + ErrorCorrectionLevel level = errorCorrectionLevel(params); + Map hints = new EnumMap<>(EncodeHintType.class); + + int version = intParam(params, "version", 0); + if (version > 0) { + if (version > 40) { + throw new PerlCompilerException("Failed to encode the input data: XS error"); + } + hints.put(EncodeHintType.QR_VERSION, version); + } + + String mode = stringParam(params, "mode", "8-bit"); + boolean caseSensitive = boolParam(params, "casesensitive", false); + Charset byteCharset = null; + switch (mode) { + case "8-bit" -> byteCharset = containsWideCharacter(text) + ? StandardCharsets.UTF_8 : StandardCharsets.ISO_8859_1; + case "numerical" -> { + if (!text.matches("[0-9]*")) { + throw new PerlCompilerException("Failed to encode the input data: XS error"); + } + } + case "alpha-numerical" -> { + if (!caseSensitive) { + text = text.toUpperCase(Locale.ROOT); + } + } + case "kanji" -> hints.put(EncodeHintType.CHARACTER_SET, "Shift_JIS"); + default -> throw new PerlCompilerException("Invalid mode: XS error"); + } + + try { + ByteMatrix matrix = encodeWithLibqrencodeMaskSelection( + text, level, hints, byteCharset, version); + RuntimeArray rows = new RuntimeArray(); + for (int y = 0; y < matrix.getHeight(); y++) { + RuntimeArray row = new RuntimeArray(); + for (int x = 0; x < matrix.getWidth(); x++) { + RuntimeArray.push(row, new RuntimeScalar(matrix.get(x, y) == 1 ? "*" : " ")); + } + RuntimeArray.push(rows, row.createAnonymousReference()); + } + return rows.createAnonymousReference().getList(); + } catch (WriterException | IllegalArgumentException e) { + throw new PerlCompilerException("Failed to encode the input data: XS error"); + } + } + + /** + * libqrencode and ZXing use slightly different interpretations of the + * finder-like-pattern mask penalty. Text::QRCode exposes the bitmap, so + * choose among ZXing's standards-compliant masks using libqrencode's + * published scoring algorithm to preserve the XS module's output. + */ + private static ByteMatrix encodeWithLibqrencodeMaskSelection( + String text, ErrorCorrectionLevel level, Map baseHints, + Charset byteCharset, int version) + throws WriterException { + ByteMatrix best = null; + int bestPenalty = Integer.MAX_VALUE; + for (int mask = 0; mask < 8; mask++) { + Map hints = new EnumMap<>(baseHints); + hints.put(EncodeHintType.QR_MASK_PATTERN, mask); + QRCode code = byteCharset == null + ? Encoder.encode(text, level, hints) + : PerlOnJavaByteModeEncoder.encode(text, byteCharset, level, version, mask); + ByteMatrix matrix = code.getMatrix(); + int penalty = libqrencodePenalty(matrix); + if (penalty < bestPenalty) { + bestPenalty = penalty; + best = matrix; + } + } + return best; + } + + private static int libqrencodePenalty(ByteMatrix matrix) { + int width = matrix.getWidth(); + int black = 0; + int penalty = 0; + for (int y = 0; y < width; y++) { + for (int x = 0; x < width; x++) { + if (matrix.get(x, y) == 1) black++; + if (x > 0 && y > 0) { + int value = matrix.get(x, y); + if (value == matrix.get(x - 1, y) + && value == matrix.get(x, y - 1) + && value == matrix.get(x - 1, y - 1)) { + penalty += 3; + } + } + } + penalty += libqrencodeRunPenalty(matrix, y, true); + } + for (int x = 0; x < width; x++) { + penalty += libqrencodeRunPenalty(matrix, x, false); + } + int blackPercent = (200 * black + width * width) / (width * width) / 2; + return penalty + (Math.abs(blackPercent - 50) / 5) * 10; + } + + private static int libqrencodeRunPenalty(ByteMatrix matrix, int line, boolean horizontal) { + int width = matrix.getWidth(); + int[] runs = new int[width + 1]; + int head; + int first = horizontal ? matrix.get(0, line) : matrix.get(line, 0); + if (first == 1) { + runs[0] = -1; + head = 1; + } else { + head = 0; + } + runs[head] = 1; + int previous = first; + for (int i = 1; i < width; i++) { + int value = horizontal ? matrix.get(i, line) : matrix.get(line, i); + if (value != previous) { + runs[++head] = 1; + previous = value; + } else { + runs[head]++; + } + } + + int count = head + 1; + int penalty = 0; + for (int i = 0; i < count; i++) { + if (runs[i] >= 5) penalty += 3 + runs[i] - 5; + if ((i & 1) != 0 && i >= 3 && i < count - 2 && runs[i] % 3 == 0) { + int unit = runs[i] / 3; + if (runs[i - 2] == unit && runs[i - 1] == unit + && runs[i + 1] == unit && runs[i + 2] == unit + && (i == 3 || runs[i - 3] >= 4 * unit + || i + 4 >= count || runs[i + 3] >= 4 * unit)) { + penalty += 40; + } + } + } + return penalty; + } + + private static ErrorCorrectionLevel errorCorrectionLevel(RuntimeHash params) { + String level = stringParam(params, "level", "L"); + if (level.isEmpty()) return ErrorCorrectionLevel.L; + return switch (Character.toUpperCase(level.charAt(0))) { + case 'M' -> ErrorCorrectionLevel.M; + case 'Q' -> ErrorCorrectionLevel.Q; + case 'H' -> ErrorCorrectionLevel.H; + default -> ErrorCorrectionLevel.L; + }; + } + + private static String stringParam(RuntimeHash params, String key, String fallback) { + if (!params.exists(key).getBoolean()) return fallback; + RuntimeScalar value = params.get(key); + return value != null && value.defined().getBoolean() ? value.toString() : fallback; + } + + private static int intParam(RuntimeHash params, String key, int fallback) { + if (!params.exists(key).getBoolean()) return fallback; + RuntimeScalar value = params.get(key); + return value != null && value.defined().getBoolean() ? value.getInt() : fallback; + } + + private static boolean boolParam(RuntimeHash params, String key, boolean fallback) { + if (!params.exists(key).getBoolean()) return fallback; + RuntimeScalar value = params.get(key); + return value != null && value.defined().getBoolean() ? value.getBoolean() : fallback; + } + + private static boolean containsWideCharacter(String text) { + return text.codePoints().anyMatch(codePoint -> codePoint > 0xff); + } +} diff --git a/src/main/perl/lib/ExtUtils/MakeMaker.pm b/src/main/perl/lib/ExtUtils/MakeMaker.pm index 10df6e72a..c886303c0 100644 --- a/src/main/perl/lib/ExtUtils/MakeMaker.pm +++ b/src/main/perl/lib/ExtUtils/MakeMaker.pm @@ -1347,7 +1347,7 @@ sub _shell_cp { my $autosplit_dir = $autodir; if ($should_autosplit) { $autosplit_dir =~ s/'/'\\''/g; - $autosplit = " && if grep -q '^__END__\$\$' '$dest'; then \$(PERL) -MAutoSplit -e 'autosplit(\$\$ARGV[0], \$\$ARGV[1], 0, 1, 1)' '$dest' '$autosplit_dir'; fi"; + $autosplit = " && if grep -Eq '^__END__;?[[:space:]]*\$\$' '$dest'; then \$(PERL) -MAutoSplit -e 'autosplit(\$\$ARGV[0], \$\$ARGV[1], 0, 1, 1)' '$dest' '$autosplit_dir'; fi"; } return "\t\@if [ -f '$src' ]; then rm -f '$dest' && cp '$src' '$dest'$autosplit; else echo 'PerlOnJava: skipping missing source: $src'; fi"; } @@ -1391,7 +1391,7 @@ sub _shell_fixin { for ($file, $payload, $payload_name) { s/'/'\\''/g; } - return "\t\@\$(PERL) -e 'my (\$\$f,\$\$payload,\$\$payload_name,\$\$perl)=\@ARGV; open my \$\$in,q{<},\$\$f or exit 0; my \@lines=<\$\$in>; close \$\$in; exit 0 unless \@lines && \$\$lines[0] =~ /^#!.*\\bperl(?:\\s+(.*))?\\r?\\n?\\z/; my \$\$args=defined \$\$1 ? q{ }.\$\$1 : q{}; open my \$\$payload_fh,q{>},\$\$payload or die \$\$!; print \$\$payload_fh \@lines; close \$\$payload_fh or die \$\$!; chmod 0644,\$\$payload; my \$\$d=chr 36; my \$\$at=chr 64; open my \$\$out,q{>},\$\$f or die \$\$!; print \$\$out qq{#!/bin/sh\\n}; print \$\$out q{dir=}.\$\$d.q{(dirname \"}.\$\$d.q{0\")}.qq{\\n}; print \$\$out q{exec \"}.\$\$perl.q{\"}.\$\$args.q{ \"}.\$\$d.q{dir/}.\$\$payload_name.q{\" \"}.\$\$d.\$\$at.q{\"}.qq{\\n}; close \$\$out or die \$\$!; chmod 0755,\$\$f;' '$file' '$payload' '$payload_name' '\$(PERL)'"; + return "\t\@\$(PERL) -e 'my (\$\$f,\$\$payload,\$\$payload_name,\$\$perl)=\@ARGV; open my \$\$in,q{<},\$\$f or exit 0; my \@lines=<\$\$in>; close \$\$in; exit 0 unless \@lines && \$\$lines[0] =~ /^#!.*\\bperl(?:\\s+(.*))?\\r?\\n?\\z/; my \$\$args=defined \$\$1 ? q{ }.\$\$1 : q{}; open my \$\$payload_fh,q{>},\$\$payload or die \$\$!; print \$\$payload_fh \@lines; close \$\$payload_fh or die \$\$!; chmod 0644,\$\$payload; my \$\$d=chr 36; my \$\$at=chr 64; chmod 0644,\$\$f or die \$\$!; open my \$\$out,q{>},\$\$f or die \$\$!; print \$\$out qq{#!/bin/sh\\n}; print \$\$out q{dir=}.\$\$d.q{(dirname \"}.\$\$d.q{0\")}.qq{\\n}; print \$\$out q{exec \"}.\$\$perl.q{\"}.\$\$args.q{ \"}.\$\$d.q{dir/}.\$\$payload_name.q{\" \"}.\$\$d.\$\$at.q{\"}.qq{\\n}; close \$\$out or die \$\$!; chmod 0755,\$\$f;' '$file' '$payload' '$payload_name' '\$(PERL)'"; } # Helper: generate postamble for File::ShareDir::Install diff --git a/src/test/resources/unit/io_compress_regressions.t b/src/test/resources/unit/io_compress_regressions.t index 5f8d0a2bf..ab9b130a9 100644 --- a/src/test/resources/unit/io_compress_regressions.t +++ b/src/test/resources/unit/io_compress_regressions.t @@ -2,7 +2,7 @@ use strict; use warnings; -use Test::More tests => 31; +use Test::More tests => 33; use File::Spec; { @@ -198,6 +198,16 @@ sub _io_compress_eval_proto_regression ($) { 1 } my $deflater = Compress::Zlib::deflateInit(); ok(defined $deflater && !defined $deflater->msg, 'Compress::Zlib stream objects provide msg method'); +my $compressed = Compress::Zlib::compress('stream payload'); +my $compressed_for_list = $compressed; +my $scalar_inflater = Compress::Zlib::inflateInit(); +is($scalar_inflater->inflate($compressed), 'stream payload', + 'Compress::Zlib inflate returns data in scalar context'); +my $list_inflater = Compress::Zlib::inflateInit(); +my ($inflated, $inflate_status) = $list_inflater->inflate($compressed_for_list); +is("$inflated:$inflate_status:" . (0 + $inflate_status), 'stream payload:stream end:1', + 'Compress::Zlib inflate returns data and dual-valued status in list context'); + SKIP: { require Compress::Raw::Zlib; my ($scanner, $scan_status) = eval { Compress::Raw::Zlib::_inflateScanInit() }; diff --git a/src/test/resources/unit/makemaker_autosplit_autoloader_only.t b/src/test/resources/unit/makemaker_autosplit_autoloader_only.t index 18be88118..bcdf63fa9 100644 --- a/src/test/resources/unit/makemaker_autosplit_autoloader_only.t +++ b/src/test/resources/unit/makemaker_autosplit_autoloader_only.t @@ -17,9 +17,13 @@ print {$pod_pm} "package Local::PodOnly;\n1;\n__END__\n=head1 NAME\n\nLocal::Pod close $pod_pm or die "close POD-only module: $!"; open my $loader_pm, '>', 'lib/Local/Loader.pm' or die "create AutoLoader module: $!"; -print {$loader_pm} "package Local::Loader;\nuse AutoLoader;\n1;\n__END__\nsub deferred { 42 }\n"; +print {$loader_pm} "package Local::Loader;\nuse AutoLoader;\n1;\n__END__;\nsub deferred { 42 }\n"; close $loader_pm or die "close AutoLoader module: $!"; +open my $makefile_pl, '>', 'Makefile.PL' or die "create Makefile.PL: $!"; +print {$makefile_pl} "# generated by the unit test\n"; +close $makefile_pl or die "close Makefile.PL: $!"; + use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Local::AutosplitSelection', VERSION => '0.001', @@ -37,6 +41,11 @@ unlike($makefile, qr/autosplit\([^\n]+Local\/PodOnly\.pm/, 'POD-only __END__ markers do not trigger AutoSplit'); ok($makefile =~ qr/autosplit\([^\n]+Local\/Loader\.pm/ || $makefile =~ qr/pm_to_blib\(\{\@ARGV\}/, - 'modules using AutoLoader remain covered by the staging rule'); + 'modules using AutoLoader with __END__; remain covered by the staging rule'); + +my $status = system($ENV{MAKE} || 'make', 'pm_to_blib'); +is($status, 0, 'AutoLoader module stages successfully'); +ok(-f 'blib/lib/auto/Local/Loader/autosplit.ix', + 'AutoSplit accepts the __END__; marker'); done_testing(); diff --git a/src/test/resources/unit/makemaker_exe_files.t b/src/test/resources/unit/makemaker_exe_files.t index 6c22a50a8..8e9e2f2b8 100644 --- a/src/test/resources/unit/makemaker_exe_files.t +++ b/src/test/resources/unit/makemaker_exe_files.t @@ -35,7 +35,7 @@ else { or die "create script/demo: $!"; print {$script} "#!perl -w\nprint qq(ok\\n);\n"; close $script or die "close script/demo: $!"; - chmod 0755, 'script/demo' or die "chmod script/demo: $!"; + chmod 0555, 'script/demo' or die "chmod read-only script/demo: $!"; open my $makefile_pl, '>', 'Makefile.PL' or die "create Makefile.PL: $!"; @@ -52,7 +52,7 @@ else { my $make = $Config::Config{make} || 'make'; my $status = system($make, 'pure_all'); - is($status, 0, 'pure_all target succeeds'); + is($status, 0, 'pure_all target succeeds for a read-only source script'); my @staged_candidates = ( 'blib/script/demo', diff --git a/src/test/resources/unit/math_cephes_java_xs.t b/src/test/resources/unit/math_cephes_java_xs.t new file mode 100644 index 000000000..d018c8331 --- /dev/null +++ b/src/test/resources/unit/math_cephes_java_xs.t @@ -0,0 +1,14 @@ +use strict; +use warnings; +use Test::More; + +plan skip_all => 'PerlOnJava Java XS bridge test' unless $^X =~ /jperl/; +plan tests => 4; + +require XSLoader; +XSLoader::load('Math::Cephes', '0.5308'); + +ok(abs(Math::Cephesc::ndtr(0) - 0.5) < 1e-12, 'normal CDF at zero'); +ok(abs(Math::Cephesc::ndtr(1.96) - 0.9750021049) < 1e-8, 'normal CDF'); +ok(abs(Math::Cephesc::ndtri(0.975) - 1.9599639845) < 1e-8, 'inverse normal CDF'); +ok(abs(Math::Cephesc::chdtrc(1, 7.0756) - 0.007813) < 1e-4, 'chi-square upper tail'); diff --git a/src/test/resources/unit/string_interpolation_escaped_hash_key.t b/src/test/resources/unit/string_interpolation_escaped_hash_key.t new file mode 100644 index 000000000..1245a9a90 --- /dev/null +++ b/src/test/resources/unit/string_interpolation_escaped_hash_key.t @@ -0,0 +1,11 @@ +use strict; +use warnings; +use Test::More tests => 2; + +my $set = { set_number => 7 }; +is("target G0.S$set->{\"set_number\"}", 'target G0.S7', + 'escaped quoted key interpolates through a hash reference'); + +my %set = (set_type => 'xy'); +is("type $set{\"set_type\"}", 'type xy', + 'escaped quoted key interpolates through a hash'); diff --git a/src/test/resources/unit/system_child_stdin_eof.t b/src/test/resources/unit/system_child_stdin_eof.t new file mode 100644 index 000000000..93052f792 --- /dev/null +++ b/src/test/resources/unit/system_child_stdin_eof.t @@ -0,0 +1,12 @@ +use strict; +use warnings; +use File::Temp qw(tempfile); +use Test::More tests => 1; + +my ($child_fh, $child_name) = tempfile(SUFFIX => '.pl', UNLINK => 1); +print {$child_fh} 'exit defined() ? 42 : 0;' . "\n"; +close $child_fh; + +my $status = system(qq{"$^X" "$child_name"}); + +is($status, 0, 'string-form system child observes EOF on noninteractive stdin'); diff --git a/src/test/resources/unit/text_qrcode_java_xs.t b/src/test/resources/unit/text_qrcode_java_xs.t new file mode 100644 index 000000000..d7adf64b5 --- /dev/null +++ b/src/test/resources/unit/text_qrcode_java_xs.t @@ -0,0 +1,16 @@ +use strict; +use warnings; +use Test::More; + +plan skip_all => 'PerlOnJava Java XS bridge test' unless $^X =~ /jperl/; +plan tests => 4; + +require XSLoader; +XSLoader::load('Text::QRCode', '0.05'); + +my $matrix = Text::QRCode::_plot('Some text here.', {}); +is(ref($matrix), 'ARRAY', '_plot returns an array reference'); +is(scalar(@$matrix), 21, 'version 1 QR code has 21 rows'); +is(scalar(@{$matrix->[0]}), 21, 'version 1 QR code has 21 columns'); +is(join('', @{$matrix->[0]}), '******* * ** *******', + 'QR matrix matches the libqrencode reference first row'); From fb7d03895f5bdfd6e6e7350338eeb8ca6ebfe7ae Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Sat, 15 Aug 2026 18:01:37 +0200 Subject: [PATCH 2/8] fix: preserve Windows interpreter paths in Makefiles Normalize native Windows separators before writing the Perl executable into POSIX-shell Makefile recipes. This prevents Bash from consuming backslashes as escapes when MakeMaker stages AutoLoader modules. Generated with [Codex](https://openai.com/codex) Co-Authored-By: Codex --- src/main/perl/lib/ExtUtils/MakeMaker.pm | 21 +++++++++++++++++---- 1 file changed, 17 insertions(+), 4 deletions(-) diff --git a/src/main/perl/lib/ExtUtils/MakeMaker.pm b/src/main/perl/lib/ExtUtils/MakeMaker.pm index c886303c0..5a0185bd7 100644 --- a/src/main/perl/lib/ExtUtils/MakeMaker.pm +++ b/src/main/perl/lib/ExtUtils/MakeMaker.pm @@ -1314,20 +1314,33 @@ sub _shell_mkdir { sub _current_perl_path { my $perl = $ENV{PERLONJAVA_EXECUTABLE} || $Config{perlpath} || $^X; - return $perl if File::Spec->file_name_is_absolute($perl); + return _makefile_shell_path($perl) + if File::Spec->file_name_is_absolute($perl); for my $base ($ENV{PWD}, getcwd()) { next unless defined $base && length $base; my $candidate = File::Spec->catfile($base, $perl); - return abs_path($candidate) || $candidate if -x $candidate; + return _makefile_shell_path(abs_path($candidate) || $candidate) + if -x $candidate; } for my $dir (File::Spec->path()) { my $candidate = File::Spec->catfile($dir, $perl); - return abs_path($candidate) || $candidate if -x $candidate; + return _makefile_shell_path(abs_path($candidate) || $candidate) + if -x $candidate; } - return $perl; + return _makefile_shell_path($perl); +} + +# Generated Makefiles deliberately use a POSIX shell, including on the +# Windows CI image. A native path such as D:\a\project\jperl.bat is therefore +# parsed as shell escapes and collapses to D:aprojectjperl.bat. Windows APIs +# accept forward slashes, and the POSIX shell preserves them. +sub _makefile_shell_path { + my ($path) = @_; + $path =~ tr{\\}{/} if $^O eq 'MSWin32'; + return $path; } # Helper: generate a shell cp command for Makefile. From 15816593d589ecd175592fa582d86a068ec1dc10 Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Sat, 15 Aug 2026 20:16:51 +0200 Subject: [PATCH 3/8] fix: use supported Zstd frame sizing API Replace deprecated decompressedSize calls in the imported Sereal decoders with getFrameContentSize. Reject unknown or invalid frame sizes before allocating decoder buffers, and remove the compile-time deprecation warnings. Generated with [Codex](https://openai.com/codex/) Co-Authored-By: Codex --- dev/design/jcpan-compiler-tooling-followup.md | 4 ++++ src/main/java/com/booking/sereal/Decoder.java | 8 +++++++- src/main/java/com/booking/sereal/TokenDecoder.java | 8 +++++++- 3 files changed, 18 insertions(+), 2 deletions(-) diff --git a/dev/design/jcpan-compiler-tooling-followup.md b/dev/design/jcpan-compiler-tooling-followup.md index 9ff51562b..9651a2503 100644 --- a/dev/design/jcpan-compiler-tooling-followup.md +++ b/dev/design/jcpan-compiler-tooling-followup.md @@ -59,6 +59,10 @@ The following are not treated as PerlOnJava regressions because their current di - Opened PR #962 from `fix/jcpan-compiler-tooling-followup`. - GitHub Actions passed on Ubuntu and Windows; the Windows run specifically confirmed the platform-default newline fix in `pipe_jperl_shebang.t`. +- [x] Phase 7: post-merge warning cleanup (2026-08-15) + - Replaced deprecated `Zstd.decompressedSize` calls with + `Zstd.getFrameContentSize` and reject unknown or invalid frame sizes before + allocating decoder buffers. ### Next Steps diff --git a/src/main/java/com/booking/sereal/Decoder.java b/src/main/java/com/booking/sereal/Decoder.java index edca41ed6..939763abb 100644 --- a/src/main/java/com/booking/sereal/Decoder.java +++ b/src/main/java/com/booking/sereal/Decoder.java @@ -334,7 +334,13 @@ private void uncompressZstd() throws SerealException { int len = (int) read_varint(); byte[] compressedData = Arrays.copyOfRange(originalData.array, position, position + len); - long decompressedSize = Zstd.decompressedSize(compressedData); + long decompressedSize = Zstd.getFrameContentSize(compressedData); + if (Zstd.isError(decompressedSize)) { + String message = decompressedSize == -1 + ? "Zstd frame content size is unknown" + : Zstd.getErrorName(decompressedSize); + throw new SerealException(message); + } if (decompressedSize > this.maxSize) { throw new SerealException("The expected uncompressed size is larger than the allowed maximum size"); diff --git a/src/main/java/com/booking/sereal/TokenDecoder.java b/src/main/java/com/booking/sereal/TokenDecoder.java index aef8bd412..95555827c 100644 --- a/src/main/java/com/booking/sereal/TokenDecoder.java +++ b/src/main/java/com/booking/sereal/TokenDecoder.java @@ -336,7 +336,13 @@ private void uncompressZstd() throws SerealException { int len = (int) readVarint(); byte[] compressedData = Arrays.copyOfRange(originalData.array, position, position + len); - long decompressedSize = Zstd.decompressedSize(compressedData); + long decompressedSize = Zstd.getFrameContentSize(compressedData); + if (Zstd.isError(decompressedSize)) { + String message = decompressedSize == -1 + ? "Zstd frame content size is unknown" + : Zstd.getErrorName(decompressedSize); + throw new SerealException(message); + } if (decompressedSize > Integer.MAX_VALUE) { throw new SerealException("Decompressed size exceeds integer MAX_VALUE: " + decompressedSize); } From 916adfeaa0f1aa4935742268260709b326618df1 Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Sat, 15 Aug 2026 21:00:59 +0200 Subject: [PATCH 4/8] fix: unblock jcpan compiler and tooling modules Restore YAML::PP object and scalar-reference serialization, route Object::Pad core syntax through native classes, preserve field context in method signatures, fix gzip EOF status for single-file CPAN distributions, and retry TAP-indented missing prerequisites. This unblocks Pegex::JSON, Music::Factory, App::Chained, and Queue without distribution preferences. Bio-MCPrimers and Catalyst Engine HTTP POE remain excluded because their distributions fail under system Perl. Generated with [Codex](https://openai.com/codex) Co-Authored-By: Codex <158243242+openai-codex@users.noreply.github.com> --- dev/design/jcpan-compiler-tooling-modules.md | 60 +++++++++++++++++++ docs/about/changelog.md | 5 ++ docs/reference/bundled-modules.md | 1 + docs/reference/feature-matrix.md | 3 + jcpan | 2 +- .../frontend/parser/StatementResolver.java | 16 ++++- .../runtime/perlmodule/CompressZlib.java | 1 + .../perlmodule/CompressZlibGzFile.java | 18 ++++-- .../perlonjava/runtime/perlmodule/YAMLPP.java | 5 ++ src/main/perl/lib/CPAN/Distribution.pm | 2 +- src/main/perl/lib/Object/Pad.pm | 48 +++++++++++++++ src/main/perl/lib/YAML/PP.pm | 9 +++ .../unit/compress_zlib_gzerror_eof.t | 18 ++++++ .../unit/cpan_tap_missing_prerequisite.t | 20 +++++++ .../resources/unit/object_pad_native_class.t | 20 +++++++ src/test/resources/unit/yaml_pp_dump_method.t | 13 ++++ 16 files changed, 233 insertions(+), 8 deletions(-) create mode 100644 dev/design/jcpan-compiler-tooling-modules.md create mode 100644 src/main/perl/lib/Object/Pad.pm create mode 100644 src/test/resources/unit/compress_zlib_gzerror_eof.t create mode 100644 src/test/resources/unit/cpan_tap_missing_prerequisite.t create mode 100644 src/test/resources/unit/object_pad_native_class.t create mode 100644 src/test/resources/unit/yaml_pp_dump_method.t diff --git a/dev/design/jcpan-compiler-tooling-modules.md b/dev/design/jcpan-compiler-tooling-modules.md new file mode 100644 index 000000000..93d31205c --- /dev/null +++ b/dev/design/jcpan-compiler-tooling-modules.md @@ -0,0 +1,60 @@ +# jcpan compiler and tooling modules + +## Goal + +Fix reusable compiler and CPAN-tooling blockers exposed by Pegex::JSON, +Music::Factory, Bio::Data::Plasmid::CloningVector, +Catalyst::Engine::HTTP::POE::YieldCC, App::Chained, Queue, and their +dependencies. Prefer shared runtime/tooling fixes and existing Java libraries +over distribution preferences. + +## Progress Tracking + +### Current Status: PR #964 open; CI in progress + +### Completed Phases + +- [x] Phase 1: baseline and system-Perl classification (2026-08-15) + - Captured bounded `jcpan -t` logs for all six requested modules. + - Identified malformed Bio-MCPrimers packaging and Catalyst's omitted + Restarter::Watcher as upstream distribution failures. +- [x] Phase 2: shared root-cause implementation (2026-08-15) + - Restored YAML::PP's standard object `dump` API. + - Serialized scalar references through their referents for boolean.pm parity. + - Made gzip EOF status compatible with CPAN single-file extraction. + - Extended generic missing-prerequisite discovery to TAP diagnostics. + - Routed Object::Pad's core syntax to PerlOnJava's native class compiler. +- [x] Phase 3: cross-runtime regression validation (2026-08-15) + - Validated YAML, gzip, native-class, and CPAN-tooling regressions with + system Perl where applicable. + - Passed the focused regressions on JVM and interpreter backends. +- [x] Phase 4: requested module verification (2026-08-15) + - Pegex::JSON: 4 files, 21 assertions, PASS. + - Music::Factory: 5 files, 20 assertions, PASS. + - App::Chained: 2 files, 9 assertions, PASS after generic dependency retry. + - Queue: single-file distribution built and tested successfully; upstream + ships no test directory. + - Bio::Data::Plasmid::CloningVector excluded because Bio-MCPrimers has no + Makefile.PL and fails system-Perl configuration. + - Catalyst::Engine::HTTP::POE::YieldCC excluded because its distribution + requires but does not ship or declare Restarter::Watcher; system Perl + reproduces the missing-module failure. +- [x] Phase 5: full verification (2026-08-15) + - Full `make` passed all unit shards. +- [ ] Phase 6: pull request and CI + - Opened [PR #964](https://github.com/fglock/PerlOnJava/pull/964). + - CI checks are in progress. + +### Next Steps + +1. Monitor all PR #964 CI checks to completion. +2. Record the final CI result here. + +### Open Questions + +- Object::Pad-specific MOP and extension APIs remain outside the native class + compatibility pragma; the requested Music::Factory surface uses core syntax. + +## References + +- Skills: `debug-perlonjava`, `port-cpan-module` diff --git a/docs/about/changelog.md b/docs/about/changelog.md index 5763d14f2..80c60e527 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -4,6 +4,11 @@ Release history of PerlOnJava. See [Roadmap](roadmap.md) for future plans. ## Work in progress +- CPAN/compiler tooling: restore YAML::PP's object `dump` API, recognize + TAP-indented missing prerequisites, report gzip stream completion for CPAN + single-file distributions, and route Object::Pad's core syntax through the + native class compiler. This unblocks Pegex::JSON, Music::Factory, + App::Chained, and Queue without distribution preferences. - CPAN/compiler tooling: add transitive prerequisites to the bundled-provider manifest, provide a JAXP-backed `XML::LibXSLT`, and preserve descriptors for anonymous handles stored in container lvalues. This unblocks diff --git a/docs/reference/bundled-modules.md b/docs/reference/bundled-modules.md index 3f7369e6d..2c8aeeb81 100644 --- a/docs/reference/bundled-modules.md +++ b/docs/reference/bundled-modules.md @@ -377,6 +377,7 @@ These are loaded automatically or via `use`: | Module | Implementation | Notes | |--------|---------------|-------| +| `Object::Pad` | Perl/compiler | Core `class`, `field`, `method`, `:param`, and `:isa` syntax uses PerlOnJava's native class compiler; Object::Pad MOP extensions are not included | | `Scalar::Util` | Java | | | `Sub::Name` | Java | | | `Sub::Util` | Java | | diff --git a/docs/reference/feature-matrix.md b/docs/reference/feature-matrix.md index 758aa4e3f..59a2727e9 100644 --- a/docs/reference/feature-matrix.md +++ b/docs/reference/feature-matrix.md @@ -769,6 +769,9 @@ The `:encoding()` layer supports all encodings provided by Java's `Charset.forNa - ❌ **Safe** module. ### Non-core modules +- 🟡 **Object::Pad**: core class, field, method, parameter, and inheritance + syntax is handled by PerlOnJava's native class compiler; Object::Pad-specific + MOP extensions are not implemented. - ✅ **JSON::DWIW**: relaxed JSON conversion implemented over the bundled pure-Perl `JSON::PP` backend. - ✅ **Taint::Runtime**: Java XS replacement for runtime taint toggling and diff --git a/jcpan b/jcpan index 52ecb5b5e..473f9bc3f 100755 --- a/jcpan +++ b/jcpan @@ -116,7 +116,7 @@ export JPERL_ORPHAN_EXIT=1 # CPAN build tools may install copies of their own implementation modules into # the user library. Keep PerlOnJava's narrow compatibility overlays ahead of # those copies while jcpan and its child build processes run. -export PERLONJAVA_PREFER_BUNDLED_MODULES="Module/Build/Base.pm${PERLONJAVA_PREFER_BUNDLED_MODULES:+,$PERLONJAVA_PREFER_BUNDLED_MODULES}" +export PERLONJAVA_PREFER_BUNDLED_MODULES="Module/Build/Base.pm,Object/Pad.pm${PERLONJAVA_PREFER_BUNDLED_MODULES:+,$PERLONJAVA_PREFER_BUNDLED_MODULES}" # CPAN test suites should run with deterministic semantics. User-interface # color preferences such as NO_COLOR can change module behavior under test diff --git a/src/main/java/org/perlonjava/frontend/parser/StatementResolver.java b/src/main/java/org/perlonjava/frontend/parser/StatementResolver.java index 2ac8de7b1..5b15d18b6 100644 --- a/src/main/java/org/perlonjava/frontend/parser/StatementResolver.java +++ b/src/main/java/org/perlonjava/frontend/parser/StatementResolver.java @@ -233,7 +233,13 @@ public static Node parseStatement(Parser parser, String label) { if (peek(parser).text.equals("(")) { // Parse the signature properly to generate parameter declarations // Pass true for isMethod flag to account for implicit $self in error messages - signatureAST = SignatureParser.parseSignature(parser, methodName, true); + boolean wasInMethod = parser.isInMethod; + parser.isInMethod = true; + try { + signatureAST = SignatureParser.parseSignature(parser, methodName, true); + } finally { + parser.isInMethod = wasInMethod; + } // Note: SignatureParser consumes the closing ) } @@ -617,7 +623,13 @@ && nextNonWhitespaceTokenIs(parser, parser.tokenIndex + 1, "sub")) { ListNode signatureAST = null; if (peek(parser).text.equals("(")) { // Pass true for isMethod flag to account for implicit $self in error messages - signatureAST = SignatureParser.parseSignature(parser, methodName, true); + boolean wasInMethod = parser.isInMethod; + parser.isInMethod = true; + try { + signatureAST = SignatureParser.parseSignature(parser, methodName, true); + } finally { + parser.isInMethod = wasInMethod; + } } try { diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/CompressZlib.java b/src/main/java/org/perlonjava/runtime/perlmodule/CompressZlib.java index c5d40178b..ce62e6ebf 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/CompressZlib.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/CompressZlib.java @@ -832,6 +832,7 @@ public static RuntimeList gzopen(RuntimeArray args, int ctx) { self.put("_mode", new RuntimeScalar(mode)); self.put("_eof", new RuntimeScalar(0)); self.put("_pos", new RuntimeScalar(0)); + self.put("_error", new RuntimeScalar(0)); GlobalVariable.getGlobalVariable("Compress::Zlib::gzerrno").set(new RuntimeScalar(0)); if (mode.startsWith("r")) { diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/CompressZlibGzFile.java b/src/main/java/org/perlonjava/runtime/perlmodule/CompressZlibGzFile.java index 6cfc05e12..0a07febc8 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/CompressZlibGzFile.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/CompressZlibGzFile.java @@ -22,6 +22,7 @@ public class CompressZlibGzFile extends PerlModuleBase { private static final String EOF_KEY = "_eof"; private static final String PUSHBACK_KEY = "_pushback"; private static final String POS_KEY = "_pos"; + private static final String ERROR_KEY = "_error"; public CompressZlibGzFile() { super("Compress::Zlib::gzFile", false); @@ -71,6 +72,7 @@ public static RuntimeList gzread(RuntimeArray args, int ctx) { int n = is.read(buf, totalRead, nbytes - totalRead); if (n == -1) { self.put(EOF_KEY, new RuntimeScalar(1)); + self.put(ERROR_KEY, new RuntimeScalar(1)); // Z_STREAM_END break; } totalRead += n; @@ -91,12 +93,14 @@ public static RuntimeList gzread(RuntimeArray args, int ctx) { int next = pushback.read(); if (next == -1) { self.put(EOF_KEY, new RuntimeScalar(1)); + self.put(ERROR_KEY, new RuntimeScalar(1)); // Z_STREAM_END } else { pushback.unread(next); } } return new RuntimeScalar(totalRead).getList(); } catch (IOException e) { + self.put(ERROR_KEY, new RuntimeScalar(-1)); // Z_ERRNO return new RuntimeScalar(-1).getList(); } } @@ -167,6 +171,7 @@ public static RuntimeList gzreadline(RuntimeArray args, int ctx) { if (line.isEmpty()) { self.put(EOF_KEY, new RuntimeScalar(1)); + self.put(ERROR_KEY, new RuntimeScalar(1)); // Z_STREAM_END args.get(1).set(""); return new RuntimeScalar(0).getList(); } @@ -177,16 +182,19 @@ public static RuntimeList gzreadline(RuntimeArray args, int ctx) { addPosition(self, result.length()); if (c == -1) { self.put(EOF_KEY, new RuntimeScalar(1)); + self.put(ERROR_KEY, new RuntimeScalar(1)); // Z_STREAM_END } else if (c == '\n' && is instanceof PushbackInputStream pushback) { int next = pushback.read(); if (next == -1) { self.put(EOF_KEY, new RuntimeScalar(1)); + self.put(ERROR_KEY, new RuntimeScalar(1)); // Z_STREAM_END } else { pushback.unread(next); } } return new RuntimeScalar(result.length()).getList(); } catch (IOException e) { + self.put(ERROR_KEY, new RuntimeScalar(-1)); // Z_ERRNO return new RuntimeScalar(-1).getList(); } } @@ -356,14 +364,16 @@ public static RuntimeList gzclose(RuntimeArray args, int ctx) { * In list context, returns (message, errno). */ public static RuntimeList gzerror(RuntimeArray args, int ctx) { - // No error tracking in this implementation — always return success + RuntimeHash self = args.get(0).hashDeref(); + RuntimeScalar error = self.get(ERROR_KEY); + int status = error != null ? error.getInt() : 0; if (ctx == org.perlonjava.runtime.runtimetypes.RuntimeContextType.LIST) { RuntimeList result = new RuntimeList(); - result.add(new RuntimeScalar("")); - result.add(new RuntimeScalar(0)); // Z_OK + result.add(new RuntimeScalar(status == -1 ? "I/O error" : "")); + result.add(new RuntimeScalar(status)); return result; } - return new RuntimeScalar(0).getList(); + return new RuntimeScalar(status).getList(); } private static void addPosition(RuntimeHash self, long amount) { diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/YAMLPP.java b/src/main/java/org/perlonjava/runtime/perlmodule/YAMLPP.java index 1fc07fcee..407a94d29 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/YAMLPP.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/YAMLPP.java @@ -404,6 +404,11 @@ private static Object convertRuntimeScalarToYaml(RuntimeScalar scalar, IdentityH case DOUBLE -> scalar.getDouble(); case INTEGER -> scalar.getLong(); case BOOLEAN -> scalar.getBoolean(); + // YAML::PP's Perl schema serializes scalar references (including + // boolean.pm's blessed scalar references) by their referent. A + // null result here incorrectly turned true and false into YAML + // nulls in consumers such as Pegex::JSON. + case REFERENCE -> convertRuntimeScalarToYaml(scalar.scalarDeref(), seen); case READONLY_SCALAR -> convertRuntimeScalarToYaml((RuntimeScalar) scalar.value, seen); default -> null; }; diff --git a/src/main/perl/lib/CPAN/Distribution.pm b/src/main/perl/lib/CPAN/Distribution.pm index 5295a4a7c..9795c2d51 100644 --- a/src/main/perl/lib/CPAN/Distribution.pm +++ b/src/main/perl/lib/CPAN/Distribution.pm @@ -790,7 +790,7 @@ sub _perlonjava_missing_modules_from_test_output { my %seen; my @modules; - while ($output =~ /(?:\A|\n)Can't locate ([A-Za-z_][A-Za-z0-9_]*(?:\/[A-Za-z_][A-Za-z0-9_]*)*\.pm) in \@INC\b/g) { + while ($output =~ /(?:\A|\n)[^\n]*?Can't locate ([A-Za-z_][A-Za-z0-9_]*(?:\/[A-Za-z_][A-Za-z0-9_]*)*\.pm) in \@INC\b/g) { my $module = $1; $module =~ s{/}{::}g; $module =~ s{\.pm\z}{}; diff --git a/src/main/perl/lib/Object/Pad.pm b/src/main/perl/lib/Object/Pad.pm new file mode 100644 index 000000000..29f73bbe9 --- /dev/null +++ b/src/main/perl/lib/Object/Pad.pm @@ -0,0 +1,48 @@ +package Object::Pad; + +use strict; +use warnings; +use feature (); + +our $VERSION = '0.66'; + +# PerlOnJava compiles the class, field, and method syntax natively. Object::Pad +# normally installs those keywords through XS; its compatibility layer only +# needs to enable the equivalent lexical compiler feature here. This covers +# the core syntax shared with Perl's class feature, including :param fields, +# method signatures, and :isa inheritance. +sub import { + feature->import('class'); + warnings->unimport('experimental::class'); + return; +} + +sub unimport { + feature->unimport('class'); + return; +} + +1; + +__END__ + +=head1 NAME + +Object::Pad - PerlOnJava compatibility pragma for native class syntax + +=head1 DESCRIPTION + +PerlOnJava implements the class syntax used by Object::Pad directly in its +compiler. This pragma enables that lexical syntax without loading the module's +XS keyword parser. Object::Pad-specific MOP and extension APIs are not provided. + +=head1 AUTHOR + +Object::Pad was written by Paul Evans . + +=head1 COPYRIGHT AND LICENSE + +Copyright 2026 Paul Evans. This compatibility pragma is free software; it may +be redistributed and/or modified under the same terms as Perl itself. + +=cut diff --git a/src/main/perl/lib/YAML/PP.pm b/src/main/perl/lib/YAML/PP.pm index 4bc09f9df..ceefcc30a 100644 --- a/src/main/perl/lib/YAML/PP.pm +++ b/src/main/perl/lib/YAML/PP.pm @@ -48,6 +48,15 @@ sub Dump { ($YPP ||= __PACKAGE__->new)->dump_string(@_); } +# YAML::PP's object API exposes both dump() and dump_string(). The Java +# backend implements the string-producing operation directly; keep the +# standard convenience method in Perl so callers do not need to know which +# backend supplies the dumper. +sub dump { + my ($self, @data) = @_; + return $self->dump_string(@data); +} + sub LoadFile { my ($file) = @_; my $ypp = ($YPP ||= __PACKAGE__->new); diff --git a/src/test/resources/unit/compress_zlib_gzerror_eof.t b/src/test/resources/unit/compress_zlib_gzerror_eof.t new file mode 100644 index 000000000..5955e48a5 --- /dev/null +++ b/src/test/resources/unit/compress_zlib_gzerror_eof.t @@ -0,0 +1,18 @@ +use strict; +use warnings; +use Test::More tests => 5; +use File::Temp qw(tempfile); +use Compress::Zlib; + +my ($fh, $file) = tempfile(SUFFIX => '.gz'); +close $fh; + +my $writer = gzopen($file, 'wb'); +ok($writer, 'opened gzip writer'); +is($writer->gzwrite('payload'), 7, 'wrote payload'); +is($writer->gzclose, Z_OK, 'closed gzip writer'); + +my $reader = gzopen($file, 'rb'); +my $buffer = ''; +is($reader->gzread($buffer, 4096), 7, 'read through end of gzip stream'); +is(0 + $reader->gzerror, Z_STREAM_END, 'gzerror reports successful stream end'); diff --git a/src/test/resources/unit/cpan_tap_missing_prerequisite.t b/src/test/resources/unit/cpan_tap_missing_prerequisite.t new file mode 100644 index 000000000..6e85e898f --- /dev/null +++ b/src/test/resources/unit/cpan_tap_missing_prerequisite.t @@ -0,0 +1,20 @@ +use strict; +use warnings; +use Test::More; +use CPAN::Distribution; + +plan skip_all => 'PerlOnJava CPAN prerequisite helper unavailable' + unless CPAN::Distribution->can('_perlonjava_missing_modules_from_test_output'); + +my $output = <<'OUTPUT'; +# Failed test 'use Example;' +# Error: Can't locate List/MoreUtils.pm in @INC (you may need to install the List::MoreUtils module) +OUTPUT + +is_deeply( + [ CPAN::Distribution::_perlonjava_missing_modules_from_test_output($output) ], + ['List::MoreUtils'], + 'TAP-indented missing-module diagnostics are promoted to prerequisites', +); + +done_testing; diff --git a/src/test/resources/unit/object_pad_native_class.t b/src/test/resources/unit/object_pad_native_class.t new file mode 100644 index 000000000..e8e4a8936 --- /dev/null +++ b/src/test/resources/unit/object_pad_native_class.t @@ -0,0 +1,20 @@ +use strict; +use warnings; +use Test::More tests => 4; +use Object::Pad 0.66; + +class ObjectPadNativeBase { + field $value :param; + method value { $value } +} + +class ObjectPadNativeChild :isa(ObjectPadNativeBase) { + field $extra :param = 2; + method total ($base = $extra) { $self->value + $base } +} + +my $object = ObjectPadNativeChild->new(value => 40); +isa_ok($object, 'ObjectPadNativeChild'); +is($object->value, 40, 'Object::Pad syntax exposes inherited field method'); +is($object->total, 42, 'Object::Pad syntax supports parameters and inheritance'); +is($object->total(3), 43, 'method signature default can read a class field'); diff --git a/src/test/resources/unit/yaml_pp_dump_method.t b/src/test/resources/unit/yaml_pp_dump_method.t new file mode 100644 index 000000000..fd31bc99c --- /dev/null +++ b/src/test/resources/unit/yaml_pp_dump_method.t @@ -0,0 +1,13 @@ +use strict; +use warnings; +use Test::More tests => 3; +use YAML::PP; + +my $yaml = YAML::PP->new(header => 0)->dump({ answer => 42 }); +like($yaml, qr/^answer:\s+42\s*$/m, 'object dump method emits YAML'); +ok(YAML::PP->new->can('dump'), 'object dump method is discoverable'); + +my $true = 1; +my $yaml_ref = YAML::PP->new(header => 0, schema => [qw(Core Perl)]) + ->dump(bless \$true, 'Local::Boolean'); +like($yaml_ref, qr/1/, 'blessed scalar reference serializes its referent'); From 1adb75d98193b583590bef15e2a2e3e2c62c1c04 Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Sat, 15 Aug 2026 21:21:01 +0200 Subject: [PATCH 5/8] docs: record jcpan tooling CI completion Mark the implementation phase complete after Ubuntu and Windows CI passed on PR #964. Generated with [Codex](https://openai.com/codex) Co-Authored-By: Codex <158243242+openai-codex@users.noreply.github.com> --- dev/design/jcpan-compiler-tooling-modules.md | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/dev/design/jcpan-compiler-tooling-modules.md b/dev/design/jcpan-compiler-tooling-modules.md index 93d31205c..e0993deaa 100644 --- a/dev/design/jcpan-compiler-tooling-modules.md +++ b/dev/design/jcpan-compiler-tooling-modules.md @@ -10,7 +10,7 @@ over distribution preferences. ## Progress Tracking -### Current Status: PR #964 open; CI in progress +### Current Status: complete; PR #964 open with CI passing ### Completed Phases @@ -41,14 +41,14 @@ over distribution preferences. reproduces the missing-module failure. - [x] Phase 5: full verification (2026-08-15) - Full `make` passed all unit shards. -- [ ] Phase 6: pull request and CI +- [x] Phase 6: pull request and CI (2026-08-15) - Opened [PR #964](https://github.com/fglock/PerlOnJava/pull/964). - - CI checks are in progress. + - Ubuntu CI passed in 11m20s. + - Windows CI passed in 18m10s. ### Next Steps -1. Monitor all PR #964 CI checks to completion. -2. Record the final CI result here. +1. Await review of PR #964. ### Open Questions From b48f504d809fabbc10b35319c06714ea280adb7d Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Sat, 15 Aug 2026 21:45:27 +0200 Subject: [PATCH 6/8] fix: preserve PVLV filehandle semantics Resolve file tests through the IO slot carried by a glob instead of its stringified name, and retain PVLV glob names in unopened-close warnings. Generated with [Codex](https://openai.com/codex/) Co-Authored-By: Codex --- dev/design/jcpan-compiler-tooling-followup.md | 20 +++++-- .../runtime/operators/FileTestOperator.java | 54 ++++++++----------- .../runtime/operators/IOOperator.java | 21 ++++++++ src/test/resources/unit/pvlv_filehandle.t | 32 +++++++++++ 4 files changed, 92 insertions(+), 35 deletions(-) create mode 100644 src/test/resources/unit/pvlv_filehandle.t diff --git a/dev/design/jcpan-compiler-tooling-followup.md b/dev/design/jcpan-compiler-tooling-followup.md index 9651a2503..1f1eb4096 100644 --- a/dev/design/jcpan-compiler-tooling-followup.md +++ b/dev/design/jcpan-compiler-tooling-followup.md @@ -37,7 +37,7 @@ The following are not treated as PerlOnJava regressions because their current di ## Progress Tracking -### Current Status: implementation complete; PR ready for review +### Current Status: implementation complete; PR #963 validation in progress ### Completed Phases @@ -63,11 +63,25 @@ The following are not treated as PerlOnJava regressions because their current di - Replaced deprecated `Zstd.decompressedSize` calls with `Zstd.getFrameContentSize` and reject unknown or invalid frame sizes before allocating decoder buffers. +- [x] Phase 8: core-suite regression audit (2026-08-15) + - Compared the reported core files against isolated current-master and + historical baseline builds instead of treating aggregate TAP counts as + deterministic. + - Fixed PVLV filehandle handling so `-t` follows the glob's IO slot without + stringification and `close` warnings retain ASCII and Unicode glob names. + - Restored `op/gv.t` from 253/304 to 255/304 and `uni/gv.t` from 176/206 to + 178/206. `re/pat_advanced.t`, `re/pat_advanced_thr.t`, and + `test_pl/examples.t` reproduce their higher reported counts. The remaining + `japh/abigail.t` 109/130 result matches both current master and the + documented historical baseline, so it is not a PR #963 regression. + - Added a four-case system-Perl oracle and verified it with both PerlOnJava + backends; the full `make` suite passes. ### Next Steps -1. Review PR #962. -2. Merge after approval. +1. Push the regression repair to PR #963. +2. Wait for Ubuntu and Windows CI before handing the unified PR back for user + testing. ### Open Questions diff --git a/src/main/java/org/perlonjava/runtime/operators/FileTestOperator.java b/src/main/java/org/perlonjava/runtime/operators/FileTestOperator.java index 6dc220f80..ca01efd3a 100644 --- a/src/main/java/org/perlonjava/runtime/operators/FileTestOperator.java +++ b/src/main/java/org/perlonjava/runtime/operators/FileTestOperator.java @@ -26,8 +26,8 @@ * 1. -R, -W, -X, -O (for real uid/gid) are not implemented due to lack of * straightforward Java equivalents. *

- * 2. -t (tty check) is not implemented as it's specific to file handles - * rather than file paths. + * 2. -t (tty check) is implemented for open file handles through their + * native or synthetic descriptor; path operands still return undef. *

* 3. -p, -S, -b, and -c are approximated using file names or paths, as Java * doesn't provide direct equivalents. @@ -349,37 +349,27 @@ public static RuntimeScalar fileTest(String operator, RuntimeScalar fileHandle) return fileTest(operator, new RuntimeScalar(dirPath.toString())); } } - // Special handling for -t on standard streams (STDIN, STDOUT, STDERR) + // -t operates on the handle's IO slot, not on the name of the glob + // which happens to contain it. This matters for PVLVs and detached + // globs such as `$_ = *name; *$_ = *STDOUT{IO}`: stringifying or + // resolving the outer glob loses the real descriptor. if (operator.equals("-t")) { - String globName = null; - if (fileHandle.value instanceof RuntimeGlob rg) { - globName = rg.globName; - } else if (fileHandle.value instanceof RuntimeIO rio) { - globName = rio.globName; - } - if (globName != null) { - int fd = -1; - if (globName.endsWith("::STDIN") || globName.equals("STDIN")) { - fd = 0; - } else if (globName.endsWith("::STDOUT") || globName.equals("STDOUT")) { - fd = 1; - } else if (globName.endsWith("::STDERR") || globName.equals("STDERR")) { - fd = 2; - } - if (fd >= 0) { - try { - boolean isTty = FFMPosix.get().isatty(fd) != 0; - getGlobalVariable("main::!").set(0); - return getScalarBoolean(isTty); - } catch (Exception e) { - // Fall back to System.console() check for fd 0 - if (fd == 0) { - boolean isTty = System.console() != null; - getGlobalVariable("main::!").set(0); - return getScalarBoolean(isTty); - } - } - } + RuntimeScalar descriptor = fh.fileno(); + if (!descriptor.getDefinedBoolean()) { + getGlobalVariable("main::!").set(9); + updateLastStat(fileHandle, false, 9); + return scalarUndef; + } + int fd = descriptor.getInt(); + try { + boolean isTty = FFMPosix.get().isatty(fd) != 0; + getGlobalVariable("main::!").set(0); + return getScalarBoolean(isTty); + } catch (Exception e) { + // Preserve a defined false result for an open, non-terminal + // handle when the platform cannot perform isatty(). + getGlobalVariable("main::!").set(0); + return scalarFalse; } } // Fallback for non-file handles (pipes, sockets, etc.) diff --git a/src/main/java/org/perlonjava/runtime/operators/IOOperator.java b/src/main/java/org/perlonjava/runtime/operators/IOOperator.java index e6751329b..2d3ae6241 100644 --- a/src/main/java/org/perlonjava/runtime/operators/IOOperator.java +++ b/src/main/java/org/perlonjava/runtime/operators/IOOperator.java @@ -8,6 +8,7 @@ import org.perlonjava.runtime.nativ.NativeUtils; import org.perlonjava.runtime.nativ.ffm.FFMPosix; import org.perlonjava.runtime.perlmodule.Socket; +import org.perlonjava.runtime.perlmodule.Warnings; import org.perlonjava.runtime.runtimetypes.*; import java.io.File; @@ -922,6 +923,12 @@ public static RuntimeScalar close(int ctx, RuntimeBase... args) { // Handle case where the filehandle is invalid/corrupted if (fh == null) { + if (unopenedWarningsEnabled()) { + String name = filehandleShortName(handle); + String message = "close() on unopened filehandle" + + (name == null || name.isEmpty() ? "" : " " + name); + WarnDie.warn(new RuntimeScalar(message), new RuntimeScalar("")); + } // Return false (undef in boolean context) for invalid filehandle return new RuntimeScalar(); } @@ -933,6 +940,20 @@ public static RuntimeScalar close(int ctx, RuntimeBase... args) { return fh.close(); } + private static boolean unopenedWarningsEnabled() { + return getGlobalVariable("main::" + Character.toString('W' - 'A' + 1)).getBoolean() + || Warnings.warningManager.isWarningEnabled("unopened") + || Warnings.warningManager.isWarningEnabled("all"); + } + + private static String filehandleShortName(RuntimeScalar handle) { + if (!(handle.value instanceof RuntimeGlob glob) || glob.globName == null) { + return null; + } + int separator = glob.globName.lastIndexOf("::"); + return separator >= 0 ? glob.globName.substring(separator + 2) : glob.globName; + } + /** * Prints the elements to the specified file handle according to the format string. * diff --git a/src/test/resources/unit/pvlv_filehandle.t b/src/test/resources/unit/pvlv_filehandle.t new file mode 100644 index 000000000..4053e9ee2 --- /dev/null +++ b/src/test/resources/unit/pvlv_filehandle.t @@ -0,0 +1,32 @@ +use strict; +use warnings; +use Test::More tests => 4; + +$_ = *pvlv_tty; +delete $::{pvlv_tty}; +*$_ = *STDOUT{IO}; +ok defined -t $_, 'file test uses a PVLV glob IO slot without stringifying it'; + +my $warning = ''; +{ + local $SIG{__WARN__} = sub { $warning .= shift }; + $_ = *pvlv_unopened; + close $_; +} +like $warning, qr/close\(\) on unopened filehandle pvlv_unopened/, + 'close warning retains the PVLV glob name'; + +{ + use utf8; + $_ = *pvlv_tty_ò; + delete $::{pvlv_tty_ò}; + *$_ = *STDOUT{IO}; + ok defined -t $_, 'Unicode PVLV file test preserves its IO slot'; + + $warning = ''; + local $SIG{__WARN__} = sub { $warning .= shift }; + $_ = *pvlv_unopened_ò; + close $_; + like $warning, qr/close\(\) on unopened filehandle pvlv_unopened_ò/, + 'close warning retains a Unicode PVLV glob name'; +} From 25b7b5a3e8568b13e5dc4a8e111416f76ab01bad Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Sat, 15 Aug 2026 22:04:18 +0200 Subject: [PATCH 7/8] docs: record PR 963 regression CI Generated with [Codex](https://openai.com/codex/) Co-Authored-By: Codex --- dev/design/jcpan-compiler-tooling-followup.md | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/dev/design/jcpan-compiler-tooling-followup.md b/dev/design/jcpan-compiler-tooling-followup.md index 1f1eb4096..feecbbe47 100644 --- a/dev/design/jcpan-compiler-tooling-followup.md +++ b/dev/design/jcpan-compiler-tooling-followup.md @@ -37,7 +37,7 @@ The following are not treated as PerlOnJava regressions because their current di ## Progress Tracking -### Current Status: implementation complete; PR #963 validation in progress +### Current Status: implementation complete; PR #963 CI green ### Completed Phases @@ -76,12 +76,11 @@ The following are not treated as PerlOnJava regressions because their current di documented historical baseline, so it is not a PR #963 regression. - Added a four-case system-Perl oracle and verified it with both PerlOnJava backends; the full `make` suite passes. + - PR #963 CI passed on Ubuntu and Windows at commit `b48f504d8`. ### Next Steps -1. Push the regression repair to PR #963. -2. Wait for Ubuntu and Windows CI before handing the unified PR back for user - testing. +1. Hand the unified PR #963 back for user testing and review. ### Open Questions From a8bef45f63fa5aedfea95cf1c59bc7d80453bad1 Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Sat, 15 Aug 2026 23:07:39 +0200 Subject: [PATCH 8/8] docs: record unified PR CI completion Record the passing Ubuntu and Windows results for the combined PR #963 and PR #964 review branch. Generated with [Codex](https://openai.com/codex) Co-Authored-By: Codex <158243242+openai-codex@users.noreply.github.com> --- dev/design/jcpan-compiler-tooling-followup.md | 10 ++++------ dev/design/jcpan-compiler-tooling-modules.md | 8 ++++---- 2 files changed, 8 insertions(+), 10 deletions(-) diff --git a/dev/design/jcpan-compiler-tooling-followup.md b/dev/design/jcpan-compiler-tooling-followup.md index 1fa2ccfdd..4e935b0cd 100644 --- a/dev/design/jcpan-compiler-tooling-followup.md +++ b/dev/design/jcpan-compiler-tooling-followup.md @@ -37,7 +37,7 @@ The following are not treated as PerlOnJava regressions because their current di ## Progress Tracking -### Current Status: unified into PR #964; combined CI pending +### Current Status: unified into PR #964; combined CI passing ### Completed Phases @@ -81,14 +81,12 @@ The following are not treated as PerlOnJava regressions because their current di - Merged all five PR #963 commits into PR #964 so the compiler, runtime, CPAN-tooling, and Java-module changes can be tested and approved together. - The combined full `make` suite passed before the unified branch was pushed. - - PR #963 remains available as the source history until unified PR #964 CI - completes. + - Unified PR #964 CI passed on Ubuntu in 14m35s and Windows in 17m27s. ### Next Steps -1. Complete unified PR #964 CI. -2. Mark PR #963 as superseded by PR #964. -3. Hand PR #964 back for user testing and review. +1. Mark PR #963 as superseded by PR #964. +2. Hand PR #964 back for user testing and review. ### Open Questions diff --git a/dev/design/jcpan-compiler-tooling-modules.md b/dev/design/jcpan-compiler-tooling-modules.md index 02ddc075b..e4edfcf64 100644 --- a/dev/design/jcpan-compiler-tooling-modules.md +++ b/dev/design/jcpan-compiler-tooling-modules.md @@ -10,7 +10,7 @@ over distribution preferences. ## Progress Tracking -### Current Status: PR #963 commits unified into PR #964; combined CI pending +### Current Status: PR #963 commits unified into PR #964; combined CI passing ### Completed Phases @@ -49,12 +49,12 @@ over distribution preferences. - Merged all five commits from PR #963 into PR #964 for joint testing and approval. - The combined full `make` suite passed before push. + - Unified PR #964 CI passed on Ubuntu in 14m35s and Windows in 17m27s. ### Next Steps -1. Complete unified PR #964 CI. -2. Mark PR #963 as superseded by PR #964. -3. Await joint testing and review of PR #964. +1. Mark PR #963 as superseded by PR #964. +2. Await joint testing and review of PR #964. ### Open Questions