diff --git a/docs/about/changelog.md b/docs/about/changelog.md index afe7781bb2..c915f5c7bb 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -9,6 +9,13 @@ 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, 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`. + - 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..970b5f3a0a 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) { @@ -107,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()); @@ -146,7 +172,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 +197,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 +220,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 +272,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); } } } @@ -275,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/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//< 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); if (arg.value instanceof RuntimeBase base) { int rc = base.refCount; @@ -731,6 +739,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/heredoc.t b/src/test/resources/unit/heredoc.t index c47f980999..fccd1379a6 100644 --- a/src/test/resources/unit/heredoc.t +++ b/src/test/resources/unit/heredoc.t @@ -1,7 +1,7 @@ use 5.38.0; use strict; use warnings; -use Test::More tests => 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(); 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..562611d7aa --- /dev/null +++ b/src/test/resources/unit/internals_prototype_bypass.t @@ -0,0 +1,27 @@ +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", + ); + } +} + +my @empty; +is eval { Internals::SvREFCNT(@empty, 9); $@ }, '', + 'SvREFCNT accepts an empty aggregate followed by its optional refcount'; + +done_testing;