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

fix(semantic): repair generic instance methods when type alias precedes impl (#124)

Browse source 
When a named type alias (e.g. TIntHolder = THolder<Integer>) appeared
in the type section before the out-of-line method implementations
(procedure THolder<T>.SetVal), InstantiateGenericRecord cloned the
template methods with Body=nil because LinkGenericClassMethodImpls had
not yet transferred the implementation bodies. Codegen skipped the
bodiless methods, producing undefined-reference link errors.

Add RepairEarlyGenericInstances which runs after LinkGenericClassMethodImpls
in all three analysis paths (AnalyseUnit, AnalyseUnitForExport,
AnalyseBlock). It iterates existing generic record and class instances,
finds methods still missing a body, clones from the now-populated
template, and analyses the repaired methods with correct type-param
scope bindings.
This commit is contained in:
Graeme Geldenhuys 2026-06-17 16:51:26 +01:00
parent 0af9f9f7bf
commit b0499aa454
3 changed files with 272 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -166,6 +166,7 @@ type
procedure AnalyseTypeDecls(ABlock: TBlock);
procedure LinkClassMethodImpls(ABlock: TBlock);
procedure LinkGenericClassMethodImpls(ABlock: TBlock);
procedure RepairEarlyGenericInstances;
procedure AnalyseMethodBodies(ABlock: TBlock);
procedure AnalyseMethodDecl(AMethod: TMethodDecl; AClassType: TRecordTypeDesc);
procedure AnalyseStandaloneDecls(ABlock: TBlock);
@ -1013,6 +1014,7 @@ begin
*before* any FindTypeOrInstantiate call can clone an instance, or the
instance is born with nil bodies and codegen emits no function for it. }
LinkGenericClassMethodImpls(AUnit.ImplBlock);
RepairEarlyGenericInstances;
{ Register interface-section global variables — visible to impl bodies. }
for I := 0 to AUnit.IntfBlock.Decls.Count - 1 do
@ -1321,12 +1323,11 @@ begin
{ Transfer impl-section bodies to generic class templates *before* any
instantiation can happen. Generic instances clone the template's
Methods.Body at instantiation time (uSemantic.pas ~line 1524), so if
the body is still nil when an interface-section global variable or
parameter triggers FindTypeOrInstantiate, the cloned instance method
is born without a body and codegen emits no function — leaving call
sites referencing an undefined symbol. }
Methods.Body at instantiation time, so if the body is still nil,
the cloned instance method is born without a body and codegen emits
no function — leaving call sites referencing an undefined symbol. }
LinkGenericClassMethodImpls(AUnit.ImplBlock);
RepairEarlyGenericInstances;
{ Register interface-section global variables. Marked IsGlobal so
codegen emits them as data-segment slots rather than stack allocs;
@ -1908,6 +1909,215 @@ begin
end;
end;
procedure TSemanticAnalyser.RepairEarlyGenericInstances;
var
Instances: TObjectList;
I, J, K, MIdx: Integer;
GRI: TGenericRecordInstance;
GI: TGenericInstance;
InstMDecl: TMethodDecl;
TmplMDecl: TMethodDecl;
BaseName: string;
ArgsStr: string;
BracPos: Integer;
GenObj: TObject;
TmplMethods: TObjectList;
Args: TStringList;
ParamNames: TStringList;
ConcrType: TTypeDesc;
Sym: TSymbol;
RT: TRecordTypeDesc;
RepairedIndices: TStringList;
begin
Instances := nil;
if FCurrentUnit <> nil then
Instances := FCurrentUnit.GenericRecordInstances
else if FProg <> nil then
Instances := FProg.GenericRecordInstances;
if Instances <> nil then
begin
for I := 0 to Instances.Count - 1 do
begin
GRI := TGenericRecordInstance(Instances.Items[I]);
BracPos := StrPos('<', GRI.TypeName);
if BracPos < 0 then Continue;
BaseName := StrHead(GRI.TypeName, BracPos);
GenObj := FTable.FindGeneric(BaseName);
if not (GenObj is TGenericRecordDef) then Continue;
TmplMethods := TGenericRecordDef(GenObj).RecordDef.Methods;
RepairedIndices := TStringList.Create();
try
for J := 0 to GRI.RecordDef.Methods.Count - 1 do
begin
InstMDecl := TMethodDecl(GRI.RecordDef.Methods.Items[J]);
if InstMDecl.Body <> nil then
Continue;
TmplMDecl := nil;
for K := 0 to TmplMethods.Count - 1 do
if SameText(TMethodDecl(TmplMethods.Items[K]).Name, InstMDecl.Name) then
begin
TmplMDecl := TMethodDecl(TmplMethods.Items[K]);
Break;
end;
if (TmplMDecl <> nil) and (TmplMDecl.Body <> nil) then
begin
InstMDecl.Body := CloneBlock(TmplMDecl.Body);
InstMDecl.OwnBody := True;
RepairedIndices.Add(IntToStr(J));
end;
end;
if RepairedIndices.Count > 0 then
begin
ArgsStr := StrCopyFrom(GRI.TypeName, StrPos('<', GRI.TypeName) + 1,
Length(GRI.TypeName) - StrPos('<', GRI.TypeName) - 2);
Args := TStringList.Create();
try
while ArgsStr <> '' do
begin
BracPos := StrPos(',', ArgsStr);
if BracPos >= 0 then
begin
Args.Add(Trim(StrHead(ArgsStr, BracPos)));
ArgsStr := Trim(StrCopyTail(ArgsStr, BracPos + 1));
end
else
begin
Args.Add(Trim(ArgsStr));
ArgsStr := '';
end;
end;
ParamNames := TGenericRecordDef(FTable.FindGeneric(BaseName)).ParamNames;
RT := TRecordTypeDesc(GRI.TypeDesc);
FTable.PushScope();
for K := 0 to ParamNames.Count - 1 do
FActiveTypeParams.Add(ParamNames.Strings[K]);
try
for K := 0 to ParamNames.Count - 1 do
begin
ConcrType := FindTypeOrInstantiate(Args.Strings[K]);
if ConcrType <> nil then
begin
Sym := TSymbol.Create(ParamNames.Strings[K], skType, ConcrType);
FTable.Define(Sym);
end;
end;
for J := 0 to RepairedIndices.Count - 1 do
begin
MIdx := StrToInt(RepairedIndices.Strings[J]);
InstMDecl := TMethodDecl(GRI.RecordDef.Methods.Items[MIdx]);
if InstMDecl.Body <> nil then
AnalyseMethodDecl(InstMDecl, RT);
end;
finally
for K := 0 to ParamNames.Count - 1 do
FActiveTypeParams.Delete(FActiveTypeParams.Count - 1);
FTable.PopScope();
end;
finally
Args.Free();
end;
end;
finally
RepairedIndices.Free();
end;
end;
end;
Instances := nil;
if FCurrentUnit <> nil then
Instances := FCurrentUnit.GenericInstances
else if FProg <> nil then
Instances := FProg.GenericInstances;
if Instances <> nil then
begin
for I := 0 to Instances.Count - 1 do
begin
GI := TGenericInstance(Instances.Items[I]);
BracPos := StrPos('<', GI.TypeName);
if BracPos < 0 then Continue;
BaseName := StrHead(GI.TypeName, BracPos);
GenObj := FTable.FindGeneric(BaseName);
if not (GenObj is TGenericTypeDef) then Continue;
TmplMethods := TGenericTypeDef(GenObj).ClassDef.Methods;
RepairedIndices := TStringList.Create();
try
for J := 0 to GI.ClassDef.Methods.Count - 1 do
begin
InstMDecl := TMethodDecl(GI.ClassDef.Methods.Items[J]);
if InstMDecl.Body <> nil then
Continue;
TmplMDecl := nil;
for K := 0 to TmplMethods.Count - 1 do
if SameText(TMethodDecl(TmplMethods.Items[K]).Name, InstMDecl.Name) then
begin
TmplMDecl := TMethodDecl(TmplMethods.Items[K]);
Break;
end;
if (TmplMDecl <> nil) and (TmplMDecl.Body <> nil) then
begin
InstMDecl.Body := CloneBlock(TmplMDecl.Body);
InstMDecl.OwnBody := True;
RepairedIndices.Add(IntToStr(J));
end;
end;
if RepairedIndices.Count > 0 then
begin
ArgsStr := StrCopyFrom(GI.TypeName, StrPos('<', GI.TypeName) + 1,
Length(GI.TypeName) - StrPos('<', GI.TypeName) - 2);
Args := TStringList.Create();
try
while ArgsStr <> '' do
begin
BracPos := StrPos(',', ArgsStr);
if BracPos >= 0 then
begin
Args.Add(Trim(StrHead(ArgsStr, BracPos)));
ArgsStr := Trim(StrCopyTail(ArgsStr, BracPos + 1));
end
else
begin
Args.Add(Trim(ArgsStr));
ArgsStr := '';
end;
end;
ParamNames := TGenericTypeDef(FTable.FindGeneric(BaseName)).ParamNames;
RT := TRecordTypeDesc(GI.TypeDesc);
FTable.PushScope();
for K := 0 to ParamNames.Count - 1 do
FActiveTypeParams.Add(ParamNames.Strings[K]);
try
for K := 0 to ParamNames.Count - 1 do
begin
ConcrType := FindTypeOrInstantiate(Args.Strings[K]);
if ConcrType <> nil then
begin
Sym := TSymbol.Create(ParamNames.Strings[K], skType, ConcrType);
FTable.Define(Sym);
end;
end;
for J := 0 to RepairedIndices.Count - 1 do
begin
MIdx := StrToInt(RepairedIndices.Strings[J]);
InstMDecl := TMethodDecl(GI.ClassDef.Methods.Items[MIdx]);
if InstMDecl.Body <> nil then
AnalyseMethodDecl(InstMDecl, RT);
end;
finally
for K := 0 to ParamNames.Count - 1 do
FActiveTypeParams.Delete(FActiveTypeParams.Count - 1);
FTable.PopScope();
end;
finally
Args.Free();
end;
end;
finally
RepairedIndices.Free();
end;
end;
end;
end;
function TSemanticAnalyser.ResolveScopeBoundTypeParams(const ATypeName: string): string;
var
BrOpen, BrClose, I: Integer;
@ -3266,6 +3476,7 @@ begin
declarations, transferring the body so AnalyseMethodBodies can process it. }
LinkClassMethodImpls(ABlock);
LinkGenericClassMethodImpls(ABlock);
RepairEarlyGenericInstances;
{ Register standalone proc/func signatures before class method bodies so that
methods can call free functions declared in the same block. }
AnalyseStandaloneDecls(ABlock);

