diff --git a/docs/about/changelog.md b/docs/about/changelog.md index 19cdddb7d4..15bf39ba71 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -6,6 +6,8 @@ priorities and future plans. ## Work in progress +- Parse forward-declared qualified classes as indirect constructors inside `new` methods (#1899). + - Match Perl `Encode` aliases for ANSI X3.4-1968, HZ-GB-2312, and ISO-8859-8-I, and include the BOM when encoding generic UTF-32 (#1897). - Separate organizational and project issue queues, record temporary agent claims and dependencies, and keep agent checkpoints concise (#1895). diff --git a/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java b/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java index e03f738f28..6709a55340 100644 --- a/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java +++ b/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java @@ -386,7 +386,12 @@ && isValidIndirectMethod(sourceSubName, parser) if ((isPackage != null && !isPackage) || (isPackage == null && !isKnownSub && token.text.equals("(") && !packageName.contains("::") && subExists) || (subExists && packageName.contains("::") && token.text.equals("(") - && !(isPackage != null && isPackage)) + && !(isPackage != null && isPackage) + // Inside a named `new` method, a qualified class may be + // declared later in the file. Keep it as indirect + // constructor syntax instead of parsing it as a direct + // call to the current `new` subroutine. + && !sourceSubName.equals("new")) // If the method name is a known subroutine and the invocant // candidate is an unknown bareword followed by a list boundary, // Perl keeps the direct sub call: `foo Bar, baz` is diff --git a/src/test/resources/unit/indirect_object_constructor.t b/src/test/resources/unit/indirect_object_constructor.t index c90ae5bf37..bc23c3cc2a 100644 --- a/src/test/resources/unit/indirect_object_constructor.t +++ b/src/test/resources/unit/indirect_object_constructor.t @@ -42,6 +42,32 @@ is( 'require Foo::Bar marks the package for following indirect constructor syntax' ); +{ + package IndirectObject::ForwardFactory; + sub new { + my $class = shift; + my $tree = new IndirectObject::Forward::Tree(@_); + return bless { tree => $tree }, $class; + } +} + +{ + package IndirectObject::Forward::Tree; + sub new { bless { args => [@_[1 .. $#_]] }, shift } +} + +my $forward_factory = IndirectObject::ForwardFactory->new('from-forward-class'); +is( + ref($forward_factory->{tree}), + 'IndirectObject::Forward::Tree', + 'qualified indirect constructor works for a package declared later' +); +is_deeply( + $forward_factory->{tree}->{args}, + ['from-forward-class'], + 'qualified indirect constructor forwards arguments to a later package' +); + # A fully-qualified class used only in platform-specific code need not be # loaded for Perl to parse an indirect constructor followed by a method call. # Argv::Win32Utils uses this exact form on non-Windows platforms.