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

fix(codegen): chained l-value base through a qualified static var

Browse source 
'TFoo.X.Field := V' and 'TFoo.X.Method()' failed semantic analysis with
"Field access requires a record or class base, got 'class of TFoo'".
The read form (TFoo.X.Field as an expression) already worked.

When a qualified static var is the base of a further chain on an l-value,
the parser shapes it as a Base-form field access whose base is the bare
class-name ident resolving to the 'class of TFoo' metaclass, rather than
the simple RecordName form. AnalyseFieldAccess's chained-base path
rejected a metaclass base outright.

Semantic: in the chained-base path, when the base type is a metaclass,
resolve the field as a static var (IsClassVarRead) or static property
(IsStaticPropGet) of the metaclass's base class, mirroring the RecordName
static-member read path, so the result type feeds the outer chain.

QBE codegen: EmitInstancePtr loads the instance pointer from the static
var's global slot for an IsClassVarRead base, and the field-access reader
checks IsClassVarRead before the chained-base branch so a Base-form static
var is loaded directly rather than treated as a chained field of the
metaclass. The native backend already produced correct code.

Tests cover the read, a scalar field write, and a method call through the
chained static-var base on both backends.
This commit is contained in:
Graeme Geldenhuys 2026-06-29 01:13:00 +01:00
parent e950814a34
commit 8d1cdc8f61
4 changed files with 149 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -4941,6 +4941,18 @@ begin
begin
Exit(EmitExpr(Fld));
end;
{ Qualified static-var read used as an instance pointer (TFoo.GObj.Field /
TFoo.GObj.Method()): the class-typed static var's global slot holds the
instance pointer — load it directly. Static getter (IsStaticPropGet)
results are full expressions, so EmitExpr handles those. }
if Fld.IsClassVarRead then
begin
Loaded := AllocTemp();
EmitLine(Format(' %s =l loadl $%s', [Loaded, Fld.ClassVarEmitName]));
Exit(Loaded);
end;
if Fld.IsStaticPropGet then
Exit(EmitExpr(Fld));
if Fld.Base <> nil then
Base := EmitInstancePtr(Fld.Base)
else if Fld.IsImplicitSelf then
@ -11962,6 +11974,21 @@ begin
Exit(T);
end;
{ Static var read: TypeName.StaticVar — a plain global load of the mangled
label. Checked BEFORE the chained-access branch: a qualified static var
shaped by the parser as a Base-form access (Base is the bare class-name
ident) still has IsClassVarRead set and must NOT be treated as a chained
field of the metaclass. }
if FldAccess.IsClassVarRead then
begin
QType := QbeTypeOf(FldAccess.ResolvedType);
LoadInstr := LoadInstrFor(FldAccess.ResolvedType);
T := AllocTemp();
EmitLine(Format(' %s =%s %s $%s',
[T, QType, LoadInstr, FldAccess.ClassVarEmitName]));
Exit(T);
end;
{ Chained access: compute base storage pointer, then load the field from
(base_ptr + offset) using the field's QBE type. }
if FldAccess.Base <> nil then

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

@ -11340,6 +11340,53 @@ begin
if AAccess.Base <> nil then
begin
BaseType := AnalyseExpr(AAccess.Base);
{ Metaclass base: 'TypeName.StaticVar' or 'TypeName.StaticProp' arriving as
a chained access (Base is the bare class-name ident resolving to
'class of TypeName') rather than the simple RecordName form. This is how
the parser shapes a qualified static-var/property used as the BASE of a
further chain on an l-value, e.g. 'TFoo.GObj.V := x' or 'TFoo.GObj.M()'.
Resolve it exactly like the RecordName static-var/static-prop read below,
so the result type feeds the outer chain. }
if BaseType.Kind = tyMetaClass then
begin
RT := TRecordTypeDesc(TMetaClassTypeDesc(BaseType).BaseClass);
Sym := FTable.Lookup(RT.Name + '.' + AAccess.FieldName);
if (Sym <> nil) and (Sym.Kind = skVariable) and Sym.IsClassVar then
begin
AssertStaticVarVisible(Sym.Visibility, Sym.OwningUnit,
Sym.OwnerTypeName, AAccess.FieldName,
AAccess.Line, AAccess.Col);
AAccess.IsClassVarRead := True;
AAccess.IsGlobal := True;
AAccess.ClassVarEmitName := Sym.GlobalEmitName;
AAccess.ResolvedType := Sym.TypeDesc;
Exit(Sym.TypeDesc);
end;
PropInfo := RT.FindProperty(AAccess.FieldName);
if (PropInfo <> nil) and PropInfo.IsStatic then
begin
if PropInfo.ReadMethod = '' then
SemanticError(
Format('Static property ''%s.%s'' has no readable static getter',
[RT.Name, AAccess.FieldName]),
AAccess.Line, AAccess.Col);
MDecl := FindMethodDecl(RT.Name, PropInfo.ReadMethod);
if (MDecl = nil) or not MDecl.IsStatic then
SemanticError(
Format('Static property ''%s.%s'' getter ''%s'' is not a static method',
[RT.Name, AAccess.FieldName, PropInfo.ReadMethod]),
AAccess.Line, AAccess.Col);
AAccess.IsStaticPropGet := True;
AAccess.ResolvedMethod := MDecl;
AAccess.ResolvedClassType := BaseType;
AAccess.ResolvedType := MDecl.ResolvedReturnType;
Exit(MDecl.ResolvedReturnType);
end;
SemanticError(
Format('Unknown static member ''%s'' on type ''%s''',
[AAccess.FieldName, RT.Name]),
AAccess.Line, AAccess.Col);
end;
if not (BaseType.Kind in [tyRecord, tyClass]) then
SemanticError(
Format('Field access ''.%s'' requires a record or class base, got ''%s''',

42
compiler/src/test/pascal/cp.test.e2e.staticmembers.pas
View file

@ -32,6 +32,7 @@ type
procedure TestRun_StaticVar_QualifiedWrite_Scalar;
procedure TestRun_StaticVar_QualifiedWrite_ClassARC;
procedure TestRun_StaticVar_InterfaceStore;
procedure TestRun_StaticVar_ChainedLValueBase;
procedure TestRun_StaticProperty_QualifiedRead;
procedure TestRun_Singleton_LazyGetInstance;
procedure TestRun_StaticConst_OnClass;
@ -222,6 +223,47 @@ begin
AssertRunsOnAll(Src, 'thing 7' + LineEnding, 0);
end;
procedure TE2EStaticMembersTests.TestRun_StaticVar_ChainedLValueBase;
{ A qualified static var of class type used as the BASE of a further l-value
chain: 'TFoo.GObj.Field := V' (field write through the chained base) and
'TFoo.GObj.Method()' (method call on the chained base). The read form
(TFoo.GObj.Field as an expression) already worked; the write/call receiver
path through the chained base was unresolved ("Field access requires a record
or class base, got 'class of TFoo'"). }
const Src =
'''
program P;
type
TObj = class
public
V: Integer;
procedure Bump;
end;
THolder = class
public static var
GObj: TObj;
end;
procedure TObj.Bump;
begin
V := V + 1;
end;
begin
THolder.GObj := TObj.Create();
WriteLn(THolder.GObj.V);
THolder.GObj.V := 5;
WriteLn(THolder.GObj.V);
THolder.GObj.Bump();
WriteLn(THolder.GObj.V);
THolder.GObj := nil
end.
''';
var LE: string;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit end;
LE := LineEnding;
AssertRunsOnAll(Src, '0' + LE + '5' + LE + '6' + LE, 0);
end;
procedure TE2EStaticMembersTests.TestRun_StaticProperty_QualifiedRead;
const Src =
'''

33
compiler/src/test/pascal/cp.test.staticmembers.pas
View file

@ -588,6 +588,7 @@ type
procedure TestIR_StaticProperty_QualifiedRead_CallsGetter;
procedure TestIR_ClassStaticVar_ReleasedAtExit;
procedure TestIR_StaticCall_InterfaceArg_NoLeadingComma;
procedure TestIR_StaticVar_ChainedLValueBase_LoadsGlobal;
end;
function TStaticMembersSemTests.AnalyseSrc(const ASrc: string): TProgram;
@ -1041,6 +1042,38 @@ begin
Pos('call $THolder_SetIt(l ', IR) >= 0);
end;
procedure TStaticMembersSemTests.TestIR_StaticVar_ChainedLValueBase_LoadsGlobal;
{ A qualified static var of class type used as the base of a further l-value
chain (THolder.GObj.V := 5) must resolve and lower: the base instance pointer
is loaded from the static var's mangled global slot. Without the fix the
semantic pass rejected the write with "requires a record or class base, got
'class of THolder'". }
const
Src =
'''
program P;
type
TObj = class
public
V: Integer;
end;
THolder = class
public static var
GObj: TObj;
end;
begin
THolder.GObj := TObj.Create();
THolder.GObj.V := 5;
end.
''';
var IR: string;
begin
IR := GenIR(Src);
{ The chained write loads the base instance pointer from the static var slot. }
AssertTrue('chained l-value base loads static var global',
Pos('loadl $THolder_GObj', IR) >= 0);
end;
initialization
RegisterTest(TStaticMembersParseTests);
RegisterTest(TStaticMembersSemTests);