28
compiler/src/test/pascal/cp.test.e2e.gaps.pas
View file

@ -69,6 +69,9 @@ type
procedure TestRun_DerefFieldSubscript_Write;
procedure TestRun_DerefFieldSubscript_ReadAndWrite;
{ Generic record type alias specialisation (GitHub #124) }
procedure TestRun_GenericRecordAlias_MethodCall;
{ Multi-arg WriteLn }
procedure TestRun_WriteLn_MultipleArgs_MixedTypes;
end;
@ -721,6 +724,31 @@ begin
AssertRunsOnAll(Src, '300' + Chr(10), 0);
end;
procedure TE2EGapTests.TestRun_GenericRecordAlias_MethodCall;
const
Src =
'''
program P;
type
THolder<T> = record
FVal: T;
procedure SetVal(AVal: T);
end;
TIntHolder = THolder<Integer>;
procedure THolder<T>.SetVal(AVal: T);
begin
FVal := AVal
end;
var H: TIntHolder;
begin
H.SetVal(54);
WriteLn(H.FVal)
end.
''';
begin
AssertRunsOnAll(Src, '54' + Chr(10), 0);
end;
procedure TE2EGapTests.TestRun_WriteLn_MultipleArgs_MixedTypes;
const Src = '''
program T;

28
compiler/src/test/pascal/cp.test.genericrecords.pas
View file

@ -47,6 +47,9 @@ type
procedure TestCodegen_GenericRecord_OutOfLine_MethodEmitted;
procedure TestCodegen_GenericRecord_NoTypeInfoEmitted;
procedure TestCodegen_GenericRecord_NoVTableEmitted;
{ Named type alias for generic record specialisation (issue #124) }
procedure TestCodegen_GenericRecord_TypeAlias_MethodEmitted;
end;
implementation
@ -475,6 +478,31 @@ begin
Pos('vtable_TMyVal', IR) < 0);
end;
procedure TGenericRecordTests.TestCodegen_GenericRecord_TypeAlias_MethodEmitted;
var IR: string;
begin
IR := GenIR(
'''
program P;
type
THolder<T> = record
FVal: T;
procedure SetVal(AVal: T);
end;
TIntHolder = THolder<Integer>;
procedure THolder<T>.SetVal(AVal: T);
begin
FVal := AVal
end;
var H: TIntHolder;
begin
H.SetVal(42)
end.
''');
AssertTrue('method body emitted',
Pos('function $THolder_Integer_SetVal', IR) >= 0);
end;
initialization
RegisterTest(TGenericRecordTests);