diff --git a/src/main/java/org/perlonjava/frontend/parser/FileHandle.java b/src/main/java/org/perlonjava/frontend/parser/FileHandle.java index 81f7557cf..6254b4851 100644 --- a/src/main/java/org/perlonjava/frontend/parser/FileHandle.java +++ b/src/main/java/org/perlonjava/frontend/parser/FileHandle.java @@ -183,6 +183,13 @@ public static Node parseFileHandle(Parser parser, boolean autovivifyUnknownBarew // Handle bareword file handles (most common case) // Examples: STDOUT, STDERR, STDIN, or user-defined handles like LOG, FILE, etc. else if (token.type == LexerTokenType.IDENTIFIER) { + // `print foo()` is always a call whose result is printed. A prior + // typeglob assignment can create an IO placeholder while the CODE + // slot is still installed only at runtime, so checking the current + // global slots first would incorrectly make foo the filehandle. + if (!hasBracket && isBarewordCallAtCurrentPosition(parser)) { + return null; + } // Check if this is a function call or method chain // In that case, we need to parse it as an expression, not a bareword LexerToken nextToken = parser.tokens.get(parser.tokenIndex + 1); @@ -354,6 +361,19 @@ private static boolean isImmediatelyFollowedByOpenParen(Parser parser) { && "(".equals(parser.tokens.get(parser.tokenIndex).text); } + /** + * Checks a bareword before it has been consumed as a prospective + * filehandle. Unlike {@link #isImmediatelyFollowedByOpenParen}, the + * parser is still positioned on the identifier itself. + */ + private static boolean isBarewordCallAtCurrentPosition(Parser parser) { + int index = parser.tokenIndex + 1; + while (index + 1 < parser.tokens.size() && "::".equals(parser.tokens.get(index).text)) { + index += 2; + } + return index < parser.tokens.size() && "(".equals(parser.tokens.get(index).text); + } + private static boolean isFollowedByMethodDereference(Parser parser) { int idx = parser.tokenIndex; while (idx < parser.tokens.size() diff --git a/src/main/java/org/perlonjava/frontend/parser/OperatorParser.java b/src/main/java/org/perlonjava/frontend/parser/OperatorParser.java index 6bcb146e7..2c2533c50 100644 --- a/src/main/java/org/perlonjava/frontend/parser/OperatorParser.java +++ b/src/main/java/org/perlonjava/frontend/parser/OperatorParser.java @@ -269,7 +269,14 @@ static BinaryOperatorNode parsePrint(Parser parser, LexerToken token, int curren parser.debugHeredocState("PRINT_START"); try { - operand = ListParser.parseZeroOrMoreList(parser, 0, false, true, true, false, true); + // A parenthesized bareword call is part of print's argument list, + // not a parenthesized filehandle form. In particular, a CODE slot + // may be installed through a typeglob only when this statement + // runs, so filehandle probing cannot use the current glob slots to + // disambiguate it. + boolean parenthesizedBarewordCall = isParenthesizedBarewordCall(parser); + operand = ListParser.parseZeroOrMoreList( + parser, 0, false, true, !parenthesizedBarewordCall, false, true); parser.debugHeredocState("PRINT_PARSE_SUCCESS"); } catch (PerlCompilerException e) { parser.debugHeredocState("PRINT_BEFORE_BACKTRACK"); @@ -310,6 +317,34 @@ static BinaryOperatorNode parsePrint(Parser parser, LexerToken token, int curren return new BinaryOperatorNode(token.text, handle, operand, currentIndex); } + /** True for {@code print(foo(...), ...)}, but not {@code print(FH (...))}. */ + private static boolean isParenthesizedBarewordCall(Parser parser) { + if (!peek(parser).text.equals("(")) { + return false; + } + + int index = parser.tokenIndex + 1; + while (parser.tokens.get(index).type == WHITESPACE) { + index++; + } + if (parser.tokens.get(index).type != IDENTIFIER) { + return false; + } + index++; + + // Qualified calls such as print(Package::foo(), ...) follow the same + // rule. Do not skip whitespace before the call parenthesis: that is + // the meaningful distinction from print(FH (...)). + while (parser.tokens.get(index).text.equals("::")) { + index++; + if (parser.tokens.get(index).type != IDENTIFIER) { + return false; + } + index++; + } + return parser.tokens.get(index).text.equals("("); + } + /** * Check if a variable name refers to a forced-global variable that cannot * be lexicalized with 'my' or 'state'. diff --git a/src/test/resources/unit/typeglob_print_dynamic_sub.t b/src/test/resources/unit/typeglob_print_dynamic_sub.t new file mode 100644 index 000000000..fe809617a --- /dev/null +++ b/src/test/resources/unit/typeglob_print_dynamic_sub.t @@ -0,0 +1,25 @@ +use strict; +use warnings; +use Test::More tests => 2; + +# The call sites are parsed before this assignment runs, so they must retain +# dynamic named-sub lookup instead of being interpreted as filehandles. +*issue_1163_bar = sub { 'glob-installed' }; + +my $output = ''; +open my $fh, '>', \$output or die "open scalar handle: $!"; +{ + local *STDOUT = $fh; + print issue_1163_bar(), "\n"; +} +is $output, "glob-installed\n", + 'unparenthesized print invokes a sub installed through a typeglob'; + +$output = ''; +open $fh, '>', \$output or die "open scalar handle: $!"; +{ + local *STDOUT = $fh; + print(issue_1163_bar(), "\n"); +} +is $output, "glob-installed\n", + 'parenthesized print invokes a sub installed through a typeglob';