diff --git a/docs/about/changelog.md b/docs/about/changelog.md index 4d39562b77..b41e44ea84 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -6,6 +6,10 @@ priorities and future plans. ## Work in progress +- Support `sprintf` field widths up to 1,000,000 characters, including widths + above the former 8192-character limit. +- Preserve bare carriage returns in quote-like strings and regex patterns read + from Perl source files. - Keep version-control conflict-marker diagnostics out of quoted strings and heredoc contents. - Preserve diagnostics for malformed CSV rows, decode EUC-JP row-13 extension diff --git a/src/main/java/org/perlonjava/frontend/lexer/Lexer.java b/src/main/java/org/perlonjava/frontend/lexer/Lexer.java index 87df2274c8..5cdc02429a 100644 --- a/src/main/java/org/perlonjava/frontend/lexer/Lexer.java +++ b/src/main/java/org/perlonjava/frontend/lexer/Lexer.java @@ -124,9 +124,8 @@ public static void main(String[] args) { /** * Helper method to check if a character is ASCII whitespace only. * This excludes Unicode whitespace characters that should be treated as invalid identifier characters. - * Note: \r is included as whitespace. It is consumed by consumeWhitespace() along with - * spaces and tabs, which preserves it in the token text. This is critical for eval'd code - * (e.g., from Template Toolkit) where \r inside string literals must be preserved. + * Bare carriage returns are handled as line terminators by nextToken() so quote-like + * parsers can preserve them in string and regex contents. */ private static boolean isAsciiWhitespace(char c) { return c == ' ' || c == '\t' || c == '\n' || c == '\r' || c == '\f'; @@ -202,9 +201,9 @@ public LexerToken nextToken() { } if (isAsciiWhitespace(current)) { - if (current == '\n') { + if (current == '\n' || current == '\r') { position++; - return new LexerToken(LexerTokenType.NEWLINE, "\n"); + return new LexerToken(LexerTokenType.NEWLINE, String.valueOf(current)); } else { return consumeWhitespace(); } diff --git a/src/main/java/org/perlonjava/runtime/operators/SprintfOperator.java b/src/main/java/org/perlonjava/runtime/operators/SprintfOperator.java index 1e4107cbc7..b33efdc869 100644 --- a/src/main/java/org/perlonjava/runtime/operators/SprintfOperator.java +++ b/src/main/java/org/perlonjava/runtime/operators/SprintfOperator.java @@ -20,8 +20,11 @@ */ public class SprintfOperator { - // Maximum practical limit for width/precision to prevent memory issues - public static final int MAX_PRACTICAL_FORMAT_SIZE = 8192; + // Avoid allocating impractically large formatted fields while supporting + // ordinary wide values such as table columns produced by Text::Diff. + public static final int MAX_PRACTICAL_FORMAT_WIDTH = 1_000_000; + // Maximum practical precision to prevent unexpectedly large numeric output + public static final int MAX_PRACTICAL_PRECISION = 8192; /** * Formats the elements according to the specified format string. *
@@ -87,14 +90,11 @@ private static RuntimeScalar sprintfInternal(RuntimeScalar runtimeScalar, Runtim throw new PerlCompilerException("Integer overflow in format string for sprintf "); } // Check for integer overflow FIRST - if ((spec.width != null && spec.width > MAX_PRACTICAL_FORMAT_SIZE) || - (spec.precision != null && (spec.precision == Integer.MAX_VALUE || spec.precision > MAX_PRACTICAL_FORMAT_SIZE)) || + if ((spec.width != null && spec.width > MAX_PRACTICAL_FORMAT_WIDTH) || + (spec.precision != null && spec.precision > MAX_PRACTICAL_PRECISION) || (spec.parameterIndex != null && spec.parameterIndex == Integer.MAX_VALUE) || (spec.widthArgIndex != null && spec.widthArgIndex == Integer.MAX_VALUE) || - (spec.precisionArgIndex != null && spec.precisionArgIndex == Integer.MAX_VALUE) || - // Check for impractically large width/precision values - (spec.width != null && spec.width > MAX_PRACTICAL_FORMAT_SIZE) || - (spec.precision != null && spec.precision > MAX_PRACTICAL_FORMAT_SIZE)) { + (spec.precisionArgIndex != null && spec.precisionArgIndex == Integer.MAX_VALUE)) { throw new PerlCompilerException("Integer overflow in format string for sprintf "); } @@ -620,10 +620,10 @@ private static FormatArguments extractFormatArguments( spec.flags += "-"; args.width = -args.width; // After negation, check again for overflow - if (args.width < 0 || args.width > MAX_PRACTICAL_FORMAT_SIZE) { + if (args.width < 0 || args.width > MAX_PRACTICAL_FORMAT_WIDTH) { throw new PerlCompilerException("Integer overflow in format string for sprintf "); } - } else if (args.width > MAX_PRACTICAL_FORMAT_SIZE) { + } else if (args.width > MAX_PRACTICAL_FORMAT_WIDTH) { throw new PerlCompilerException("Integer overflow in format string for sprintf "); } } else { @@ -665,11 +665,11 @@ private static FormatArguments extractFormatArguments( args.precision = precisionValue.intValue(); if (args.precision < 0) { // For precision, check if negating would cause issues - if (args.precision < -MAX_PRACTICAL_FORMAT_SIZE) { + if (args.precision < -MAX_PRACTICAL_PRECISION) { throw new PerlCompilerException("Integer overflow in format string for sprintf "); } args.precision = -1; // Negative precision is ignored - } else if (args.precision > MAX_PRACTICAL_FORMAT_SIZE) { + } else if (args.precision > MAX_PRACTICAL_PRECISION) { throw new PerlCompilerException("Integer overflow in format string for sprintf "); } } else { diff --git a/src/main/java/org/perlonjava/runtime/operators/sprintf/SprintfPaddingHelper.java b/src/main/java/org/perlonjava/runtime/operators/sprintf/SprintfPaddingHelper.java index 07afb076e3..c767a703bd 100644 --- a/src/main/java/org/perlonjava/runtime/operators/sprintf/SprintfPaddingHelper.java +++ b/src/main/java/org/perlonjava/runtime/operators/sprintf/SprintfPaddingHelper.java @@ -80,8 +80,7 @@ public static String padLeft(String str, int width) { * Pad a string on the left with a specified character. */ public static String padLeft(String str, int width, char padChar) { - // Add overflow protection - if (width > SprintfOperator.MAX_PRACTICAL_FORMAT_SIZE) { + if (width > SprintfOperator.MAX_PRACTICAL_FORMAT_WIDTH) { throw new PerlCompilerException("Integer overflow in format string for sprintf "); } @@ -160,4 +159,4 @@ private static class PrefixedNumber { String prefix = ""; String number = ""; } -} \ No newline at end of file +} diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/FileUtils.java b/src/main/java/org/perlonjava/runtime/runtimetypes/FileUtils.java index c720f87583..d6b54d834c 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/FileUtils.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/FileUtils.java @@ -24,11 +24,10 @@ public class FileUtils { */ public static String decodePerlSourceBytes(byte[] bytes, CompilerOptions parsedArgs) { String content = detectEncodingAndDecode(bytes, parsedArgs); - // Normalize line endings: \r\n → \n, bare \r → \n - // This must happen for source files so the Lexer sees clean \n line endings. - // For eval STRING input, \r characters are preserved (they don't go through this path). + // Normalize Windows line endings while preserving bare carriage returns. + // A bare CR can be part of a Perl quote-like string or regex pattern. if (content.indexOf('\r') >= 0) { - content = content.replace("\r\n", "\n").replace("\r", "\n"); + content = content.replace("\r\n", "\n"); } return content; } diff --git a/src/test/java/org/perlonjava/PerlScriptExecutionTest.java b/src/test/java/org/perlonjava/PerlScriptExecutionTest.java index c09321dc52..f79c724386 100644 --- a/src/test/java/org/perlonjava/PerlScriptExecutionTest.java +++ b/src/test/java/org/perlonjava/PerlScriptExecutionTest.java @@ -323,10 +323,10 @@ private void executeTest(String filename) { // Read the content of the Perl script with UTF-8 encoding String content = new String(inputStream.readAllBytes(), StandardCharsets.UTF_8); // Normalize CRLF to LF, matching what readFileWithEncodingDetection() does - // for source files loaded by ./jperl. On Windows, Git checks out files with - // CRLF line endings, but the Lexer expects LF-only line endings. + // for source files loaded by ./jperl. Preserve bare CR, which may be part + // of a Perl quote-like string or regex pattern. if (content.indexOf('\r') >= 0) { - content = content.replace("\r\n", "\n").replace("\r", "\n"); + content = content.replace("\r\n", "\n"); } CompilerOptions options = new CompilerOptions(); options.code = content; // Set the code to be executed diff --git a/src/test/resources/unit/regex/literal_cr_substitution.t b/src/test/resources/unit/regex/literal_cr_substitution.t new file mode 100644 index 0000000000..005ff1a871 --- /dev/null +++ b/src/test/resources/unit/regex/literal_cr_substitution.t @@ -0,0 +1,8 @@ +use strict; +use warnings; +use Test::More tests => 2; + +my $text = "before\nmiddle\r\nend\n"; +$text =~ s/ //g; +is($text, "before\nmiddle\nend\n", 'literal carriage return removal preserves line feeds'); +is(($text =~ tr/\n//), 3, 'all three line feeds survive'); diff --git a/src/test/resources/unit/sprintf_large_width.t b/src/test/resources/unit/sprintf_large_width.t new file mode 100644 index 0000000000..c505481677 --- /dev/null +++ b/src/test/resources/unit/sprintf_large_width.t @@ -0,0 +1,13 @@ +use strict; +use warnings; +use Test::More tests => 4; + +my $width = 10965; + +my $static = sprintf("%${width}s", 'x'); +is(length($static), $width, 'static width above 8192 is accepted'); +is(substr($static, -1), 'x', 'static width keeps the value right-aligned'); + +my $dynamic = sprintf('%*s', $width, 'x'); +is(length($dynamic), $width, 'dynamic width above 8192 is accepted'); +is(substr($dynamic, -1), 'x', 'dynamic width keeps the value right-aligned');