fix(parser): forward; routine in a program declaration section (issue #130 bug2)

A `forward;`-declared routine in a program's declaration section swallowed the
following separate implementation (and everything up to the program's `end.`)
as its own body, producing "Expected ';' but got '.'".

Root cause: in ParseMethodDecl, when ACanHaveNestedProcs is true (the
standalone-proc context used for program/unit blocks), a bare
`procedure`/`function` keyword after the signature triggers body parsing so a
nested sub-routine is absorbed into the enclosing routine.  A forward decl has
no body, so the keyword that follows it is the SEPARATE implementation — but
the body-trigger fired anyway and consumed it.

Fix: track a local IsForward flag (set when the `forward` directive is seen)
and suppress the body-parse trigger for it, exactly as IsExternal already does.
Mutually-recursive routines declared with forward now parse and run.

Tests: a parser test asserts the forward decl and its implementation are two
separate ProcDecls (forward has no body, impl has one); a dual-backend e2e
test runs mutually-recursive IsEven/IsOdd and checks the computed parity.

Verified: FIXPOINT_OK, NATIVE_FIXPOINT_OK, NATIVE_INTERNAL_OK; full suite green
on both the QBE-built and native-built runners (3693 tests).
This commit is contained in:
Graeme Geldenhuys 2026-06-20 16:20:01 +01:00
parent 8c68b09245
commit 33db0f699e
3 changed files with 63 additions and 2 deletions

View file

@ -1874,9 +1874,11 @@ var
TempParams: TStringList; TempParams: TStringList;
TempConstraints: TStringList; TempConstraints: TStringList;
Constraint: string; Constraint: string;
IsForward: Boolean; { 'forward;' directive seen — no body follows }
begin begin
TempParams := nil; TempParams := nil;
TempConstraints := nil; TempConstraints := nil;
IsForward := False;
Result := TMethodDecl.Create(); Result := TMethodDecl.Create();
try try
Result.Line := FCurrent.Line; Result.Line := FCurrent.Line;
@ -2087,6 +2089,8 @@ begin
begin begin
if SameText(FCurrent.Value, 'inline') then if SameText(FCurrent.Value, 'inline') then
Result.IsInline := True Result.IsInline := True
else if SameText(FCurrent.Value, 'forward') then
IsForward := True
else if SameText(FCurrent.Value, 'cdecl') or else if SameText(FCurrent.Value, 'cdecl') or
SameText(FCurrent.Value, 'stdcall') or SameText(FCurrent.Value, 'stdcall') or
SameText(FCurrent.Value, 'register') or SameText(FCurrent.Value, 'register') or
@ -2103,8 +2107,13 @@ begin
absent for class forward declarations, external declarations, etc. absent for class forward declarations, external declarations, etc.
When ACanHaveNestedProcs is True (standalone proc context), a bare When ACanHaveNestedProcs is True (standalone proc context), a bare
'procedure'/'function' keyword triggers body parsing so that a nested 'procedure'/'function' keyword triggers body parsing so that a nested
sub-procedure declaration is parsed as part of the enclosing routine. } sub-procedure declaration is parsed as part of the enclosing routine.
if (not Result.IsExternal) and A 'forward;'-declared routine has NO body here — the following
'procedure'/'function' is the SEPARATE implementation, not a nested
proc. Without this guard the forward decl swallowed the real
implementation (and everything up to the program's 'end.') as its body
(issue #130 bug2). }
if (not Result.IsExternal) and (not IsForward) and
(Check(tkBegin) or Check(tkVar) or Check(tkType) or Check(tkConst) or (Check(tkBegin) or Check(tkVar) or Check(tkType) or Check(tkConst) or
(ACanHaveNestedProcs and (Check(tkProcedure) or Check(tkFunction)))) then (ACanHaveNestedProcs and (Check(tkProcedure) or Check(tkFunction)))) then
begin begin

View file

@ -118,6 +118,10 @@ type
standard integer type and carries no range checking. } standard integer type and carries no range checking. }
procedure TestRun_Subrange_NamedType; procedure TestRun_Subrange_NamedType;
procedure TestRun_Subrange_InRecordAndArray; procedure TestRun_Subrange_InRecordAndArray;
{ forward; in a program decl section (issue #130 bug2): the forward decl
used to swallow the following implementation as a nested-proc body. }
procedure TestRun_Forward_MutualRecursion;
end; end;
implementation implementation
@ -1220,6 +1224,27 @@ begin
AssertRunsOnAll(Src, '200 -7 250' + LE, 0); AssertRunsOnAll(Src, '200 -7 250' + LE, 0);
end; end;
procedure TE2EMiscTests.TestRun_Forward_MutualRecursion;
const
{ Mutually-recursive routines via a forward; declaration in the program's
decl section. Asserts the recursion actually computes parity, not just
that it compiles. }
Src = '''
program P;
function IsEven(n: Integer): Boolean; forward;
function IsOdd(n: Integer): Boolean;
begin if n = 0 then Result := False else Result := IsEven(n - 1) end;
function IsEven(n: Integer): Boolean;
begin if n = 0 then Result := True else Result := IsOdd(n - 1) end;
begin
WriteLn(IsEven(10), ' ', IsEven(7), ' ', IsOdd(7), ' ', IsOdd(4))
end.
''';
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertRunsOnAll(Src, 'True False True False' + LE, 0);
end;
initialization initialization
RegisterTest(TE2EMiscTests); RegisterTest(TE2EMiscTests);

View file

@ -59,6 +59,9 @@ type
procedure TestSubrange_NegativeBounds_Parses; procedure TestSubrange_NegativeBounds_Parses;
procedure TestSubrange_Descending_Error; procedure TestSubrange_Descending_Error;
{ forward; in a program declaration section (issue #130 bug2) }
procedure TestForward_InProgram_Parses;
{ Error cases } { Error cases }
procedure TestError_MissingProgramKeyword; procedure TestError_MissingProgramKeyword;
procedure TestError_MissingDot; procedure TestError_MissingDot;
@ -555,6 +558,30 @@ begin
end; end;
end; end;
procedure TParserTests.TestForward_InProgram_Parses;
var
Prog: TProgram;
begin
{ A forward; routine in a program's decl section, then its separate
implementation, must parse — the forward decl must NOT swallow the
implementation as a nested-proc body (issue #130 bug2). }
Prog := ParseSource(
'program P; ' +
'function F(n: Integer): Boolean; forward; ' +
'function F(n: Integer): Boolean; begin Result := n > 0 end; ' +
'begin WriteLn(F(5)) end.');
try
{ Two ProcDecls: the forward (no body) and the implementation (with body). }
AssertEquals('two proc decls', 2, Prog.Block.ProcDecls.Count);
AssertTrue('forward decl has no body',
TMethodDecl(Prog.Block.ProcDecls.Items[0]).Body = nil);
AssertTrue('impl decl has a body',
TMethodDecl(Prog.Block.ProcDecls.Items[1]).Body <> nil);
finally
Prog.Free();
end;
end;
initialization initialization
RegisterTest(TParserTests); RegisterTest(TParserTests);