Fix heredoc and Internals core-test compatibility

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.
 

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,14 +121,18 @@ 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) {
         parser.debugHeredocState("HEREDOC_PROCESSING_START");
         List<OperatorNode> heredocNodes = parser.getHeredocNodes();
         List<LexerToken> 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,16 +197,32 @@ 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)) {
                         // End of heredoc - remove the end marker line from the content
                         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;
     }

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//<<EOF.../e; print\n...EOF' parses the body as
+                        // arguments to print.
+                        parser.heredocNewlineIndex = beforeHeredocTokPos;
+                        parser.heredocSkipToIndex = afterHeredocTokPos;
                     } else {
                         // Heredoc only consumed the newline, add pending content including newline
                         pendingBuffer.append(currentToken.text);

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();
         }
 

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,10 @@ 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.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);

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();

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;