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

fix(codegen): itab ref for non-virtual inherited interface method (#130 bug3)

Browse source 
When a class inherits its interface implementation from an ancestor and the
implementing method is NON-virtual, the descendant's interface table named
$<descendant>_<method> — a symbol that does not exist — causing a link error
('undefined reference to TDerived_Hello'). A non-virtual method has no vtable
slot, so the itab resolver could not find it via the vtable and fell back to
naming the method after the descendant class instead of the declaring ancestor.

Fix in both backends: when the vtable lookup fails, walk the AST class chain
(self, then ParentName ancestors) to the nearest class that DECLARES the method
and name $<declaringclass>_<method>. QBE gains ItabImplClassName; native
extends ItabMethodRefNative with the same chain walk (it now takes the type-decl
list to resolve ancestors by name).

The existing inherited-interface tests only used virtual methods, which DO get
vtable slots, so this path was uncovered. New regression
TestRun_InheritedInterface_NonVirtualMethod compiles+links+runs on both backends.

Verified: FIXPOINT_OK, NATIVE_FIXPOINT_OK, full suite green (3747) under both the
QBE-built and native-built test runners.
This commit is contained in:
Graeme Geldenhuys 2026-06-24 12:40:46 +01:00
parent e72b644a94
commit 01b5b97659
3 changed files with 112 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

39
compiler/src/main/pascal/blaise.codegen.native.x86_64.pas
View file

@ -354,7 +354,8 @@ type
{ Native label for a class's implementation of an interface method,
resolved via the vtable (inherited + overridden both work). }
function ItabMethodRefNative(AClassRT: TRecordTypeDesc;
ATD: TTypeDecl; const AMethName: string): string;
ATD: TTypeDecl; const AMethName: string;
ATypeDecls: TObjectList): string;
{ Load an integer-family value from AOperand into %rax, extended to 64
bits per AType (sign/zero-extend by width and signedness). }
procedure EmitLoadVar(const AOperand: string; AType: TTypeDesc);
@ -2640,10 +2641,16 @@ end;
the ImplName may carry a leading '$' (QBE convention) which is stripped, then
NativeMangle is applied. Falls back to the declaring-class method name. }
function TX86_64Backend.ItabMethodRefNative(AClassRT: TRecordTypeDesc;
ATD: TTypeDecl; const AMethName: string): string;
ATD: TTypeDecl; const AMethName: string;
ATypeDecls: TObjectList): string;
var
Slot: Integer;
E: TVTableEntry;
Slot: Integer;
E: TVTableEntry;
CurTD: TTypeDecl;
CD: TClassTypeDef;
MD: TMethodDecl;
I: Integer;
CurName: string;
begin
if AClassRT <> nil then
begin
@ -2660,6 +2667,28 @@ begin
end;
end;
end;
{ No vtable slot — a non-virtual interface method. Walk the AST class chain
(self, then ParentName ancestors) to the nearest class that DECLARES the
method and name $<declaringclass>_<method>; naming $<thisclass>_<method> for
an inherited method links to a symbol that does not exist (issue #130 bug3). }
CurTD := ATD;
while CurTD <> nil do
begin
if not (CurTD.Def is TClassTypeDef) then break;
CD := TClassTypeDef(CurTD.Def);
MD := FindMethodInClassDef(CD, AMethName);
if MD <> nil then
Exit(MethodEmitNameNative(MD, CurTD.Name, AMethName));
CurName := CD.ParentName;
CurTD := nil;
if (CurName <> '') and (ATypeDecls <> nil) then
for I := 0 to ATypeDecls.Count - 1 do
if SameText(TTypeDecl(ATypeDecls.Items[I]).Name, CurName) then
begin
CurTD := TTypeDecl(ATypeDecls.Items[I]);
break;
end;
end;
Result := MethodEmitNameNative(
FindMethodInClassDef(TClassTypeDef(ATD.Def), AMethName),
ATD.Name, AMethName);
@ -2770,7 +2799,7 @@ begin
{ Resolve via the vtable so an inherited (non-overridden) method
points at the ancestor's body and an override at the descendant's
(issue #130 bug3). }
MethRef := Self.ItabMethodRefNative(ClassRT, TD, MethName);
MethRef := Self.ItabMethodRefNative(ClassRT, TD, MethName, ATypeDecls);
Self.Emit(#9'.quad ' + MethRef);
end;
end;

48
compiler/src/main/pascal/blaise.codegen.qbe.pas
View file

@ -190,6 +190,14 @@ type
resolved via the vtable so inherited/overridden methods both work. }
function ItabMethodRef(AClassRT: TRecordTypeDesc;
const AClassName, AMethName: string): string;
{ Walk AClassName's AST class chain (self, then ParentName ancestors) and
return the name of the nearest class that DECLARES AMethName. Used to
resolve the itab symbol for a non-virtual interface method inherited from
an ancestor: such a method has no vtable slot, so ItabMethodRef cannot
find it via the vtable and would otherwise name $<thisclass>_<method>,
which does not exist for an inherited method (issue #130 bug3). }
function ItabImplClassName(AProg: TProgram;
const AClassName, AMethName: string): string;
function IsAbstractClassMethod(ARec: TRecordTypeDesc;
const AMethName: string): Boolean;
procedure EmitFieldCleanupDefs(AProg: TProgram);
@ -7668,6 +7676,39 @@ begin
Result := '$' + ClassSymName(AClassName) + '_' + AMethName;
end;
function TCodeGenQBE.ItabImplClassName(AProg: TProgram;
const AClassName, AMethName: string): string;
var
CurName: string;
I: Integer;
TD: TTypeDecl;
CD: TClassTypeDef;
Found: Boolean;
begin
{ Walk the class chain by name. Return the nearest class (self first) that
declares AMethName; fall back to AClassName if not found anywhere. }
Result := AClassName;
CurName := AClassName;
while CurName <> '' do
begin
CD := nil;
for I := 0 to AProg.Block.TypeDecls.Count - 1 do
begin
TD := TTypeDecl(AProg.Block.TypeDecls.Items[I]);
if SameText(TD.Name, CurName) and (TD.Def is TClassTypeDef) then
begin
CD := TClassTypeDef(TD.Def);
break;
end;
end;
if CD = nil then Exit; { ancestor not in this compilation unit's decls }
Found := Self.FindMethodInClassDef(CD, AMethName) <> nil;
if Found then
Exit(CurName);
CurName := CD.ParentName;
end;
end;
procedure TCodeGenQBE.EmitInterfaceDefs(AProg: TProgram);
{ Emit typeinfo blocks for interfaces and itab/impllist blocks for class-interface pairs.
Interface typeinfo: data $typeinfo_IFoo = ( l 0 ) -- address IS the identity token
@ -7772,8 +7813,11 @@ begin
overrides ($TLoud_Greet for an override, $TPerson_Greet for a
method inherited unchanged), so use it rather than blindly naming
$<thisclass>_<method> which would not exist for inherited methods
(issue #130 bug3). }
MethRef := ItabMethodRef(ClassRT, TD.Name, MethName);
(issue #130 bug3). A non-virtual interface method has no vtable
slot, so resolve its declaring class by name-walking the AST chain
and name $<declaringclass>_<method>. }
MethRef := ItabMethodRef(ClassRT,
ItabImplClassName(AProg, TD.Name, MethName), MethName);
if K = 0 then
ItabLine := ItabLine + ' l ' + MethRef
else

32
compiler/src/test/pascal/cp.test.e2e.interfaces.pas
View file

@ -48,6 +48,7 @@ type
(issue #130 bug3). }
procedure TestRun_InheritedInterface_DescendantToVar;
procedure TestRun_InheritedInterface_OverrideAndInheritedMethod;
procedure TestRun_InheritedInterface_NonVirtualMethod;
end;
implementation
@ -374,6 +375,37 @@ begin
'hi / person' + LE + 'HI / person' + LE + 'HI!!! / person' + LE, 0);
end;
procedure TE2EInterfaceTests.TestRun_InheritedInterface_NonVirtualMethod;
const
{ Regression (issue #130 bug3): a NON-virtual interface method inherited by a
descendant. A non-virtual method gets no vtable slot, so the itab method ref
cannot be resolved via the vtable; the descendant's itab used to name
$TDerived_Hello (which does not exist) instead of the declaring ancestor's
$TBase_Hello, causing an "undefined symbol"/link error. The earlier
inherited-interface tests only exercised VIRTUAL methods, which DO have
vtable slots, so this path went uncovered. Both backends must now link+run. }
Src = '''
program P;
type
IBase = interface procedure Hello; end;
TBase = class(IBase) procedure Hello; end;
TDerived = class(TBase) end;
procedure TBase.Hello; begin WriteLn('hello') end;
procedure Use(g: IBase); begin g.Hello() end;
var d: TDerived; i: IBase;
begin
d := TDerived.Create;
i := d; // assignment to interface
i.Hello();
Use(d); // parameter passing
d.Free
end.
''';
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertRunsOnAll(Src, 'hello' + LE + 'hello' + LE, 0);
end;
initialization
RegisterTest(TE2EInterfaceTests);