administrator/blaise
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

feat(types): support forward class and interface declarations

Browse source 
A bare `TFoo = class;` / `IFoo = interface;` (the keyword immediately
followed by `;`, with no ancestor clause and no body) is a forward
declaration: it registers a placeholder type that a later full
declaration of the same name completes within the same declaration
scope. This is the standard Object Pascal idiom for mutually
referential types, e.g. a class declared between the forward and its
full declaration may name the forward-declared type.

Previously the front end registered the bare `class;` as a complete
type and then rejected the full declaration as a duplicate type name,
so the idiom could not be used at all.

The parser flags the stub via TClassTypeDef.IsForward /
TInterfaceTypeDef.IsForward. AnalyseTypeDecls registers the placeholder
in pass 1, lets the matching full declaration complete it (reusing the
placeholder descriptor) instead of erroring, skips the stub in pass 2,
and after resolution drops the now-redundant stub from the AST so later
phases see a single declaration. A forward never completed in the scope
is reported as "Forward type not resolved"; a type forward-declared
twice is "Duplicate forward type declaration".

Tests: IR/semantic coverage for completion, mutual reference,
unresolved, and double-forward errors, plus a single-vtable codegen
check (the stub must not double-emit); an e2e test compiles and runs a
mutually-referential class pair with a managed field.
This commit is contained in:
Andrew Haines 2026-06-24 17:48:59 -04:00 committed by Graeme Geldenhuys
parent 3c092babc6
commit 4addcd1076
6 changed files with 325 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
compiler/src/main/pascal/uAST.pas
View file

@ -897,6 +897,8 @@ type
Methods: TObjectList; { owned TMethodDecl }
Properties: TObjectList; { owned TPropertyDecl }
Attributes: TStringList; { owned — class-level custom attribute names e.g. 'Threaded' }
IsForward: Boolean; { True for a forward decl 'TFoo = class;' (no ancestor,
no body) — completed by the full decl later in scope }
constructor Create;
destructor Destroy; override;
end;
@ -957,6 +959,7 @@ type
ParentName: string;
Methods: TObjectList; { owned TMethodDecl — forward signatures only }
Properties: TObjectList; { owned TPropertyDecl — accessors are interface methods }
IsForward: Boolean; { True for a forward decl 'IFoo = interface;' — completed later in scope }
constructor Create;
destructor Destroy; override;
end;
@ -2471,6 +2474,7 @@ begin
if ASrc = nil then begin Result := nil; Exit; end;
Result := TClassTypeDef.Create();
Result.ParentName := ASrc.ParentName;
Result.IsForward := ASrc.IsForward;
for I := 0 to ASrc.ImplementsNames.Count - 1 do
Result.ImplementsNames.Add(ASrc.ImplementsNames.Strings[I]);
for I := 0 to ASrc.ConstDecls.Count - 1 do
@ -2511,6 +2515,7 @@ begin
if ASrc = nil then begin Result := nil; Exit; end;
Result := TInterfaceTypeDef.Create();
Result.ParentName := ASrc.ParentName;
Result.IsForward := ASrc.IsForward;
for I := 0 to ASrc.Methods.Count - 1 do
Result.Methods.Add(CloneMethodDecl(TMethodDecl(ASrc.Methods.Items[I])));
for I := 0 to ASrc.Properties.Count - 1 do

16
compiler/src/main/pascal/uParser.pas
View file

@ -1975,6 +1975,15 @@ begin
Result.Line := FCurrent.Line;
Result.Col := FCurrent.Col;
Expect(tkClass);
{ Forward class declaration: the keyword `class` immediately followed by
`;` (no ancestor clause, no body). `class(TBase);` and `class end;` are
complete empty classes, not forwards. The full declaration later in the
same type scope completes it (see uSemantic.AnalyseTypeDecls). }
if Check(tkSemicolon) then
begin
Result.IsForward := True;
Exit;
end;
if Check(tkLParen) then
begin
Advance();
@ -2047,6 +2056,13 @@ begin
Result.Line := FCurrent.Line;
Result.Col := FCurrent.Col;
Expect(tkIntf);
{ Forward interface declaration `IFoo = interface;` — no parent, no body,
completed later in the same type scope. }
if Check(tkSemicolon) then
begin
Result.IsForward := True;
Exit;
end;
if Check(tkLParen) then
begin
Advance();

