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/5] 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/5] 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/5] 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 b48f504d809fabbc10b35319c06714ea280adb7d Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Sat, 15 Aug 2026 21:45:27 +0200 Subject: [PATCH 4/5] 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 5/5] 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