From da377f3dec275fe7cafec1dda11a801e4a1de37f Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Sun, 13 Sep 2026 10:12:21 +0200 Subject: [PATCH 1/3] fix: restore Perl heredoc compatibility Handle indented delimiters, eval substitution bodies, EOF termination, and Perl-compatible heredoc diagnostics on both backends. Generated with Codex (https://openai.com/codex) Co-Authored-By: Codex --- docs/about/changelog.md | 3 + .../frontend/parser/ParseHeredoc.java | 80 +++++++++++++++++-- .../frontend/parser/StringParser.java | 9 +++ src/test/resources/unit/heredoc.t | 30 ++++++- 4 files changed, 114 insertions(+), 8 deletions(-) diff --git a/docs/about/changelog.md b/docs/about/changelog.md index afe7781bb2..dd0e4dea62 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -9,6 +9,9 @@ priorities and future plans. - Preserve Perl control-verb boundaries through nested common-prefix regex alternatives, restoring `re/regexp.t` compatibility on both backends. +- Restore indented here-doc delimiters with whitespace, eval-string substitution + bodies, EOF termination, and Perl-compatible diagnostics on both backends. + - Restore Perl smartmatch dispatch for arrays, hashes, regexes, predicates, tied hashes, overloaded objects, and both execution backends. diff --git a/src/main/java/org/perlonjava/frontend/parser/ParseHeredoc.java b/src/main/java/org/perlonjava/frontend/parser/ParseHeredoc.java index 88c2c2fd5a..b9a3976a4f 100644 --- a/src/main/java/org/perlonjava/frontend/parser/ParseHeredoc.java +++ b/src/main/java/org/perlonjava/frontend/parser/ParseHeredoc.java @@ -63,6 +63,12 @@ static OperatorNode parseHeredoc(Parser parser, String tokenText) { TokenUtils.consume(parser); } } + if ("`".equals(delimiter) + && parser.tokenIndex + 1 < parser.tokens.size() + && "\\".equals(parser.tokens.get(parser.tokenIndex + 1).text)) { + throw new PerlCompilerException(parser.tokenIndex, + "Unterminated delimiter for here document", parser.ctx.errorUtil); + } } else if (token.type == LexerTokenType.IDENTIFIER || token.type == LexerTokenType.NUMBER) { delimiter = "\""; identifier = tokenText; @@ -82,6 +88,22 @@ static OperatorNode parseHeredoc(Parser parser, String tokenText) { } node.setAnnotation("identifier", identifier); + // Perl diagnoses `0<<<<""0` as a number immediately following an + // empty here-doc delimiter, rather than reducing the expression to a + // generic syntax error. Preserve that diagnostic before the normal + // parser attempts to consume the trailing numeric token. + if (identifier.isEmpty() + && parser.tokenIndex < parser.tokens.size() + && parser.tokens.get(parser.tokenIndex).type == LexerTokenType.NUMBER) { + int numberIndex = parser.tokenIndex; + var location = parser.ctx.errorUtil.getSourceLocationAccurate(numberIndex); + throw new PerlCompilerException( + "Number found where operator expected (Missing operator before \"" + + parser.tokens.get(numberIndex).text + "\"?) at " + + location.fileName() + " line " + location.lineNumber() + + ", near \"<<\"\"" + parser.tokens.get(numberIndex).text + "\""); + } + if (CompilerOptions.DEBUG_ENABLED) parser.ctx.logDebug("Heredoc " + node); parser.getHeredocNodes().add(node); return node; @@ -99,7 +121,10 @@ static void heredocError(Parser parser) { } static void heredocError(Parser parser, OperatorNode heredoc) { - throw new PerlCompilerException(parser.tokenIndex, "Can't find string terminator \"" + heredoc.getAnnotation("identifier") + "\" anywhere before EOF", parser.ctx.errorUtil); + throw PerlCompilerException.withSourceLocation( + heredoc.tokenIndex, + "Can't find string terminator \"" + heredoc.getAnnotation("identifier") + "\" anywhere before EOF", + parser.ctx.errorUtil); } public static void parseHeredocAfterNewline(Parser parser) { @@ -146,7 +171,18 @@ public static void parseHeredocAfterNewline(Parser parser) { // Debug: Log current token if (CompilerOptions.DEBUG_ENABLED) parser.ctx.logDebug(" Token[" + currentIndex + "]: type=" + token.type + ", text='" + token.text.replace("\n", "\\n") + "'"); - if (token.type == LexerTokenType.NEWLINE || (!identifier.isEmpty() && token.type == LexerTokenType.EOF)) { + // EOF normally terminates a line only for a nonempty delimiter. + // The exception is <<~'' with a whitespace-only final line: that + // line is the indented empty terminator even without a trailing + // newline. A plain <<"" followed by data at EOF must still be + // reported as an unterminated heredoc. + boolean eofIsIndentedEmptyTerminator = token.type == LexerTokenType.EOF + && indent + && identifier.isEmpty() + && currentLine.chars().allMatch(Character::isWhitespace); + if (token.type == LexerTokenType.NEWLINE + || (!identifier.isEmpty() && token.type == LexerTokenType.EOF) + || eofIsIndentedEmptyTerminator) { lastTokenWasNewline = (token.type == LexerTokenType.NEWLINE); // End of the current line — strip trailing \r for Windows CRLF compatibility String line = currentLine.toString(); @@ -160,8 +196,22 @@ public static void parseHeredocAfterNewline(Parser parser) { // Check if this line is the end marker String lineToCompare = line; if (indent) { - // Left-trim the line if indentation is enabled - lineToCompare = line.stripLeading(); + // An indented terminator may itself start with whitespace. + // Do not strip all leading whitespace: for <<~' EOF', the + // final space before EOF belongs to the delimiter, while + // only the preceding whitespace is indentation. + int identifierStart = line.length() - identifier.length(); + if (identifierStart < 0 || !line.endsWith(identifier)) { + currentIndex++; + continue; + } + String candidateIndent = line.substring(0, identifierStart); + if (!candidateIndent.chars().allMatch(Character::isWhitespace)) { + currentIndex++; + continue; + } + lineToCompare = identifier; + indentWhitespace = candidateIndent; } if (lineToCompare.equals(identifier)) { @@ -169,7 +219,9 @@ public static void parseHeredocAfterNewline(Parser parser) { lines.removeLast(); // Determine the indentation of the end marker - indentWhitespace = line.substring(0, line.length() - lineToCompare.length()); + if (!indent) { + indentWhitespace = line.substring(0, line.length() - lineToCompare.length()); + } if (CompilerOptions.DEBUG_ENABLED) parser.ctx.logDebug("Detected end marker indentation: '" + indentWhitespace + "'"); if (CompilerOptions.DEBUG_ENABLED) parser.ctx.logDebug("Found heredoc terminator '" + identifier + "' at token index " + currentIndex); foundTerminator = true; // Mark that we found the terminator @@ -219,7 +271,10 @@ else if (currentIndex >= tokens.size() || lines.set(i, line.substring(indentWhitespace.length())); } else if (!line.trim().isEmpty()) { // If the line doesn't start with the expected indentation, throw an error - throw new PerlCompilerException(newlineIndex, "Indentation of here-doc doesn't match delimiter", parser.ctx.errorUtil); + throw PerlCompilerException.withSourceLocation( + heredocNode.tokenIndex, + "Indentation on line " + (i + 1) + " of here-doc doesn't match delimiter", + parser.ctx.errorUtil); } } } @@ -267,6 +322,19 @@ else if (currentIndex >= tokens.size() || heredocNode.operand = operand; heredocNode.annotations.clear(); + // The body is now represented by the rewritten HEREDOC node. It + // must not remain executable source for a parser path that + // backtracks to a position before this heredoc was collected (for + // example the replacement expression in s///e). Leave the + // terminator newline intact as a statement boundary, but make the + // body tokens inert so a stale cursor cannot parse `some data` as + // arguments to a following print statement. + for (int i = newlineIndex + 1; i < currentIndex; i++) { + LexerToken consumed = tokens.get(i); + consumed.text = " "; + consumed.type = LexerTokenType.WHITESPACE; + } + // Update the token index to skip the heredoc content newlineIndex = currentIndex; } diff --git a/src/main/java/org/perlonjava/frontend/parser/StringParser.java b/src/main/java/org/perlonjava/frontend/parser/StringParser.java index 3119fbe735..c133216f3c 100644 --- a/src/main/java/org/perlonjava/frontend/parser/StringParser.java +++ b/src/main/java/org/perlonjava/frontend/parser/StringParser.java @@ -173,6 +173,15 @@ public static ParsedString parseRawStringWithDelimiter(EmitterContext ctx, List< // Skip the newline (it triggered heredoc) and all consumed content tokPos = afterHeredocTokPos - 1; // -1 because loop will increment + + // This quote-like parser must restore the parent parser's + // position below, but it has already consumed the heredoc + // body. Record that range so the parent skips it when it + // later reaches the triggering newline. Without this, + // eval 's//< 17; +use Test::More tests => 23; # Test 1: Basic heredoc my $basic_heredoc = <<'END'; @@ -118,5 +118,31 @@ my $indented_interpolated_heredoc = <<~"END"; END is($indented_interpolated_heredoc, "This heredoc has an interpolated variable\n", 'Indented heredoc with interpolation'); -done_testing(); +# Test 20: Indented heredoc whose delimiter begins with a space +my $leading_space_delimiter = <<~' EOF'; + Leading-space delimiter + EOF +is($leading_space_delimiter, "Leading-space delimiter\n", 'Indented heredoc preserves delimiter-leading space'); + +# Test 21: Indented heredoc whose delimiter ends with a space +my $trailing_space_delimiter = <<~'EOF '; + Trailing-space delimiter + EOF +is($trailing_space_delimiter, "Trailing-space delimiter\n", 'Indented heredoc preserves delimiter-trailing space'); + +# Test 22: Empty indented delimiter on a final line without a newline +my $empty_delimiter_eof = eval "my \$value = <<~'';\n Empty delimiter\n "; +is($@, '', 'Empty indented delimiter at EOF compiles'); +is($empty_delimiter_eof, "Empty delimiter\n", 'Empty indented delimiter at EOF terminates correctly'); + +# Test 23: Here-doc body consumed while parsing a substitution eval is skipped by its parent +my $eval_substitution_heredoc = eval q{ + $_ = ''; + s//<<~'EOF'.""/e; + some data + EOF +}; +is($@, '', 'Eval substitution indented heredoc compiles'); +is($_, "some data\n", 'Eval substitution indented heredoc is not parsed as print arguments'); +done_testing(); From f786f96f50fc452facd509e525eb9c5b7e06aed5 Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Sun, 13 Sep 2026 12:38:47 +0200 Subject: [PATCH 2/3] fix: restore Internals prototype-bypass diagnostics Validate Internals native arguments that bypass Perl prototypes and report their Usage diagnostics at the Perl call site. Generated with Codex (https://openai.com/codex) Co-Authored-By: Codex --- docs/about/changelog.md | 3 +++ .../perlonjava/runtime/operators/WarnDie.java | 7 +++++- .../runtime/perlmodule/Internals.java | 10 ++++++++ .../unit/internals_prototype_bypass.t | 23 +++++++++++++++++++ 4 files changed, 42 insertions(+), 1 deletion(-) create mode 100644 src/test/resources/unit/internals_prototype_bypass.t diff --git a/docs/about/changelog.md b/docs/about/changelog.md index dd0e4dea62..e601f949b5 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -12,6 +12,9 @@ priorities and future plans. - Restore indented here-doc delimiters with whitespace, eval-string substitution bodies, EOF termination, and Perl-compatible diagnostics on both backends. +- Report Perl-compatible `Usage:` diagnostics for invalid prototype-bypassing + calls to `Internals::SvREADONLY`, `SvREFCNT`, and `hv_clear_placeholders`. + - Restore Perl smartmatch dispatch for arrays, hashes, regexes, predicates, tied hashes, overloaded objects, and both execution backends. diff --git a/src/main/java/org/perlonjava/runtime/operators/WarnDie.java b/src/main/java/org/perlonjava/runtime/operators/WarnDie.java index a938812617..469f52dc7d 100644 --- a/src/main/java/org/perlonjava/runtime/operators/WarnDie.java +++ b/src/main/java/org/perlonjava/runtime/operators/WarnDie.java @@ -676,7 +676,12 @@ private static String signatureMismatchLocation(String message, RuntimeScalar de && !message.startsWith("Too many arguments for subroutine '") && !message.startsWith("Odd name/value argument for subroutine '") && !message.startsWith("Missing required named parameter '") - && !message.startsWith("Unrecognized named parameter '")) { + && !message.startsWith("Unrecognized named parameter '") + // Native subs use Perl's conventional Usage: diagnostic for + // arguments that cannot be represented by their prototype. + // These errors, like signature errors, are reported at the + // call site rather than at the Java method definition. + && !message.startsWith("Usage: Internals::")) { return definitionWhere.toString(); } diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/Internals.java b/src/main/java/org/perlonjava/runtime/perlmodule/Internals.java index e89ea559eb..8245b75546 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/Internals.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/Internals.java @@ -1,6 +1,7 @@ package org.perlonjava.runtime.perlmodule; import org.perlonjava.backend.bytecode.InterpretedCode; +import org.perlonjava.runtime.operators.WarnDie; import org.perlonjava.runtime.runtimetypes.*; import java.lang.reflect.Field; @@ -391,6 +392,9 @@ public static RuntimeList stack_refcounted(RuntimeArray args, int ctx) { * to do — returning an empty list matches the behavior callers expect. */ public static RuntimeList hvClearPlaceholders(RuntimeArray args, int ctx) { + if (args.size() != 1 || args.get(0) instanceof RuntimeScalarReadOnly) { + WarnDie.die(new RuntimeScalar("Usage: Internals::hv_clear_placeholders(hv)"), new RuntimeScalar("")); + } return new RuntimeList(); } @@ -416,6 +420,9 @@ public static RuntimeList V(RuntimeArray args, int ctx) { * @return Empty list */ public static RuntimeList svRefcount(RuntimeArray args, int ctx) { + if (args.size() < 1 || args.size() > 2 || args.get(0) instanceof RuntimeScalarReadOnly) { + WarnDie.die(new RuntimeScalar("Usage: Internals::SvREFCNT(SCALAR[, REFCOUNT])"), new RuntimeScalar("")); + } RuntimeScalar arg = args.get(0); if (arg.value instanceof RuntimeBase base) { int rc = base.refCount; @@ -731,6 +738,9 @@ public static RuntimeList jperl_trace_to(RuntimeArray args, int ctx) { * @return The readonly status (query mode) or empty list (set mode) */ public static RuntimeList svReadonly(RuntimeArray args, int ctx) { + if (args.size() < 1 || args.size() > 2 || args.get(0) instanceof RuntimeScalarReadOnly) { + WarnDie.die(new RuntimeScalar("Usage: Internals::SvREADONLY(SCALAR[, ON])"), new RuntimeScalar("")); + } if (args.size() >= 2) { RuntimeBase variable = args.get(0); RuntimeBase flag = args.get(1); diff --git a/src/test/resources/unit/internals_prototype_bypass.t b/src/test/resources/unit/internals_prototype_bypass.t new file mode 100644 index 0000000000..ca31ae0b5c --- /dev/null +++ b/src/test/resources/unit/internals_prototype_bypass.t @@ -0,0 +1,23 @@ +use strict; +use warnings; +use Test::More; + +my @cases = ( + [ 'SvREADONLY', 'SCALAR[, ON]' ], + [ 'SvREFCNT', 'SCALAR[, REFCOUNT]' ], + [ 'hv_clear_placeholders', 'hv' ], +); + +for my $argument ('', 'q[]', '1', 'undef') { + for my $case (@cases) { + my ($name, $signature) = @{$case}; + my $result = eval "&Internals::$name($argument)"; + like( + $@, + qr{\AUsage: Internals::\Q$name\E\(\Q$signature\E\) at \(eval \d+\) line 1\.\n\z}, + "&Internals::$name($argument) reports its prototype usage", + ); + } +} + +done_testing; From a020d45a6185b0448c1c253b244c7cbe325c0622 Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Sun, 13 Sep 2026 14:30:19 +0200 Subject: [PATCH 3/3] fix: preserve heredoc parser spans Keep collected heredoc source intact for nested parsing and source locations, and retain SvREFCNT aggregate calls while validating prototype bypasses. Generated with Codex (https://openai.com/codex) Co-Authored-By: Codex --- docs/about/changelog.md | 3 ++- .../frontend/parser/ParseHeredoc.java | 24 +++++++++---------- .../runtime/perlmodule/Internals.java | 3 ++- .../unit/internals_prototype_bypass.t | 4 ++++ 4 files changed, 19 insertions(+), 15 deletions(-) diff --git a/docs/about/changelog.md b/docs/about/changelog.md index e601f949b5..c915f5c7bb 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -10,7 +10,8 @@ priorities and future plans. alternatives, restoring `re/regexp.t` compatibility on both backends. - Restore indented here-doc delimiters with whitespace, eval-string substitution - bodies, EOF termination, and Perl-compatible diagnostics on both backends. + bodies, EOF termination, Perl-compatible diagnostics, and source positions on + both backends. - Report Perl-compatible `Usage:` diagnostics for invalid prototype-bypassing calls to `Internals::SvREADONLY`, `SvREFCNT`, and `hv_clear_placeholders`. diff --git a/src/main/java/org/perlonjava/frontend/parser/ParseHeredoc.java b/src/main/java/org/perlonjava/frontend/parser/ParseHeredoc.java index b9a3976a4f..970b5f3a0a 100644 --- a/src/main/java/org/perlonjava/frontend/parser/ParseHeredoc.java +++ b/src/main/java/org/perlonjava/frontend/parser/ParseHeredoc.java @@ -132,6 +132,7 @@ public static void parseHeredocAfterNewline(Parser parser) { List heredocNodes = parser.getHeredocNodes(); List tokens = parser.tokens; int newlineIndex = parser.tokenIndex; + int triggeringNewlineIndex = newlineIndex; if (CompilerOptions.DEBUG_ENABLED) parser.ctx.logDebug("ParseHeredoc.parseHeredocAfterNewline: Starting at tokenIndex=" + newlineIndex + ", heredoc count=" + heredocNodes.size() + ", total tokens=" + tokens.size()); @@ -322,19 +323,6 @@ else if (currentIndex >= tokens.size() || heredocNode.operand = operand; heredocNode.annotations.clear(); - // The body is now represented by the rewritten HEREDOC node. It - // must not remain executable source for a parser path that - // backtracks to a position before this heredoc was collected (for - // example the replacement expression in s///e). Leave the - // terminator newline intact as a statement boundary, but make the - // body tokens inert so a stale cursor cannot parse `some data` as - // arguments to a following print statement. - for (int i = newlineIndex + 1; i < currentIndex; i++) { - LexerToken consumed = tokens.get(i); - consumed.text = " "; - consumed.type = LexerTokenType.WHITESPACE; - } - // Update the token index to skip the heredoc content newlineIndex = currentIndex; } @@ -343,6 +331,16 @@ else if (currentIndex >= tokens.size() || heredocNodes.addAll(deferredHeredocs); if (CompilerOptions.DEBUG_ENABLED) parser.ctx.logDebug("ParseHeredoc.parseHeredocAfterNewline: Deferred " + deferredHeredocs.size() + " heredocs back to queue"); + // A quote-like parser can collect a heredoc before its enclosing + // parser resumes at the triggering newline. Retain the consumed span + // so Whitespace.skipWhitespace() skips it instead of interpreting the + // body a second time. Do not mutate lexer tokens: their content and + // newlines are still needed for nested heredocs and source locations. + if (newlineIndex > triggeringNewlineIndex) { + parser.heredocNewlineIndex = triggeringNewlineIndex; + parser.heredocSkipToIndex = newlineIndex; + } + parser.debugHeredocState("HEREDOC_AFTER_CLEAR"); parser.tokenIndex = newlineIndex; } diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/Internals.java b/src/main/java/org/perlonjava/runtime/perlmodule/Internals.java index 8245b75546..c40b03bef2 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/Internals.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/Internals.java @@ -420,7 +420,8 @@ public static RuntimeList V(RuntimeArray args, int ctx) { * @return Empty list */ public static RuntimeList svRefcount(RuntimeArray args, int ctx) { - if (args.size() < 1 || args.size() > 2 || args.get(0) instanceof RuntimeScalarReadOnly) { + if (args.size() < 1 || args.size() > 2 + || (args.size() == 1 && args.get(0) instanceof RuntimeScalarReadOnly)) { WarnDie.die(new RuntimeScalar("Usage: Internals::SvREFCNT(SCALAR[, REFCOUNT])"), new RuntimeScalar("")); } RuntimeScalar arg = args.get(0); diff --git a/src/test/resources/unit/internals_prototype_bypass.t b/src/test/resources/unit/internals_prototype_bypass.t index ca31ae0b5c..562611d7aa 100644 --- a/src/test/resources/unit/internals_prototype_bypass.t +++ b/src/test/resources/unit/internals_prototype_bypass.t @@ -20,4 +20,8 @@ for my $argument ('', 'q[]', '1', 'undef') { } } +my @empty; +is eval { Internals::SvREFCNT(@empty, 9); $@ }, '', + 'SvREFCNT accepts an empty aggregate followed by its optional refcount'; + done_testing;