90
compiler/src/main/pascal/uSemantic.pas
View file

@ -4843,7 +4843,16 @@ var
IdxTD: TTypeDesc;
ArrTD: TStaticArrayTypeDesc;
Expected: Integer;
ForwardDecls: TStringList; { names of bare forward class/interface decls still
awaiting their completing full declaration }
FwdIdx: Integer;
begin
{ Forward declarations (`TFoo = class;` / `IFoo = interface;`) register a
placeholder type in pass 1 and are completed by a later full declaration of
the same name in this scope. Track the pending ones so a never-completed
forward is reported as an error. }
ForwardDecls := TStringList.Create();
ForwardDecls.CaseSensitive := False;
{ Pass 1 — register all type symbols with empty descriptors.
This allows self-referential field types to resolve in pass 2. }
for I := 0 to ABlock.TypeDecls.Count - 1 do
@ -4855,7 +4864,37 @@ begin
RT.IsPacked := TRecordTypeDef(TD.Def).IsPacked;
end
else if TD.Def is TClassTypeDef then
RT := FTable.NewClassType(TD.Name)
begin
if TClassTypeDef(TD.Def).IsForward then
begin
{ Forward class: register a placeholder class type so intervening
declarations can name it. A name already in the table — including a
prior forward — is a redeclaration. }
if FTable.Lookup(TD.Name) <> nil then
begin
if ForwardDecls.IndexOf(TD.Name) >= 0 then
SemanticError(Format('Duplicate forward type declaration ''%s''',
[TD.Name]), TD.Line, TD.Col)
else
SemanticError(Format('Duplicate type name ''%s''', [TD.Name]),
TD.Line, TD.Col);
end;
Sym := TSymbol.Create(TD.Name, skType, FTable.NewClassType(TD.Name));
FTable.Define(Sym);
ForwardDecls.AddObject(TD.Name, TD);
Continue;
end;
{ Full class declaration completing a pending forward: reuse the
placeholder descriptor (pass 2 re-derives it by name) — skip the
re-registration below. }
FwdIdx := ForwardDecls.IndexOf(TD.Name);
if FwdIdx >= 0 then
begin
ForwardDecls.Delete(FwdIdx);
Continue;
end;
RT := FTable.NewClassType(TD.Name);
end
else if TD.Def is TGenericTypeDef then
begin
{ Register as template — no concrete type symbol; instantiated on demand.
@ -4878,6 +4917,30 @@ begin
end
else if TD.Def is TInterfaceTypeDef then
begin
if TInterfaceTypeDef(TD.Def).IsForward then
begin
{ Forward interface: placeholder, completed later in scope. }
if FTable.Lookup(TD.Name) <> nil then
begin
if ForwardDecls.IndexOf(TD.Name) >= 0 then
SemanticError(Format('Duplicate forward type declaration ''%s''',
[TD.Name]), TD.Line, TD.Col)
else
SemanticError(Format('Duplicate type name ''%s''', [TD.Name]),
TD.Line, TD.Col);
end;
Sym := TSymbol.Create(TD.Name, skType, FTable.NewInterfaceType(TD.Name));
FTable.Define(Sym);
ForwardDecls.AddObject(TD.Name, TD);
Continue;
end;
{ Full interface completing a pending forward: reuse the placeholder. }
FwdIdx := ForwardDecls.IndexOf(TD.Name);
if FwdIdx >= 0 then
begin
ForwardDecls.Delete(FwdIdx);
Continue;
end;
IntfDesc := FTable.NewInterfaceType(TD.Name);
Sym := TSymbol.Create(TD.Name, skType, IntfDesc);
if not FTable.Define(Sym) then
@ -5064,6 +5127,11 @@ begin
if TD.Def is TSetTypeDef then Continue;
if TD.Def is TTypeAliasDef then Continue;
{ Forward stub: the completing full declaration (same name, later) carries
the body and does all pass-2 work. }
if (TD.Def is TClassTypeDef) and TClassTypeDef(TD.Def).IsForward then Continue;
if (TD.Def is TInterfaceTypeDef) and TInterfaceTypeDef(TD.Def).IsForward then Continue;
{ Procedural types: resolve param + return types now that all
type names are registered. }
if TD.Def is TProceduralTypeDef then
@ -5657,6 +5725,26 @@ begin
if (Sym <> nil) and (Sym.Kind = skType) then
TPointerTypeDesc(BaseSym.TypeDesc).BaseType := Sym.TypeDesc;
end;
{ A forward declaration never completed in this scope is an error. }
if ForwardDecls.Count > 0 then
begin
TD := TTypeDecl(ForwardDecls.Objects[0]);
SemanticError(Format('Forward type not resolved ''%s''',
[ForwardDecls.Strings[0]]), TD.Line, TD.Col);
end;
{ Drop the now-redundant forward stubs from the AST so later phases (codegen
iterates ABlock.TypeDecls) never see two declarations of the same type. }
for I := ABlock.TypeDecls.Count - 1 downto 0 do
begin
TD := TTypeDecl(ABlock.TypeDecls.Items[I]);
if ((TD.Def is TClassTypeDef) and TClassTypeDef(TD.Def).IsForward) or
((TD.Def is TInterfaceTypeDef) and TInterfaceTypeDef(TD.Def).IsForward) then
ABlock.TypeDecls.Delete(I);
end;
ForwardDecls.Free();
end;
procedure TSemanticAnalyser.AnalyseMethodBodies(ABlock: TBlock);

124
compiler/src/test/pascal/cp.test.classes.pas
View file

@ -71,6 +71,15 @@ type
procedure TestCodegen_MethodCall_CaseInsensitive;
procedure TestCodegen_MethodBody_ReadsProgramGlobal;
{ ------------------------------------------------------------------ }
{ Forward class declarations (TFoo = class;) }
{ ------------------------------------------------------------------ }
procedure TestSemantic_ForwardClass_CompletedByFullDecl;
procedure TestSemantic_ForwardClass_MutualReference;
procedure TestSemantic_ForwardClass_Unresolved_RaisesError;
procedure TestSemantic_ForwardClass_DoubleForward_RaisesError;
procedure TestCodegen_ForwardClass_SingleVTable;
{ ------------------------------------------------------------------ }
{ Free built-in }
{ ------------------------------------------------------------------ }
@ -1180,6 +1189,121 @@ begin
end;
end;
{ ------------------------------------------------------------------ }
{ Forward class declarations }
{ ------------------------------------------------------------------ }
procedure TClassTests.TestSemantic_ForwardClass_CompletedByFullDecl;
var
Prog: TProgram;
begin
{ A bare `TFoo = class;` forward stub, completed by the full declaration
later in the same type section, must not be a duplicate-type error. }
Prog := AnalyseSrc(
'''
program P;
type
TFoo = class;
TFoo = class
X: Integer;
end;
begin
end.
''');
try
AssertTrue('forward class completed by full decl analyses OK', Prog <> nil);
finally
Prog.Free();
end;
end;
procedure TClassTests.TestSemantic_ForwardClass_MutualReference;
var
Prog: TProgram;
begin
{ The point of a forward decl: a class declared between the forward and the
full declaration can name the forward-declared type. }
Prog := AnalyseSrc(
'''
program P;
type
TFoo = class;
TBar = class
Foo: TFoo;
end;
TFoo = class
Bar: TBar;
end;
begin
end.
''');
try
AssertTrue('mutual class reference via forward decl analyses OK',
Prog <> nil);
finally
Prog.Free();
end;
end;
procedure TClassTests.TestSemantic_ForwardClass_Unresolved_RaisesError;
begin
{ A forward never completed in the scope is an error. }
AnalyseExpectError(
'''
program P;
type
TFoo = class;
begin
end.
''');
end;
procedure TClassTests.TestSemantic_ForwardClass_DoubleForward_RaisesError;
begin
{ The same type may be forward-declared only once. }
AnalyseExpectError(
'''
program P;
type
TFoo = class;
TFoo = class;
TFoo = class
X: Integer;
end;
begin
end.
''');
end;
procedure TClassTests.TestCodegen_ForwardClass_SingleVTable;
var
IR: string;
Count: Integer;
P: Integer;
begin
{ The forward stub is dropped after semantic analysis, so codegen must emit
the class's vtable exactly once — a second emission would be a duplicate
data symbol and fail to link. }
IR := GenIR(
'''
program P;
type
TFoo = class;
TFoo = class
X: Integer;
end;
begin
end.
''');
Count := 0;
P := 0;
repeat
P := PosEx('data $vtable_TFoo', IR, P);
if P >= 0 then begin Inc(Count); Inc(P) end;
until P < 0;
AssertEquals('vtable_TFoo emitted exactly once', 1, Count);
end;
initialization
RegisterTest(TClassTests);

41
compiler/src/test/pascal/cp.test.e2e.classes2.pas
View file

@ -159,6 +159,10 @@ type
{ ClassCreate builtin still works (backwards compat) and now dispatches
the ctor body via vtable too. }
procedure TestRun_ClassCreate_StillWorks;
{ Forward class declaration with a managed (string) field: the forward
stub must complete into the same type so the full class — including its
ARC field — compiles and runs correctly. }
procedure TestRun_ForwardClass_MutualRefRuns;
procedure TestRun_SelfIndexedRecordFieldAssign;
end;
@ -201,6 +205,35 @@ const
end.
''';
{ Forward-declared TNode referenced by TEdge before its full definition,
then completed with a managed (string) field and a back-reference. }
SrcForwardClass =
'''
program Prg;
type
TNode = class;
TEdge = class
Target: TNode;
end;
TNode = class
Name: string;
Link: TEdge;
end;
var
N: TNode;
E: TEdge;
begin
N := TNode.Create();
N.Name := 'hello';
E := TEdge.Create();
E.Target := N;
N.Link := E;
WriteLn(E.Target.Name);
N.Free();
E.Free()
end.
''';
SrcToStringDefault = '''
program Prg;
type
@ -2286,6 +2319,14 @@ begin
AssertRunsOnAll(Src, '1' + LE, 0);
end;
procedure TE2EClasses2Tests.TestRun_ForwardClass_MutualRefRuns;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRun(SrcForwardClass, Output, RCode));
AssertEquals('forward-declared TNode field read back', 'hello', Trim(Output));
end;
initialization
RegisterTest(TE2EClasses2Tests);

50
compiler/src/test/pascal/cp.test.interfaces.pas
View file

@ -130,6 +130,12 @@ type
procedure TestCodegen_IntfDispatch_RecordArg_PassesAggregate;
procedure TestCodegen_IntfDispatch_OutString_PassesSlotAddr;
procedure TestCodegen_DiscardedIntfReturnStmt_GetsSretAndRelease;
{ ------------------------------------------------------------------ }
{ Forward interface declarations (IFoo = interface;) }
{ ------------------------------------------------------------------ }
procedure TestSemantic_ForwardInterface_CompletedByFullDecl;
procedure TestSemantic_ForwardInterface_Unresolved_RaisesError;
end;
implementation
@ -1774,6 +1780,50 @@ begin
Pos('call $_ClassRelease', Copy(IR, CallPos, MaxInt)) > 0);
end;
{ ------------------------------------------------------------------ }
{ Forward interface declarations }
{ ------------------------------------------------------------------ }
procedure TInterfaceTests.TestSemantic_ForwardInterface_CompletedByFullDecl;
var
Prog: TProgram;
begin
{ `IFoo = interface;` forward stub completed later in the same scope. }
Prog := AnalyseSrc(
'''
program P;
type
IFoo = interface;
IBar = interface
function GetFoo: IFoo;
end;
IFoo = interface
function GetBar: IBar;
end;
begin
end.
''');
try
AssertTrue('forward interface completed by full decl analyses OK',
Prog <> nil);
finally
Prog.Free();
end;
end;
procedure TInterfaceTests.TestSemantic_ForwardInterface_Unresolved_RaisesError;
begin
{ A forward interface never completed in the scope is an error. }
AnalyseExpectError(
'''
program P;
type
IFoo = interface;
begin
end.
''');
end;
initialization
RegisterTest(TInterfaceTests);