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

feat(lang): static class/record members (within-unit)

Browse source 
Introduce `static` (class-level) members to the Blaise language using the
`static` keyword — never an overloaded `class` keyword. A `static` member is
type-associated, not instance-associated: static methods take no implicit
Self, and static vars/consts are a single shared storage slot.

Surface, on classes and records:

* `static var` / `static const` — section form (`private static var`) or as a
  bare `static` continuing the current visibility. Static vars lower to one
  shared global slot (mangled `<Unit><Type>_<Name>`), zero-initialised, NOT an
  instance field. Class- and interface-typed static vars are supported (the
  canonical singleton storage) with store-time ARC and a program-exit release;
  string and dynamic-array static vars remain deferred.
* `static function` / `static procedure` — per-member prefix or section form;
  no implicit Self. Out-of-line bodies are `static function T.M`.
* `static property` — sugar over a static getter (no Self at the call site).
* record `static function` — the factory / namespaced-function form
  (`TPoint.Make(x, y): TPoint`), required to be marked `static` explicitly.

There is no `static constructor` / `static destructor` (rejected at parse):
the zero-initialisation guarantee covers nil singletons, and eager setup
belongs in a unit's `initialization`/`finalization` (the Swift/Rust/Go model,
not Java/C#/Delphi). `class` is never a member qualifier.

Implementation spans the full pipeline:

* parser — `static` is a soft keyword; section qualifier (followed by
  var/const) and per-member prefix forms; `static constructor/destructor`
  rejected.
* semantic — static vars register a shared global (bare + qualified) under a
  mangled emit label; static methods skip the Self binding; qualified
  `Type.StaticVar` / `Type.StaticProp` / `Type.StaticMethod()` resolution.
* QBE + native x86-64 codegen — no-Self method signatures and call sites
  (including the record-return sret and >6-arg paths), shared global data
  slots, qualified static var/property reads, and class/interface static-var
  release at program exit.
* `.bif` interface format — IsClassVar/ClassVarEmitName, property IsStatic, and
  record/class const decls are encoded (BLAISE-IFACE version 2 -> 3).
* OPDF debug info — static vars are emitted as `recGlobalVar`s under their
  mangled label so a debugger can print `TFoo.FInstance`.

Static members currently work within a single program/unit; carrying them
across separately-compiled units (export clone, import, TRoutineSig.IsStatic)
is a tracked follow-up — the .bif wire format is already in place for it.

Tests: cp.test.staticmembers (parser + semantic + IR) and
cp.test.e2e.staticmembers (compile+run on both backends). Full suite green on
QBE- and native-built runners (3908 tests); all fixpoints pass; bif-coverage
clean. docs/grammar.ebnf and docs/language-rationale.adoc updated.
This commit is contained in:
Graeme Geldenhuys 2026-06-28 16:11:40 +01:00
parent 50b8d75e6d
commit 0977dc16cb
16 changed files with 2556 additions and 122 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -196,6 +196,7 @@ type
registration's type wins). The width and signedness drive both the
.data directive and every load/store of the slot. }
procedure AddGlobal(const AName: string; AType: TTypeDesc);
procedure RegisterClassVars(AFields: TObjectList);
procedure MarkThreadVar(const AName: string);
procedure MarkWeakGlobal(const AName: string);
function IsThreadVarGlobal(const AName: string): Boolean;
@ -1005,6 +1006,26 @@ begin
FDataGlobals.Add(AName, AType);
end;
{ Register a shared data global for every STATIC (class-level) variable in a
class/record field list, under the mangled ClassVarEmitName stamped by the
semantic pass. EmitDataSection then emits a correctly-sized zero slot. This
covers read-only static vars that no assignment site auto-registers. }
procedure TX86_64Backend.RegisterClassVars(AFields: TObjectList);
var
I: Integer;
FDecl: TFieldDecl;
begin
if AFields = nil then Exit;
for I := 0 to AFields.Count - 1 do
begin
FDecl := TFieldDecl(AFields.Items[I]);
if not FDecl.IsClassVar then Continue;
if FDecl.ClassVarEmitName = '' then Continue;
if FDecl.ResolvedType = nil then Continue;
Self.AddGlobal(FDecl.ClassVarEmitName, FDecl.ResolvedType);
end;
end;
procedure TX86_64Backend.MarkThreadVar(const AName: string);
begin
if not FThreadVarGlobals.ContainsKey(AName) then
@ -1575,6 +1596,19 @@ begin
end;
end;
end;
{ Static (class-level) variables: register one shared global per IsClassVar
field so EmitDataSection emits a zero-initialised slot under the mangled
label (ClassVarEmitName). Done for BOTH class and record types, and
independently of any assignment (a read-only static var has no assignment to
auto-register it via AddGlobal at the write site). }
for I := 0 to ABlock.TypeDecls.Count - 1 do
begin
TD := TTypeDecl(ABlock.TypeDecls.Items[I]);
if TD.Def is TClassTypeDef then
RegisterClassVars(TClassTypeDef(TD.Def).Fields)
else if TD.Def is TRecordTypeDef then
RegisterClassVars(TRecordTypeDef(TD.Def).Fields);
end;
for I := 0 to ABlock.TypeDecls.Count - 1 do
begin
TD := TTypeDecl(ABlock.TypeDecls.Items[I]);
@ -3979,8 +4013,11 @@ begin
Self.AddSlot('_cap_' + ADecl.CapturedVars.Strings[I], nil, Offset);
{ For class methods, Self is the implicit first integer param (%rdi).
Allocate a pointer-size slot for it; normal params start at IntIdx=1. }
if ADecl.OwnerTypeName <> '' then
Allocate a pointer-size slot for it; normal params start at IntIdx=1.
A `static` method takes NO implicit Self (like a class function/Java
static), so no Self slot is reserved and the first user param occupies
%rdi directly. }
if (ADecl.OwnerTypeName <> '') and not ADecl.IsStatic then
Self.AddSlot('Self', nil, Offset); { nil = pointer size (8 bytes) }
{ Params: first 6 integer register slots are register-passed (spilled to
@ -4000,8 +4037,8 @@ begin
Inc(IntIdx2, ADecl.CapturedVars.Count);
if FSretFunc then
Inc(IntIdx2); { sret buffer pointer in %rdi }
if (ADecl.OwnerTypeName <> '') then
Inc(IntIdx2); { Self in the next integer register }
if (ADecl.OwnerTypeName <> '') and not ADecl.IsStatic then
Inc(IntIdx2); { Self in the next integer register (static methods have none) }
for I := 0 to ADecl.Params.Count - 1 do
begin
P := TMethodParam(ADecl.Params.Items[I]);
@ -7168,6 +7205,32 @@ begin
Exit;
end;
{ Static var read: TypeName.StaticVar — a plain global load of the mangled
label resolved by the semantic pass (no Self, no instance). }
if (AExpr is TFieldAccessExpr) and TFieldAccessExpr(AExpr).IsClassVarRead then
begin
FAE := TFieldAccessExpr(AExpr);
Self.Emit(Format(#9'movq %s(%%rip), %%rax',
[NativeMangle(FAE.ClassVarEmitName)]));
if (FAE.ResolvedType <> nil) and IsIntFamily(FAE.ResolvedType) then
Self.EmitNarrowToType(FAE.ResolvedType);
Exit;
end;
{ Static property read: TypeName.StaticProp — call the static getter (no Self
argument); result in %rax. }
if (AExpr is TFieldAccessExpr) and TFieldAccessExpr(AExpr).IsStaticPropGet then
begin
FAE := TFieldAccessExpr(AExpr);
MD := TMethodDecl(FAE.ResolvedMethod);
Self.Emit(#9'callq ' +
MethodEmitNameNative(MD,
TRecordTypeDesc(FAE.ResolvedClassType).Name, MD.Name));
if (FAE.ResolvedType <> nil) and IsIntFamily(FAE.ResolvedType) then
Self.EmitNarrowToType(FAE.ResolvedType);
Exit;
end;
if (AExpr is TFieldAccessExpr) and
TFieldAccessExpr(AExpr).IsInterfaceCall then
begin
@ -8281,6 +8344,20 @@ begin
'native backend: TMethodCallExpr has no ResolvedMethod (' + ACall.Name + ')');
Sym := MethodEmitNameNative(MD, MD.OwnerTypeName, ACall.Name);
{ Static method call (TypeName.StaticMethod(args)): NO implicit Self — the
callee shifts every parameter down one register (first user arg in %rdi).
A value-returning static method is exactly a plain function call to the
method's mangled symbol, so route it through EmitCall, which marshals args
into %rdi.. with no receiver. Record-returning static factories use the
sret ABI and are handled in EmitMethodSretCall. }
if ACall.IsStaticCall then
begin
Sym := MethodEmitNameNative(MD,
TRecordTypeDesc(ACall.ResolvedClassType).Name, ACall.Name);
Self.EmitCall(Sym, MD, ACall.Args);
Exit;
end;
UserSlots := Self.CountArgSlots(MD.Params);
TotalSlots := UserSlots + 1;
@ -9314,6 +9391,37 @@ begin
'native backend: TMethodCallStmt has no ResolvedMethod (' + ACall.Name + ')');
Sym := MethodEmitNameNative(MD, MD.OwnerTypeName, ACall.Name);
{ Static method call in statement position (TypeName.StaticMethod(args), result
discarded): NO implicit Self. A void/scalar-returning static method is a
plain function call (EmitCall marshals args into %rdi.., result ignored). A
record-returning static factory whose result is discarded needs a throwaway
sret buffer, dispatched via EmitSretCall, with its managed fields released. }
if ACall.IsStaticCall then
begin
Sym := MethodEmitNameNative(MD,
TRecordTypeDesc(ACall.ResolvedClassType).Name, ACall.Name);
if (ACall.ResolvedReturnTypeDesc <> nil) and
(ACall.ResolvedReturnTypeDesc.Kind = tyRecord) then
begin
SretRT := TRecordTypeDesc(ACall.ResolvedReturnTypeDesc);
SretBufSize := (SretRT.TotalSize() + 15) and (-16);
Self.Emit(#9'pushq %rbx');
Self.Emit(Format(#9'subq $%d, %%rsp', [SretBufSize]));
Self.Emit(#9'movq %rsp, %rbx');
Self.EmitSretCall(Sym, MD, ACall.Args, '(%rbx)', False);
{ EmitSretCall may have clobbered %rbx during arg evaluation; %rsp still
points at the buffer, so re-derive its address before releasing. }
Self.Emit(#9'movq %rsp, %rbx');
if not Self.IsRecordManagedClean(SretRT) then
Self.EmitRecordFieldReleases(SretRT, '%rbx');
Self.Emit(Format(#9'addq $%d, %%rsp', [SretBufSize]));
Self.Emit(#9'popq %rbx');
end
else
Self.EmitCall(Sym, MD, ACall.Args);
Exit;
end;
IsSretDiscard := (ACall.ResolvedReturnTypeDesc <> nil) and
(ACall.ResolvedReturnTypeDesc.Kind = tyRecord) and
(ClassifyRecordReturn(TRecordTypeDesc(ACall.ResolvedReturnTypeDesc)) = rcSret);
@ -15235,6 +15343,19 @@ begin
'native backend: method-sret call has no ResolvedMethod (' + ACall.Name + ')');
Sym := MethodEmitNameNative(MD, MD.OwnerTypeName, ACall.Name);
{ Record-returning static factory (TypeName.Make(args): TRec): NO implicit
Self, so it follows the plain record-return ABI exactly — sret buffer in
%rdi, user args in %rsi.. — which is what EmitSretCall (the free-function
record-return emitter) already produces. Delegate to it with the method's
mangled symbol; the Self-threading code below is for instance methods only. }
if ACall.IsStaticCall then
begin
Sym := MethodEmitNameNative(MD,
TRecordTypeDesc(ACall.ResolvedClassType).Name, ACall.Name);
Self.EmitSretCall(Sym, MD, ACall.Args, ASretAddr, ASretIsIndirect);
Exit;
end;
{ Record-returning-call receiver (e.g. A.Plus(B).Scale(2), where the OUTER
method Scale itself returns a record via sret): materialise the inner call
result into a stack buffer up front and carry its address in callee-saved
@ -16531,9 +16652,11 @@ begin
Self.Emit(Format(#9'movq %%rdi, %s', [Self.VarOperand('Result')]));
IntIdx := 1;
end;
if ADecl.OwnerTypeName <> '' then
if (ADecl.OwnerTypeName <> '') and not ADecl.IsStatic then
begin
{ Class method: spill Self from the first int arg register into its slot. }
{ Class method: spill Self from the first int arg register into its slot.
A `static` method has NO implicit Self — its first user parameter is the
first integer arg (%rdi), so no Self spill and IntIdx stays put. }
Self.Emit(Format(#9'movq %s, %s',
[SysVArg64(IntIdx), Self.VarOperand('Self')]));
Inc(IntIdx);

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

@ -259,6 +259,7 @@ type
function ConstElemQbeDataType(const AElemType: string): string;
procedure EmitArrayConstData(CD: TConstDecl; const APrefix: string);
procedure EmitClassConstData(AClassDef: TClassTypeDef; const AClassName: string);
procedure EmitClassVarData(AFields: TObjectList; const AClassName: string);
procedure EmitGlobalConstData(ABlock: TBlock);
procedure EmitLocalArrayConstsInBlock(ABlock: TBlock);
procedure EmitLocalArrayConstsInTypeDecls(ABlock: TBlock);
@ -266,6 +267,7 @@ type
procedure EmitLocalArrayConstsInUnit(AUnit: TUnit);
procedure EmitParamAllocs(AMethod: TMethodDecl; AClassType: TRecordTypeDesc);
procedure EmitArcCleanup(ABlock: TBlock);
procedure EmitStaticVarReleases(ABlock: TBlock);
procedure EmitExcPathArcCleanup(ABlock: TBlock);
procedure EmitExcUnwind(ATargetDepth: Integer);
procedure EmitStmt(AStmt: TASTStmt);
@ -2254,6 +2256,74 @@ begin
EmitArrayConstData(TConstDecl(AClassDef.ConstDecls.Items[I]), AClassName);
end;
{ Emit one shared global data slot per STATIC (class-level) variable. The label
must match the semantic pass's GlobalEmitName: ClassUnitPrefix(Class)+Class+'_'+
Field. Static vars are never instance fields, so they appear here, not in the
record's field layout. v1 supports only unmanaged element types (the semantic
pass rejects managed ones), so no ARC init/cleanup is needed. }
procedure TCodeGenQBE.EmitClassVarData(AFields: TObjectList; const AClassName: string);
var
I, J: Integer;
FDecl: TFieldDecl;
T: TTypeDesc;
Nm: string;
Pfx: string;
begin
if AFields = nil then Exit;
Pfx := 'export data';
for I := 0 to AFields.Count - 1 do
begin
FDecl := TFieldDecl(AFields.Items[I]);
if not FDecl.IsClassVar then Continue;
T := FDecl.ResolvedType;
if T = nil then Continue;
for J := 0 to FDecl.Names.Count - 1 do
begin
if (FDecl.ClassVarEmitName <> '') and (FDecl.Names.Count = 1) then
Nm := FDecl.ClassVarEmitName
else
Nm := ClassUnitPrefix(AClassName) + AClassName + '_' + FDecl.Names.Strings[J];
case T.Kind of
tyInteger, tyUInt32, tyBoolean, tyByte, tyEnum:
EmitLine(Format('%s $%s = { w 0 }', [Pfx, Nm]));
tySmallInt, tyWord:
EmitLine(Format('%s $%s = { h 0 }', [Pfx, Nm]));
tyInt64, tyUInt64, tyPointer, tyPChar:
EmitLine(Format('%s $%s = { l 0 }', [Pfx, Nm]));
tyDouble:
EmitLine(Format('%s $%s = { d 0 }', [Pfx, Nm]));
tySingle:
EmitLine(Format('%s $%s = { s 0 }', [Pfx, Nm]));
tySet:
if TSetTypeDesc(T).BitCount <= 32 then
EmitLine(Format('%s $%s = { w 0 }', [Pfx, Nm]))
else if TSetTypeDesc(T).BitCount <= 64 then
EmitLine(Format('%s $%s = { l 0 }', [Pfx, Nm]))
else
EmitLine(Format('%s $%s = { z %d }', [Pfx, Nm, TSetTypeDesc(T).RawSize()]));
tyRecord:
if TRecordTypeDesc(T).TotalSize() > 0 then
EmitLine(Format('%s $%s = { z %d }', [Pfx, Nm, TRecordTypeDesc(T).TotalSize()]))
else
EmitLine(Format('%s $%s = { l 0 }', [Pfx, Nm]));
tyStaticArray:
if TStaticArrayTypeDesc(T).ByteSize() > 0 then
EmitLine(Format('%s $%s = { z %d }', [Pfx, Nm, TStaticArrayTypeDesc(T).ByteSize()]))
else
EmitLine(Format('%s $%s = { l 0 }', [Pfx, Nm]));
tyInterface:
{ Contiguous 16-byte fat pointer (obj at +0, itab at +8) under the
'_obj' suffix, matching program-global interface vars so itab
accesses ($Name_obj + 8) stay adjacent. }
EmitLine(Format('%s $%s_obj = { l 0, l 0 }', [Pfx, Nm]));
else
{ tyClass and every other pointer-sized kind: a single nil slot. }
EmitLine(Format('%s $%s = { l 0 }', [Pfx, Nm]));
end;
end;
end;
end;
procedure TCodeGenQBE.EmitGlobalConstData(ABlock: TBlock);
{ Emit QBE data-section entries for array-typed constants.
Each array const is emitted as a labelled data object whose elements are
@ -2270,7 +2340,12 @@ begin
begin
TD := TTypeDecl(ABlock.TypeDecls.Items[I]);
if TD.Def is TClassTypeDef then
begin
EmitClassConstData(TClassTypeDef(TD.Def), TD.Name);
EmitClassVarData(TClassTypeDef(TD.Def).Fields, TD.Name);
end
else if TD.Def is TRecordTypeDef then
EmitClassVarData(TRecordTypeDef(TD.Def).Fields, TD.Name);
end;
end;
@ -2441,6 +2516,57 @@ begin
end;
end;
procedure TCodeGenQBE.EmitStaticVarReleases(ABlock: TBlock);
{ Release class- and interface-typed static (class-level) variables at program
exit. A static var is a single shared global pointer slot (the mangled
ClassVarEmitName), zero-initialised to nil; the slot holds at most one
retained reference, so one balancing release at teardown is correct. Value
static vars (Integer, record, …) and the still-deferred string/dynarray kinds
emit nothing here. Mirrors EmitArcCleanup, but sourced from the type decls'
IsClassVar fields rather than the block's var decls. }
var
I, K, N: Integer;
TD: TTypeDecl;
Flds: TObjectList;
FDecl: TFieldDecl;
T: TTypeDesc;
Nm: string;
ValTemp: string;
begin
if ABlock = nil then Exit;
for I := 0 to ABlock.TypeDecls.Count - 1 do
begin
TD := TTypeDecl(ABlock.TypeDecls.Items[I]);
Flds := nil;
if TD.Def is TClassTypeDef then
Flds := TClassTypeDef(TD.Def).Fields
else if TD.Def is TRecordTypeDef then
Flds := TRecordTypeDef(TD.Def).Fields;
if Flds = nil then Continue;
for K := 0 to Flds.Count - 1 do
begin
FDecl := TFieldDecl(Flds.Items[K]);
if not FDecl.IsClassVar then Continue;
T := FDecl.ResolvedType;
if T = nil then Continue;
if not (T.Kind in [tyClass, tyInterface]) then Continue;
for N := 0 to FDecl.Names.Count - 1 do
begin
if (FDecl.ClassVarEmitName <> '') and (FDecl.Names.Count = 1) then
Nm := FDecl.ClassVarEmitName
else
Nm := ClassUnitPrefix(TD.Name) + TD.Name + '_' + FDecl.Names.Strings[N];
ValTemp := AllocTemp();
if T.Kind = tyInterface then
EmitLine(Format(' %s =l loadl $%s_obj', [ValTemp, Nm]))
else
EmitLine(Format(' %s =l loadl $%s', [ValTemp, Nm]));
EmitLine(Format(' call $_ClassRelease(l %s)', [ValTemp]));
end;
end;
end;
end;
procedure TCodeGenQBE.EmitBlock(ABlock: TBlock);
var
I: Integer;
@ -2457,6 +2583,12 @@ begin
EmitLine('@' + FExitLabel);
end;
EmitArcCleanup(ABlock);
{ Program exit: release class/interface-typed static (class-level) variables.
They are shared globals not present in ABlock.Decls, so EmitArcCleanup does
not cover them. Only the program's top block carries the 'main_exit' label,
so this fires exactly once, at process teardown. }
if FExitLabel = 'main_exit' then
EmitStaticVarReleases(ABlock);
end;
procedure TCodeGenQBE.EmitExcPathArcCleanup(ABlock: TBlock);
@ -5753,6 +5885,47 @@ begin
end;
MDecl := TMethodDecl(MCallExpr.ResolvedMethod);
RetType := TRecordTypeDesc(MDecl.ResolvedReturnType);
{ Static (class-level) record-returning function: TypeName.Make(args).
No Self — the visible args begin with the first user parameter. (A record
factory is the canonical case; the user opted records into requiring an
explicit `static` marker for factory methods.) }
if MCallExpr.IsStaticCall then
begin
FuncName := '$' + MethodEmitName(MDecl,
TRecordTypeDesc(MCallExpr.ResolvedClassType).Name, MCallExpr.Name);
VisArgs := '';
for I := 0 to MCallExpr.Args.Count - 1 do
begin
Par := TMethodParam(MDecl.Params.Items[I]);
if Par.IsVarParam then
begin
if VisArgs <> '' then VisArgs := VisArgs + ', ';
VisArgs := VisArgs + Format('l %s',
[EmitLValueAddr(TASTExpr(MCallExpr.Args.Items[I]))]);
end
else if (Par.ResolvedType <> nil) and (Par.ResolvedType.Kind = tyInterface) then
begin
if VisArgs = '' then
VisArgs := Copy(InterfaceArgFragment(TASTExpr(MCallExpr.Args.Items[I]),
Par.ResolvedType), 2, MaxInt)
else
VisArgs := VisArgs + InterfaceArgFragment(TASTExpr(MCallExpr.Args.Items[I]),
Par.ResolvedType);
end
else
begin
ArgTemp := EmitExpr(TASTExpr(MCallExpr.Args.Items[I]));
ArgTemp := CoerceArg(ArgTemp, TASTExpr(MCallExpr.Args.Items[I]),
QbeTypeOf(Par.ResolvedType));
if VisArgs <> '' then VisArgs := VisArgs + ', ';
VisArgs := VisArgs + Format('%s %s',
[QbeParamTypeOf(Par.ResolvedType), ArgTemp]);
end;
end;
EmitRecordReturnCallSite(FuncName, VisArgs, RetType, ASretAddr);
FlushPendingReleases(PMark);
Exit;
end;
if MCallExpr.ObjExpr <> nil then
SelfTemp := EmitExpr(MCallExpr.ObjExpr)
else if MDecl.IsRecordMethod and MCallExpr.IsVarParam then
@ -6633,6 +6806,55 @@ begin
Exit;
end;
{ Static (class-level) method call in statement position: TypeName.M(args).
No Self; a plain call to the mangled method symbol. }
if ACall.IsStaticCall and (ACall.ResolvedMethod <> nil) then
begin
RT := TRecordTypeDesc(ACall.ResolvedClassType);
MDecl := TMethodDecl(ACall.ResolvedMethod);
ArgLine := '';
ArgTemps := TStringList.Create();
try
for I := 0 to ACall.Args.Count - 1 do
begin
Par := TMethodParam(MDecl.Params.Items[I]);
if ArgLine <> '' then ArgLine := ArgLine + ', ';
if Par.IsOpenArray then
begin
ArgTemps.Add('');
ArgLine := ArgLine + OpenArrayArgFragment(TASTExpr(ACall.Args.Items[I]));
end
else if Par.IsVarParam then
begin
ArgTemps.Add('');
ArgLine := ArgLine + Format('l %s',
[EmitLValueAddr(TASTExpr(ACall.Args.Items[I]))]);
end
else if (Par.ResolvedType <> nil) and (Par.ResolvedType.Kind = tyInterface) then
begin
ArgTemps.Add('');
ArgLine := ArgLine +
InterfaceArgFragment(TASTExpr(ACall.Args.Items[I]), Par.ResolvedType);
end
else
begin
ArgTemp := EmitExpr(TASTExpr(ACall.Args.Items[I]));
ArgTemps.Add(ArgTemp);
ArgLine := ArgLine + Format('%s %s',
[QbeParamTypeOf(Par.ResolvedType), ArgTemp]);
end;
end;
FuncName := '$' + MethodEmitName(MDecl, RT.Name, ACall.Name);
EmitLine(Format(' call %s(%s)', [FuncName, ArgLine]));
EmitOwnedArgReleases(ACall.Args, ArgTemps, MDecl.Params);
ReleaseConstStringArgs(ACall.Args, ArgTemps, MDecl.Params);
finally
ArgTemps.Free();
end;
FlushPendingReleases(PMark);
Exit;
end;
{ Interface method dispatch: load obj + itab, index by method slot }
if (ACall.ResolvedClassType <> nil) and
(ACall.ResolvedClassType.Kind = tyInterface) then
@ -7337,9 +7559,13 @@ var
I: Integer;
Par: TMethodParam;
begin
{ Self: store incoming pointer into a local slot }
EmitLine(' %_var_Self =l alloc8 1');
EmitLine(' storel %_par_Self, %_var_Self');
{ Self: store incoming pointer into a local slot. A STATIC method has no
Self — skip the slot entirely. }
if not AMethod.IsStatic then
begin
EmitLine(' %_var_Self =l alloc8 1');
EmitLine(' storel %_par_Self, %_var_Self');
end;
{ Explicit params }
for I := 0 to AMethod.Params.Count - 1 do
@ -7442,6 +7668,7 @@ procedure TCodeGenQBE.EmitMethodDef(const ATypeName: string;
AMethod: TMethodDecl);
var
Sig: string;
ParSep: string;
I: Integer;
Par: TMethodParam;
FuncName: string;
@ -7463,31 +7690,52 @@ begin
if IsFunc and (AMethod.ResolvedReturnType.Kind = tyRecord) then
RC := Self.ClassifyRecordReturn(TRecordTypeDesc(AMethod.ResolvedReturnType));
Sig := 'l %_par_Self';
if IsFunc and ((AMethod.ResolvedReturnType.Kind in [tyInterface, tyStaticArray]) or
((AMethod.ResolvedReturnType.Kind = tySet) and
TSetTypeDesc(AMethod.ResolvedReturnType).IsJumbo())) then
Sig := 'l %_par__sret, l %_par_Self'
else if IsFunc and (AMethod.ResolvedReturnType.Kind = tyRecord) then
EmitRecordReturnSignature(Sig, RC);
{ A STATIC (class-level) method takes no implicit Self. Its signature starts
empty (or with just the sret pointer for aggregate returns). }
if AMethod.IsStatic then
begin
Sig := '';
if IsFunc and ((AMethod.ResolvedReturnType.Kind in [tyInterface, tyStaticArray]) or
((AMethod.ResolvedReturnType.Kind = tySet) and
TSetTypeDesc(AMethod.ResolvedReturnType).IsJumbo())) then
Sig := 'l %_par__sret'
else if IsFunc and (AMethod.ResolvedReturnType.Kind = tyRecord) then
{ Sig is '' here, so EmitRecordReturnSignature yields just the sret ptr. }
EmitRecordReturnSignature(Sig, RC);
end
else
begin
Sig := 'l %_par_Self';
if IsFunc and ((AMethod.ResolvedReturnType.Kind in [tyInterface, tyStaticArray]) or
((AMethod.ResolvedReturnType.Kind = tySet) and
TSetTypeDesc(AMethod.ResolvedReturnType).IsJumbo())) then
Sig := 'l %_par__sret, l %_par_Self'
else if IsFunc and (AMethod.ResolvedReturnType.Kind = tyRecord) then
EmitRecordReturnSignature(Sig, RC);
end;
for I := 0 to AMethod.Params.Count - 1 do
begin
Par := TMethodParam(AMethod.Params.Items[I]);
{ A static method with a scalar return has an empty Sig at this point, so
the first user parameter must NOT be prefixed with ', ' (that would emit
'function w $F(, w %x)', which QBE rejects as an invalid class specifier).
The separator is empty only when nothing precedes this parameter. }
if Sig <> '' then ParSep := ', ' else ParSep := '';
if Par.IsOpenArray then
Sig := Sig + Format(', l %%_par_%s, l %%_par_%s_high',
Sig := Sig + ParSep + Format('l %%_par_%s, l %%_par_%s_high',
[Par.ParamName, Par.ParamName])
else if Par.IsVarParam then
Sig := Sig + Format(', l %%_par_%s', [Par.ParamName])
Sig := Sig + ParSep + Format('l %%_par_%s', [Par.ParamName])
else if (Par.ResolvedType <> nil) and
(Par.ResolvedType.Kind = tyInterface) then
{ Interfaces are two-slot fat pointers (obj + itab); caller passes both,
callee allocs two local slots in EmitParamAllocs. Mirrors the
standalone-routine path so method dispatch and value-param ARC both
find %_var_<p>_obj / %_var_<p>_itab. }
Sig := Sig + Format(', l %%_par_%s_obj, l %%_par_%s_itab',
Sig := Sig + ParSep + Format('l %%_par_%s_obj, l %%_par_%s_itab',
[Par.ParamName, Par.ParamName])
else
Sig := Sig + Format(', %s %%_par_%s',
Sig := Sig + ParSep + Format('%s %%_par_%s',
[QbeParamTypeOf(Par.ResolvedType), Par.ParamName]);
end;
@ -11035,6 +11283,61 @@ begin
begin
MCallExpr := TMethodCallExpr(AExpr);
{ Static (class-level) function call in expression position:
TypeName.F(args). No Self; plain call to the mangled symbol, returning
the result. v1: scalar/pointer return only (managed/record-return static
functions can be added later via the record-return ABI path). }
if MCallExpr.IsStaticCall and (MCallExpr.ResolvedMethod <> nil) then
begin
RT := TRecordTypeDesc(MCallExpr.ResolvedClassType);
MDecl := TMethodDecl(MCallExpr.ResolvedMethod);
ArgLine := '';
ArgTemps := TStringList.Create();
try
for I := 0 to MCallExpr.Args.Count - 1 do
begin
Par := TMethodParam(MDecl.Params.Items[I]);
if ArgLine <> '' then ArgLine := ArgLine + ', ';
if Par.IsOpenArray then
begin
ArgTemps.Add('');
ArgLine := ArgLine + OpenArrayArgFragment(TASTExpr(MCallExpr.Args.Items[I]));
end
else if Par.IsVarParam then
begin
ArgTemps.Add('');
ArgLine := ArgLine + Format('l %s',
[EmitLValueAddr(TASTExpr(MCallExpr.Args.Items[I]))]);
end
else if (Par.ResolvedType <> nil) and (Par.ResolvedType.Kind = tyInterface) then
begin
ArgTemps.Add('');
ArgLine := ArgLine +
InterfaceArgFragment(TASTExpr(MCallExpr.Args.Items[I]), Par.ResolvedType);
end
else
begin
ArgTemp := EmitExpr(TASTExpr(MCallExpr.Args.Items[I]));
ArgTemps.Add(ArgTemp);
ArgLine := ArgLine + Format('%s %s',
[QbeParamTypeOf(Par.ResolvedType), ArgTemp]);
end;
end;
FuncName := '$' + MethodEmitName(MDecl, RT.Name, MCallExpr.Name);
Result := AllocTemp();
if MDecl.ResolvedReturnType <> nil then
EmitLine(Format(' %s =%s call %s(%s)',
[Result, QbeTypeOf(MDecl.ResolvedReturnType), FuncName, ArgLine]))
else
EmitLine(Format(' call %s(%s)', [FuncName, ArgLine]));
EmitOwnedArgReleases(MCallExpr.Args, ArgTemps, MDecl.Params);
ReleaseConstStringArgs(MCallExpr.Args, ArgTemps, MDecl.Params);
finally
ArgTemps.Free();
end;
Exit(Result);
end;
{ Procedure-type field call expression: load (Code, Data) pair and
dispatch indirectly. Only applies to function-of-object fields that
return a value (otherwise they go through TMethodCallStmt). }
@ -11803,6 +12106,30 @@ begin
EmitLine(Format(' call $_ClassRelease(l %s)', [BaseReleaseTemp]));
Exit(T);
end;
{ Static var read: TypeName.StaticVar — a plain global load of the mangled
label resolved by the semantic pass. }
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;
{ Static property read: TypeName.StaticProp — call the static getter
(no Self argument). }
if FldAccess.IsStaticPropGet then
begin
MDecl := TMethodDecl(FldAccess.ResolvedMethod);
QType := QbeTypeOf(MDecl.ResolvedReturnType);
T := AllocTemp();
EmitLine(Format(' %s =%s call $%s()',
[T, QType,
MethodEmitName(MDecl,
TRecordTypeDesc(FldAccess.ResolvedClassType).Name, MDecl.Name)]));
Exit(T);
end;
if FldAccess.IsImplicitSelf then
begin
{ Implicit Self.Base.Field — Base is a field of Self }

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

@ -145,6 +145,9 @@ type
PropIndexExpr: TASTExpr; { owned — non-nil = indexed property read (e.g. List.Items[i]) }
IsCharAccess: Boolean; { set by uSemantic — PropIndexExpr indexes a string field: S.Field[N] }
IsArrayAccess: Boolean; { set by uSemantic — PropIndexExpr subscripts an array field: R.Arr[I] }
IsClassVarRead: Boolean; { set by uSemantic — TypeName.StaticVar read; lower as a global load of ClassVarEmitName }
ClassVarEmitName: string; { mangled global label for an IsClassVarRead access }
IsStaticPropGet: Boolean; { set by uSemantic — TypeName.StaticProp read; ResolvedMethod is the static getter }
destructor Destroy; override;
end;
@ -554,6 +557,9 @@ type
IsBuiltinToString: Boolean; { set by uSemantic — built-in TObject.ToString virtual dispatch }
IsConstructorCall: Boolean; { set by uSemantic — metaclass-var Create in stmt position }
IsMetaclassDispatch: Boolean; { set by uSemantic — receiver is a metaclass var }
IsStaticCall: Boolean; { set by uSemantic — TypeName.StaticMethod(): a static
(class-level) call with NO Self. Codegen lowers it as a
plain call to the mangled method symbol, no receiver. }
IsProcFieldCall: Boolean; { set by uSemantic — Name is a procedural-typed field of
the receiver, invoked directly (F.Handler;). Codegen
loads the (Code, Data) pair from the field slot and
@ -732,14 +738,26 @@ type
Attributes: TStringList; { owned — see TVarDecl.Attributes. }
IsWeak: Boolean; { set by uSemantic when [Weak] is resolved. }
IsUnretained: Boolean; { set by uSemantic when [Unretained] is resolved. }
IsClassVar: Boolean; { set by uParser — declared `static var` (a.k.a.
class variable): one shared storage slot for the
whole type, not a per-instance field. Lowered to
a global slot by uSemantic; never gets an instance
offset. }
ClassVarEmitName: string; { set by uSemantic for an IsClassVar field — the
mangled global data-label (CurrentUnitPrefix +
Class + '_' + Name). Single source of truth so
BOTH backends emit the slot under the exact label
the read/write sites use, without re-deriving the
unit prefix. }
constructor Create;
destructor Destroy; override;
end;
TRecordTypeDef = class(TASTTypeDef)
public
Fields: TObjectList; { owned TFieldDecl }
Methods: TObjectList; { owned TMethodDecl }
Fields: TObjectList; { owned TFieldDecl }
Methods: TObjectList; { owned TMethodDecl }
ConstDecls: TObjectList; { owned TConstDecl — record-level constants (static const) }
IsPacked: Boolean; { True iff declared `packed record` — disables
field alignment padding and tail padding;
ARC-managed fields (string/class/intf) still
@ -826,6 +844,11 @@ type
block that owns the whole frame; codegen
emits no compiler prologue/epilogue }
IsRecordMethod: Boolean; { set by uSemantic — owner type is a record (not a class) }
IsStatic: Boolean; { set by uParser — declared `static` (class method):
no implicit Self; type-associated dispatch.
Distinct from VTableSlot's "static dispatch"
(= non-virtual); a static method also never
receives a Self pointer. }
VTableSlot: Integer; { -1 = static; >=0 = vtable index (set by uSemantic) }
TypeParams: TStringList; { non-nil = generic function template; owns param names }
TypeParamConstraints: TStringList; { parallel to TypeParams; '' = unconstrained,
@ -865,6 +888,8 @@ type
[Unretained] ResolvedMethod: TObject; { TMethodDecl — not owned }
IsConstructorCall: Boolean; { set by uSemantic — TypeName.Create(args) }
IsMetaclassDispatch: Boolean; { set by uSemantic — receiver is a metaclass var }
IsStaticCall: Boolean; { set by uSemantic — TypeName.StaticMethod(): static
(class-level) call with NO Self; plain call to mangled name }
IsGlobal: Boolean; { set by uSemantic — ObjectName is a program-level global }
IsVarParam: Boolean; { set by uSemantic — ObjectName is a var/out parameter }
IsBuiltinToString: Boolean; { set by uSemantic — built-in TObject.ToString virtual dispatch }
@ -886,6 +911,8 @@ type
IndexParamName: string; { '' = non-indexed property }
IndexTypeName: string; { type name of the index parameter; '' when non-indexed }
IsDefault: Boolean; { declared with the `default` directive (Obj[I] sugar) }
IsStatic: Boolean; { set by uParser — declared `static`: sugar over a
static getter/setter; no implicit Self. }
end;
TClassTypeDef = class(TASTTypeDef)
@ -1460,8 +1487,9 @@ end;
constructor TRecordTypeDef.Create;
begin
inherited Create();
Fields := TObjectList.Create(True);
Methods := TObjectList.Create(True);
Fields := TObjectList.Create(True);
Methods := TObjectList.Create(True);
ConstDecls := TObjectList.Create(True);
end;
destructor TRecordTypeDef.Destroy;

44
compiler/src/main/pascal/uDebugOPDF.pas
View file

@ -74,6 +74,7 @@ type
procedure EmitConstantsFromList(AList: TObjectList);
procedure EmitTypesFromBlock(ABlock: TBlock);
procedure EmitGlobalVarsFromList(AList: TObjectList);
procedure EmitStaticVarsFromBlock(ABlock: TBlock);
procedure EmitAllTypes;
procedure EmitGlobalVars;
procedure EmitFunctionScopes;
@ -1264,15 +1265,58 @@ begin
end;
end;
{ Static (class-level) variables are shared global pointer/value slots, not
instance fields, so they are not in any block's var-decl list and EmitFields
(instance fields only) skips them. Emit one recGlobalVar per IsClassVar field
under its mangled ClassVarEmitName so a debugger can print TFoo.FInstance. }
procedure TOPDFEmitter.EmitStaticVarsFromBlock(ABlock: TBlock);
var
I, K, N: Integer;
TD: TTypeDecl;
Flds: TObjectList;
FDecl: TFieldDecl;
Nm: string;
begin
if ABlock = nil then Exit;
for I := 0 to ABlock.TypeDecls.Count - 1 do
begin
TD := TTypeDecl(ABlock.TypeDecls.Items[I]);
Flds := nil;
if TD.Def is TClassTypeDef then
Flds := TClassTypeDef(TD.Def).Fields
else if TD.Def is TRecordTypeDef then
Flds := TRecordTypeDef(TD.Def).Fields;
if Flds = nil then Continue;
for K := 0 to Flds.Count - 1 do
begin
FDecl := TFieldDecl(Flds.Items[K]);
if not FDecl.IsClassVar then Continue;
for N := 0 to FDecl.Names.Count - 1 do
begin
if (FDecl.ClassVarEmitName <> '') and (FDecl.Names.Count = 1) then
Nm := FDecl.ClassVarEmitName
else
Continue; { multi-name static vars carry no per-name emit label yet }
EmitGlobalVar(Nm, FDecl.ResolvedType);
end;
end;
end;
end;
procedure TOPDFEmitter.EmitGlobalVars;
begin
if FUnit <> nil then
begin
EmitGlobalVarsFromList(FUnit.IntfBlock.Decls);
EmitGlobalVarsFromList(FUnit.ImplBlock.Decls);
EmitStaticVarsFromBlock(FUnit.IntfBlock);
EmitStaticVarsFromBlock(FUnit.ImplBlock);
end
else if FProgram <> nil then
begin
EmitGlobalVarsFromList(FProgram.Block.Decls);
EmitStaticVarsFromBlock(FProgram.Block);
end;
end;
procedure TOPDFEmitter.SetFacts(AFacts: TDbgFacts);

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

@ -845,7 +845,9 @@ begin
as required when concatenating multiple Pascal units into one file. }
while Check(tkType) or Check(tkVar) or Check(tkThreadVar) or
Check(tkProcedure) or Check(tkFunction) or Check(tkConst) or
Check(tkConstructor) or Check(tkDestructor) do
Check(tkConstructor) or Check(tkDestructor) or
(Check(tkIdent) and SameText(FCurrent.Value, 'static') and
(PeekKind() in [tkFunction, tkProcedure])) do
begin
if Check(tkType) then
ParseTypeSection(Result)
@ -873,7 +875,11 @@ end;
procedure TParser.ParseTypeSection(ABlock: TBlock);
begin
Expect(tkType);
while Check(tkIdent) or Check(tkLBracket) do
while (Check(tkIdent) or Check(tkLBracket)) and
{ Stop the type section at a leading `static function/procedure` — that
is an out-of-line static-method implementation, not a type decl. }
not (Check(tkIdent) and SameText(FCurrent.Value, 'static') and
(PeekKind() in [tkFunction, tkProcedure])) do
ParseTypeDecl(ABlock);
end;
@ -1298,6 +1304,21 @@ begin
Expect(tkConst);
while Check(tkIdent) do
begin
{ Stop at a class/record section keyword: a const section inside a class or
record body is terminated by the next visibility/`static` section or by a
`property` member. A genuine const decl is always `IDENT (':' | '=')`, so
if the current identifier is a section keyword and is NOT immediately
followed by `:` or `=`, it begins the next section, not another const.
(Top-level const blocks never hit this: they are followed by `var`/`type`/
`begin`, which are not tkIdent.) }
if (SameText(FCurrent.Value, 'private') or
SameText(FCurrent.Value, 'protected') or
SameText(FCurrent.Value, 'public') or
SameText(FCurrent.Value, 'published') or
SameText(FCurrent.Value, 'static') or
SameText(FCurrent.Value, 'property')) and
not (PeekKind() in [tkColon, tkEquals]) then
Break;
CD := TConstDecl.Create();
CD.Line := FCurrent.Line;
CD.Col := FCurrent.Col;
@ -1904,25 +1925,73 @@ end;
function TParser.ParseRecordDef: TRecordTypeDef;
var
MethDecl: TMethodDecl;
MethDecl: TMethodDecl;
CurrStatic: Boolean; { current section's static (class-level) association }
LocalStatic: Boolean;
FieldCountBefore: Integer;
FieldIdx: Integer;
begin
Result := TRecordTypeDef.Create();
CurrStatic := False;
try
Result.Line := FCurrent.Line;
Result.Col := FCurrent.Col;
Expect(tkRecord);
repeat
if Check(tkIdent) or Check(tkLBracket) then
ParseFieldDecl(Result.Fields)
else if Check(tkFunction) then
{ Bare `static var` / `static const` SECTION keyword. `static` is a soft
keyword: a section qualifier only when followed by `var`/`const`; a
field literally named `Static` (`Static: Integer;`) falls through. }
if Check(tkIdent) and SameText(FCurrent.Value, 'static') and
(PeekKind() in [tkVar, tkConst]) then
begin
MethDecl := ParseMethodDecl(True);
CurrStatic := True;
Advance(); { the following var/const section belongs to this static section }
end
{ Visibility section keywords are accepted (and currently cosmetic), with
an optional trailing `static`. A new visibility section resets static. }
else if Check(tkIdent) and (SameText(FCurrent.Value, 'private') or
SameText(FCurrent.Value, 'public') or
SameText(FCurrent.Value, 'protected')) then
begin
CurrStatic := False;
Advance();
if Check(tkIdent) and SameText(FCurrent.Value, 'static') and
(PeekKind() in [tkVar, tkConst, tkFunction, tkProcedure]) then
begin
CurrStatic := True;
Advance();
end;
end
else if Check(tkConst) then
ParseConstBlock(Result.ConstDecls)
else if Check(tkVar) then
Advance() { optional `var` keyword before field declarations }
{ Method declarations — before the field branch so a leading `static`
prefix is not mistaken for a field name. }
else if Check(tkFunction) or Check(tkProcedure) or
(Check(tkIdent) and SameText(FCurrent.Value, 'static') and
(PeekKind() in [tkFunction, tkProcedure])) then
begin
LocalStatic := CurrStatic;
if Check(tkIdent) and SameText(FCurrent.Value, 'static') then
begin
LocalStatic := True;
Advance();
end;
if Check(tkFunction) then
MethDecl := ParseMethodDecl(True)
else
MethDecl := ParseMethodDecl(False);
MethDecl.IsStatic := LocalStatic;
Result.Methods.Add(MethDecl);
end
else if Check(tkProcedure) then
else if Check(tkIdent) or Check(tkLBracket) then
begin
MethDecl := ParseMethodDecl(False);
Result.Methods.Add(MethDecl);
FieldCountBefore := Result.Fields.Count;
ParseFieldDecl(Result.Fields);
if CurrStatic then
for FieldIdx := FieldCountBefore to Result.Fields.Count - 1 do
TFieldDecl(Result.Fields.Items[FieldIdx]).IsClassVar := True;
end
else
Break;
@ -1967,8 +2036,13 @@ end;
function TParser.ParseClassDef: TClassTypeDef;
var
CurrPublished: Boolean;
MethDecl: TMethodDecl;
CurrPublished: Boolean;
CurrStatic: Boolean; { current section's static (class-level) association }
LocalStatic: Boolean; { effective static for the member being parsed }
MethDecl: TMethodDecl;
PropDecl: TPropertyDecl;
FieldCountBefore: Integer;
FieldIdx: Integer;
begin
Result := TClassTypeDef.Create();
try
@ -2004,34 +2078,104 @@ begin
is then attached to each method decl so codegen can emit a
published-method table entry. }
CurrPublished := False;
CurrStatic := False;
repeat
{ Visibility section keyword (private/public/protected/published),
optionally followed by a `static` qualifier. A visibility keyword
resets the static section (you must re-state `static` after it). }
if Check(tkIdent) and (SameText(FCurrent.Value, 'private') or
SameText(FCurrent.Value, 'public') or
SameText(FCurrent.Value, 'protected') or
SameText(FCurrent.Value, 'published')) then
begin
CurrPublished := SameText(FCurrent.Value, 'published');
CurrStatic := False; { a new visibility section is non-static unless
`static` follows }
Advance(); { consume the visibility modifier }
{ Optional trailing `static` section qualifier. `static` is a soft
keyword: treat it as a qualifier only when it introduces a static
member (followed by var/const/method/property), NOT when it is a
field literally named `Static` (`private Static: Boolean;`). }
if Check(tkIdent) and SameText(FCurrent.Value, 'static') and
((PeekKind() in [tkVar, tkConst, tkFunction, tkProcedure,
tkConstructor, tkDestructor]) or
((PeekKind() = tkIdent) and SameText(PeekValueAt(1), 'property'))) then
begin
CurrStatic := True;
Advance();
end;
end
{ Bare `static` SECTION keyword — `static var` / `static const` only.
`static` is a soft keyword: it acts as a section qualifier only when
immediately followed by `var` or `const`. Followed by anything else
(e.g. `Static: Boolean;` — a field literally named Static, or `Static,`)
it is an ordinary field identifier and falls through to the field
branch. The `static function/procedure/property` PREFIX forms are
handled in the method/property branches below. }
else if Check(tkIdent) and SameText(FCurrent.Value, 'static') and
(PeekKind() in [tkVar, tkConst]) then
begin
CurrStatic := True;
Advance(); { consume `static`; the following `var`/`const` section is
part of this static section }
end
else if Check(tkConst) then
ParseConstBlock(Result.ConstDecls)
else if Check(tkVar) then
Advance() { optional 'var' keyword before field declarations — consume and continue }
else if Check(tkIdent) and SameText(FCurrent.Value, 'property') then
Result.Properties.Add(ParsePropertyDecl())
else if Check(tkIdent) or Check(tkLBracket) then
ParseFieldDecl(Result.Fields)
else if Check(tkFunction) then
else if (Check(tkIdent) and SameText(FCurrent.Value, 'property')) or
(Check(tkIdent) and SameText(FCurrent.Value, 'static') and
(PeekKind() = tkIdent) and SameText(PeekValueAt(1), 'property')) then
begin
MethDecl := ParseMethodDecl(True);
LocalStatic := CurrStatic;
if Check(tkIdent) and SameText(FCurrent.Value, 'static') then
begin
LocalStatic := True;
Advance(); { consume per-member `static` prefix }
end;
PropDecl := ParsePropertyDecl();
PropDecl.IsStatic := LocalStatic;
Result.Properties.Add(PropDecl);
end
{ Method declarations — checked BEFORE the generic field branch so that a
leading `static` prefix on a method is not mistaken for a field name. }
else if Check(tkFunction) or Check(tkProcedure) or
Check(tkConstructor) or Check(tkDestructor) or
(Check(tkIdent) and SameText(FCurrent.Value, 'static') and
(PeekKind() in [tkFunction, tkProcedure, tkConstructor, tkDestructor])) then
begin
LocalStatic := CurrStatic;
if Check(tkIdent) and SameText(FCurrent.Value, 'static') then
begin
LocalStatic := True;
Advance(); { consume per-member `static` prefix }
end;
if Check(tkConstructor) or Check(tkDestructor) then
begin
if LocalStatic then
raise EParseError.Create(Format(
'A constructor or destructor cannot be declared static at line %d col %d in %s'
+ ' — Blaise has no type-initialiser (class constructor); use the unit'
+ ' initialization/finalization sections',
[FCurrent.Line, FCurrent.Col, FLexer.Filename]));
MethDecl := ParseMethodDecl(False);
end
else if Check(tkFunction) then
MethDecl := ParseMethodDecl(True)
else
MethDecl := ParseMethodDecl(False);
MethDecl.IsPublished := CurrPublished;
MethDecl.IsStatic := LocalStatic;
Result.Methods.Add(MethDecl);
end
else if Check(tkProcedure) or Check(tkConstructor) or Check(tkDestructor) then
else if Check(tkIdent) or Check(tkLBracket) then
begin
MethDecl := ParseMethodDecl(False);
MethDecl.IsPublished := CurrPublished;
Result.Methods.Add(MethDecl);
FieldCountBefore := Result.Fields.Count;
ParseFieldDecl(Result.Fields);
{ Stamp class-var flag on every field this decl produced. }
if CurrStatic then
for FieldIdx := FieldCountBefore to Result.Fields.Count - 1 do
TFieldDecl(Result.Fields.Items[FieldIdx]).IsClassVar := True;
end
else
Break;
@ -2301,7 +2445,6 @@ begin
SameText(FCurrent.Value, 'pascal') or
SameText(FCurrent.Value, 'safecall') or
SameText(FCurrent.Value, 'reintroduce') or
SameText(FCurrent.Value, 'static') or
SameText(FCurrent.Value, 'final') or
SameText(FCurrent.Value, 'assembler') or
SameText(FCurrent.Value, 'nostackframe') or
@ -2482,11 +2625,24 @@ end;
procedure TParser.ParseStandaloneDecl(ABlock: TBlock);
var
IsFunc: Boolean;
MD: TMethodDecl;
IsFunc: Boolean;
IsStat: Boolean;
MD: TMethodDecl;
begin
{ Leading `static` on an out-of-line implementation: `static function T.M ...`.
Consume it and record the static-ness on the parsed decl, where it is later
reconciled against the in-class declaration. }
IsStat := False;
if Check(tkIdent) and SameText(FCurrent.Value, 'static') and
(PeekKind() in [tkFunction, tkProcedure]) then
begin
IsStat := True;
Advance();
end;
IsFunc := Check(tkFunction);
MD := ParseMethodDecl(IsFunc, True); { True = may have nested proc/func decls }
if IsStat then
MD.IsStatic := True;
ABlock.ProcDecls.Add(MD);
end;

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

@ -3271,6 +3271,7 @@ begin
if NewPDecl.IndexTypeName <> '' then
PropInfo.IndexTypeDesc := FindTypeOrInstantiate(NewPDecl.IndexTypeName);
PropInfo.IsDefault := NewPDecl.IsDefault;
PropInfo.IsStatic := NewPDecl.IsStatic;
RT.AddProperty(PropInfo);
end;
@ -4839,6 +4840,7 @@ var
MethodList: TObjectList;
Grp: TObjectList;
FDecl: TFieldDecl;
ClassVarEmit: string;
MDecl: TMethodDecl;
Par: TMethodParam;
ParType: TTypeDesc;
@ -5523,14 +5525,52 @@ begin
for K := 0 to FDecl.Names.Count - 1 do
begin
FldName := FDecl.Names.Strings[K];
RT.AddField(FldName, FldType);
{ Propagate the weak/unretained flags to the just-added field info so
codegen and the field cleanup emitter can consult them without
walking back to the AST. }
if FDecl.IsWeak then
RT.FindField(FldName).IsWeak := True;
if FDecl.IsUnretained then
RT.FindField(FldName).IsUnretained := True;
if FDecl.IsClassVar then
begin
{ STATIC (class-level) variable: not an instance field — do NOT call
AddField (that would advance the instance layout). Register a single
shared global instead, under a mangled emit label, reachable by both
the bare name (inside methods) and the qualified 'TFoo.Name' form.
Class- and interface-typed static vars ARE supported: they are a
single shared pointer slot, zero-initialised to nil, and assignment
goes through the normal managed-global store ARC (retain new /
release old). String and dynamic-array static vars remain deferred
(their exit-time release story is not yet wired). }
if (FldType.Kind = tyString) or (FldType.Kind = tyDynArray) then
SemanticError(Format(
'static var ''%s'': string and dynamic-array static fields are ' +
'not yet supported (class and interface are)', [FldName]),
FDecl.Line, FDecl.Col);
ClassVarEmit := CurrentUnitPrefix() + TD.Name + '_' + FldName;
{ Single source of truth for codegen: stash the mangled label on the
field decl (used by both backends to emit the data slot, even for a
read-only static var that no assignment auto-registers). }
if FDecl.Names.Count = 1 then
FDecl.ClassVarEmitName := ClassVarEmit;
{ Bare name — usable unqualified inside the class's own methods. }
Sym := TSymbol.Create(FldName, skVariable, FldType);
Sym.IsGlobal := True;
Sym.IsClassVar := True;
Sym.GlobalEmitName := ClassVarEmit;
if not FTable.Define(Sym) then Sym.Free();
{ Qualified name — usable as TFoo.Name from anywhere. }
Sym := TSymbol.Create(TD.Name + '.' + FldName, skVariable, FldType);
Sym.IsGlobal := True;
Sym.IsClassVar := True;
Sym.GlobalEmitName := ClassVarEmit;
if not FTable.Define(Sym) then Sym.Free();
end
else
begin
RT.AddField(FldName, FldType);
{ Propagate the weak/unretained flags to the just-added field info so
codegen and the field cleanup emitter can consult them without
walking back to the AST. }
if FDecl.IsWeak then
RT.FindField(FldName).IsWeak := True;
if FDecl.IsUnretained then
RT.FindField(FldName).IsUnretained := True;
end;
end;
end;
@ -5625,6 +5665,7 @@ begin
if PropDecl.IndexTypeName <> '' then
PropInfo.IndexTypeDesc := FTable.FindType(PropDecl.IndexTypeName);
PropInfo.IsDefault := PropDecl.IsDefault;
PropInfo.IsStatic := PropDecl.IsStatic;
RT.AddProperty(PropInfo);
end;
@ -5847,18 +5888,29 @@ begin
Exit;
end;
SavedClass := FCurrentClass;
FCurrentClass := AClassType;
{ A STATIC (class-level) method has no instance receiver. Leave FCurrentClass
at its saved value (do NOT bind it to AClassType) so that an implicit
instance-member reference inside the body resolves as an undeclared
identifier rather than silently binding to a non-existent Self. Static
members of the same type remain reachable through their registered bare
global symbols. }
if not AMethod.IsStatic then
FCurrentClass := AClassType;
FTable.PushScope();
Inc(FScopeDepth);
try
{ Record methods receive the record by pointer (like a var param); class
methods receive the object pointer as a value. Declaring Self as
skVarParameter for records makes the codegen dereference it correctly. }
if AMethod.IsRecordMethod then
Sym := TSymbol.Create('Self', skVarParameter, AClassType)
else
Sym := TSymbol.Create('Self', skVariable, AClassType);
FTable.Define(Sym);
skVarParameter for records makes the codegen dereference it correctly.
A static method receives NO Self. }
if not AMethod.IsStatic then
begin
if AMethod.IsRecordMethod then
Sym := TSymbol.Create('Self', skVarParameter, AClassType)
else
Sym := TSymbol.Create('Self', skVariable, AClassType);
FTable.Define(Sym);
end;
{ For function methods, define Result as a writable variable }
if AMethod.ResolvedReturnType <> nil then
@ -7622,6 +7674,35 @@ begin
end;
ObjSym := FTable.Lookup(ACall.ObjectName);
{ TypeName.StaticMethod() — a static (class-level) method called through the
class name in statement position. Resolve the method on the class; it must
be declared static. Lowered with NO Self. }
if (ObjSym <> nil) and (ObjSym.Kind = skType) and (ObjSym.TypeDesc <> nil) and
(ObjSym.TypeDesc.Kind = tyClass) then
begin
RT := TRecordTypeDesc(ObjSym.TypeDesc);
for I := 0 to ACall.Args.Count - 1 do
AnalyseExpr(TASTExpr(ACall.Args.Items[I]));
MDecl := ResolveMethodOverload(RT.Name, ACall.Name, ACall.Args,
ACall.Line, ACall.Col);
if MDecl = nil then
SemanticError(
Format('Class ''%s'' has no method ''%s''', [RT.Name, ACall.Name]),
ACall.Line, ACall.Col);
if not MDecl.IsStatic then
SemanticError(
Format('''%s.%s'' is not a static method — call it on an instance',
[RT.Name, ACall.Name]),
ACall.Line, ACall.Col);
AppendDefaultArgs(ACall.Args, MDecl, ACall.Name, ACall.Line, ACall.Col);
ACall.ResolvedClassType := RT;
ACall.ResolvedMethod := MDecl;
ACall.IsStaticCall := True;
if (MDecl.ResolvedReturnType <> nil) and
(MDecl.ResolvedReturnType.Kind = tyRecord) then
ACall.ResolvedReturnTypeDesc := MDecl.ResolvedReturnType;
Exit;
end;
{ Inside a method, class fields shadow same-named globals. Try the
implicit Self.Field path when there is no match (ObjSym=nil) OR when
the only match is a global variable that a class field should shadow. }
@ -7858,6 +7939,11 @@ begin
AAssign.Line, AAssign.Col);
AAssign.Name := VarSym.Name; { normalise to declared casing }
{ Static (class-level) var: the assignment target is the single shared global
emitted under the mangled GlobalEmitName, so the LHS name must be that label
(matches the read path in AnalyseIdentExpr). }
if VarSym.IsClassVar and (VarSym.GlobalEmitName <> '') then
AAssign.Name := VarSym.GlobalEmitName;
AAssign.IsVarParam := (VarSym.Kind = skVarParameter);
AAssign.ResolvedLhsType := VarSym.TypeDesc;
AAssign.IsWeakLhs := VarSym.IsWeak;
@ -10472,6 +10558,38 @@ begin
if SameText(ObjSym.Name, AExpr.ObjectName) then
AExpr.ObjectName := ObjSym.Name;
{ TypeName.StaticFunction(args) in expression position — a static (class-level)
method reached through the class name. Must be declared static; lowered with
NO Self. Checked before the Create-constructor branch so a non-Create static
method resolves here rather than falling through to "is not a variable". }
if (ObjSym.Kind = skType) and (ObjSym.TypeDesc <> nil) and
(ObjSym.TypeDesc.Kind in [tyClass, tyRecord]) and
not (SameText(AExpr.Name, 'Create') or (StrPos('Create', AExpr.Name) = 0)) then
begin
for I := 0 to AExpr.Args.Count - 1 do
AnalyseExpr(TASTExpr(AExpr.Args.Items[I]));
MDecl := ResolveMethodOverload(ObjSym.Name, AExpr.Name, AExpr.Args,
AExpr.Line, AExpr.Col);
if MDecl = nil then
MDecl := FindMethodDecl(ObjSym.Name, AExpr.Name);
if MDecl = nil then
SemanticError(
Format('Type ''%s'' has no method ''%s''', [ObjSym.Name, AExpr.Name]),
AExpr.Line, AExpr.Col);
if not MDecl.IsStatic then
SemanticError(
Format('''%s.%s'' is not a static method — call it on an instance',
[ObjSym.Name, AExpr.Name]),
AExpr.Line, AExpr.Col);
AppendDefaultArgs(AExpr.Args, MDecl, AExpr.Name, AExpr.Line, AExpr.Col);
AExpr.ResolvedMethod := MDecl;
AExpr.ResolvedClassType := ObjSym.TypeDesc;
AExpr.IsStaticCall := True;
Result := MDecl.ResolvedReturnType;
AExpr.ResolvedType := Result;
Exit;
end;
{ Constructor call with args: TypeName.Create(arg1, arg2, ...) or any
method on a class type starting with Create (e.g. CreateFmt). }
if (ObjSym.Kind = skType) and
@ -10791,6 +10909,12 @@ begin
the QBE ABI level: the local slot holds a pointer, not the aggregate
bytes. Codegen must dereference the slot before reading fields. }
TIdentExpr(AExpr).Name := Sym.Name; { normalise to declared casing }
{ A static (class-level) variable resolves to a single shared global whose
emit label is the mangled GlobalEmitName, distinct from the lookup key
('FInstance' or 'TFoo.FInstance' both reach the one slot). Rewrite the
node's emitted name to that label so codegen lowers $TFoo_FInstance. }
if Sym.IsClassVar and (Sym.GlobalEmitName <> '') then
TIdentExpr(AExpr).Name := Sym.GlobalEmitName;
if Sym.Kind = skVarParameter then
TIdentExpr(AExpr).ParamMode := pmVar
else if (Sym.Kind = skParameter) and (Sym.TypeDesc <> nil) and
@ -10944,6 +11068,7 @@ var
PropInfo: TPropertyInfo;
BaseType: TTypeDesc;
IntfDesc: TInterfaceTypeDesc;
MDecl: TMethodDecl;
begin
{ Chained access: A.B.C — base is another expression whose type must be
a record or class. Leaf lookup uses Base.ResolvedType; RecordName path
@ -11262,6 +11387,41 @@ begin
AAccess.ResolvedType := Sym.TypeDesc;
Exit(Sym.TypeDesc);
end;
{ Static (class-level) variable read: TypeName.StaticVar. The qualified
symbol carries the mangled GlobalEmitName; rewrite the access to a plain
global read of that label (codegen lowers it like a global ident). }
if (Sym <> nil) and (Sym.Kind = skVariable) and Sym.IsClassVar then
begin
AAccess.IsClassVarRead := True;
AAccess.IsGlobal := True;
AAccess.ClassVarEmitName := Sym.GlobalEmitName;
AAccess.ResolvedType := Sym.TypeDesc;
Exit(Sym.TypeDesc);
end;
{ Static property read: TypeName.StaticProp. Resolve to its (static)
getter and lower as a static getter call. Only method-backed static
getters are supported (a field-backed static property would resolve to
the static var directly). }
PropInfo := TRecordTypeDesc(RecSym.TypeDesc).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',
[AAccess.RecordName, AAccess.FieldName]),
AAccess.Line, AAccess.Col);
MDecl := FindMethodDecl(TRecordTypeDesc(RecSym.TypeDesc).Name, PropInfo.ReadMethod);
if (MDecl = nil) or not MDecl.IsStatic then
SemanticError(
Format('Static property ''%s.%s'' getter ''%s'' is not a static method',
[AAccess.RecordName, AAccess.FieldName, PropInfo.ReadMethod]),
AAccess.Line, AAccess.Col);
AAccess.IsStaticPropGet := True;
AAccess.ResolvedMethod := MDecl;
AAccess.ResolvedClassType := RecSym.TypeDesc;
AAccess.ResolvedType := MDecl.ResolvedReturnType;
Exit(MDecl.ResolvedReturnType);
end;
SemanticError(
Format('Unknown class method ''%s'' on type ''%s''',
[AAccess.FieldName, AAccess.RecordName]),

11
compiler/src/main/pascal/uSymbolTable.pas
View file

@ -219,6 +219,7 @@ type
IndexParamName: string; { '' = non-indexed property }
[Unretained] IndexTypeDesc: TTypeDesc; { not owned; non-nil when IndexParamName <> '' }
IsDefault: Boolean; { declared with the `default` directive (Obj[I] sugar) }
IsStatic: Boolean; { declared `static property` — accessors are static (no Self) }
end;
{ Type descriptor for zero-GUID interface types (Phase 3). }
@ -368,6 +369,16 @@ type
of the strong addref/release pattern. }
IsGlobal: Boolean; { true for program-level variables; codegen uses
QBE data-section storage instead of stack alloc }
IsClassVar: Boolean; { true for a STATIC (class-level) variable. Stored
as a single shared global (IsGlobal is also True),
under the mangled GlobalEmitName, not as a
per-instance field. }
GlobalEmitName: string; { when non-empty, the mangled data-label this symbol
emits/loads/stores under (e.g. 'TFoo_FInstance').
Lets a bare lookup key ('FInstance') and a
qualified one ('TFoo.FInstance') resolve to ONE
storage slot. Mirrors ConstArrayQbe for consts.
Empty = emit under Name. }
IsThreadVar: Boolean; { true for threadvar declarations; codegen emits
TLS storage instead of plain global data }
IsOverload: Boolean; { true when declared with the 'overload' directive;

102
compiler/src/main/pascal/uUnitInterfaceIO.pas
View file

@ -53,7 +53,14 @@ uses
const
IFACE_MAGIC = 'BLAISE-IFACE';
IFACE_VERSION = 2; { v1: shipped through release v0.11.x (last public commit
IFACE_VERSION = 3; { v3 (this cycle): `static` (class-level) member facts now
serialised — TFieldDecl.IsClassVar + ClassVarEmitName in
EncodeFieldList/ReadFieldList, TPropertyDecl.IsStatic in
EncodePropertyList/ReadPropertyList, and record/class
static-const declarations (ConstDecls) in the record/class
payloads. The layout grew, so v2 readers must reject these
.bif and recompile.
v1: shipped through release v0.11.x (last public commit
d56bdbf).
v2 (release v0.12.0): a batch of META/record additions
made this cycle, all gated by this single bump since
@ -266,7 +273,39 @@ begin
Result := Result +
EncodeLpstr(F.Names.Strings[J]) +
EncodeLpstr(F.TypeName) +
EncodeBool(F.IsWeak);
EncodeBool(F.IsWeak) +
{ `static var` (class variable) facts: IsClassVar marks the field
as a shared global rather than an instance slot; ClassVarEmitName
is the defining unit's mangled global label (set by uSemantic).
An importer cannot re-derive that label — its own unit prefix
differs — so the label is carried verbatim. Both default to
False/'' for ordinary instance fields. }
EncodeBool(F.IsClassVar) +
EncodeLpstr(F.ClassVarEmitName);
end;
end;
{ Record/class-level `static const` declarations. These are scalar
constants folded by the semantic pass; we serialise the same five-
field scalar shape the unit-level CONST block uses (Name, TypeName,
IntVal, StrVal, IsString/IsFloat flags). Non-scalar const forms
(array consts, unfolded expression tokens) are not carried here —
static const members are scalar in the current language surface. }
function EncodeConstDeclList(AConsts: TObjectList): string;
var
I: Integer;
C: TConstDecl;
begin
Result := EncodeCount(AConsts.Count);
for I := 0 to AConsts.Count - 1 do
begin
C := TConstDecl(AConsts.Items[I]);
Result := Result +
EncodeLpstr(C.Name) +
EncodeLpstr(C.TypeName) +
EncodeInt64(C.IntVal) +
EncodeLpstr(C.StrVal) +
EncodeFlags(C.IsString, C.IsFloat);
end;
end;
@ -313,7 +352,9 @@ var
begin
Def := TRecordTypeDef(AEntry.Def);
Result := EncodeBool(Def.IsPacked) +
EncodeFieldList(Def.Fields);
EncodeFieldList(Def.Fields) +
{ record-level `static const` declarations. }
EncodeConstDeclList(Def.ConstDecls);
end;
function EncodePropertyList(AList: TObjectList): string;
@ -332,7 +373,10 @@ begin
EncodeLpstr(P.WriteName) +
EncodeLpstr(P.IndexParamName) +
EncodeLpstr(P.IndexTypeName) +
EncodeBool(P.IsDefault);
EncodeBool(P.IsDefault) +
{ `static property` — accessors take no implicit Self. An importer
needs this to dispatch reads/writes without a receiver. }
EncodeBool(P.IsStatic);
end;
end;
@ -348,7 +392,9 @@ begin
EncodeStringList(AEntry.Implements) +
EncodeFieldList(Def.Fields) +
EncodeMethodList(AEntry.Methods) +
EncodePropertyList(Def.Properties);
EncodePropertyList(Def.Properties) +
{ class-level `static const` declarations. }
EncodeConstDeclList(Def.ConstDecls);
end;
{ Encode a TMethodDecl (AST) using the same per-method payload shape
@ -1769,11 +1815,13 @@ end;
procedure ReadFieldList(const AText: string; var APos: Integer;
ATarget: TObjectList);
var
C, I: Integer;
FldName: string;
FldType: string;
IsWeak: Boolean;
F: TFieldDecl;
C, I: Integer;
FldName: string;
FldType: string;
IsWeak: Boolean;
IsClassVar: Boolean;
ClassVarEmit: string;
F: TFieldDecl;
begin
C := DecodeCount(AText, APos);
for I := 1 to C do
@ -1781,14 +1829,44 @@ begin
FldName := ReadLpstrAt(AText, APos);
FldType := ReadLpstrAt(AText, APos);
IsWeak := DecodeBool(AText, APos);
{ Order must mirror EncodeFieldList: IsClassVar then ClassVarEmitName. }
IsClassVar := DecodeBool(AText, APos);
ClassVarEmit := ReadLpstrAt(AText, APos);
F := TFieldDecl.Create();
F.Names.Add(FldName);
F.TypeName := FldType;
F.IsWeak := IsWeak;
F.IsClassVar := IsClassVar;
F.ClassVarEmitName := ClassVarEmit;
ATarget.Add(F);
end;
end;
{ Inverse of EncodeConstDeclList — rebuild record/class `static const`
decls. Mirrors the writer's five-field scalar shape exactly. }
procedure ReadConstDeclList(const AText: string; var APos: Integer;
ATarget: TObjectList);
var
C, I: Integer;
CD: TConstDecl;
IsString: Boolean;
IsFloat: Boolean;
begin
C := DecodeCount(AText, APos);
for I := 1 to C do
begin
CD := TConstDecl.Create();
CD.Name := ReadLpstrAt(AText, APos);
CD.TypeName := ReadLpstrAt(AText, APos);
CD.IntVal := ReadInt64At(AText, APos);
CD.StrVal := ReadLpstrAt(AText, APos);
ReadFlagsAt(AText, APos, IsString, IsFloat);
CD.IsString := IsString;
CD.IsFloat := IsFloat;
ATarget.Add(CD);
end;
end;
{ Inverse of EncodeMethodSig — builds a TRoutineSig from the
per-method payload. }
function ReadMethodSig(const AText: string; var APos: Integer): TRoutineSig;
@ -1840,6 +1918,7 @@ begin
Def := TRecordTypeDef.Create();
Def.IsPacked := DecodeBool(AText, APos);
ReadFieldList(AText, APos, Def.Fields);
ReadConstDeclList(AText, APos, Def.ConstDecls);
AEntry.Def := Def;
end;
@ -1862,6 +1941,7 @@ begin
ReadFieldList(AText, APos, Def.Fields);
ReadMethodList(AText, APos, AEntry.Methods);
ReadPropertyList(AText, APos, Def.Properties);
ReadConstDeclList(AText, APos, Def.ConstDecls);
AEntry.IsClass := True;
AEntry.Def := Def;
end;
@ -1919,6 +1999,8 @@ begin
P.IndexParamName := ReadLpstrAt(AText, APos);
P.IndexTypeName := ReadLpstrAt(AText, APos);
P.IsDefault := DecodeBool(AText, APos);
{ Order must mirror EncodePropertyList: IsStatic follows IsDefault. }
P.IsStatic := DecodeBool(AText, APos);
ATarget.Add(P);
end;
end;

2
compiler/src/test/pascal/TestRunner.pas
View file

@ -122,6 +122,8 @@ uses
cp.test.proctypes,
cp.test.overload,
cp.test.classof,
cp.test.staticmembers,
cp.test.e2e.staticmembers,
cp.test.publishedrtti,
cp.test.attributes,
cp.test.proctypes_ofobject,

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

@ -0,0 +1,225 @@
{
Blaise - An Object Pascal Compiler
Copyright (c) 2026 Graeme Geldenhuys
SPDX-License-Identifier: Apache-2.0 WITH Swift-exception
Licensed under the Apache License v2.0 with Runtime Library Exception.
See LICENSE file in the project root for full license terms.
}
unit cp.test.e2e.staticmembers;
{ E2E tests for `static` class/record members: static var, static method,
static property, and the lazy-singleton pattern. Each program is compiled
and run on every backend (QBE + native). Parser/semantic/IR tests live in
cp.test.staticmembers.pas; these guard the codegen -> QBE -> run boundary
the IR harness cannot see (data-slot emission, no-Self call ABI, qualified
static reads). }
interface
uses
classes, blaise.testing, cp.test.e2e.base;
type
[Threaded]
TE2EStaticMembersTests = class(TE2ETestCase)
protected
procedure SetUp; override;
published
procedure TestRun_StaticMethod_NoSelf;
procedure TestRun_StaticVar_SharedAcrossCalls;
procedure TestRun_StaticVar_QualifiedRead;
procedure TestRun_StaticProperty_QualifiedRead;
procedure TestRun_Singleton_LazyGetInstance;
procedure TestRun_StaticConst_OnClass;
procedure TestRun_RecordStaticFactory;
end;
implementation
procedure TE2EStaticMembersTests.SetUp;
begin
inherited SetUp();
SetUpScratch('compiler/target/test-e2e-staticmembers')
end;
procedure TE2EStaticMembersTests.TestRun_StaticMethod_NoSelf;
const Src =
'''
program P;
type
TMath = class
public
static function Square(X: Integer): Integer;
end;
static function TMath.Square(X: Integer): Integer;
begin
Result := X * X;
end;
begin
WriteLn(TMath.Square(7))
end.
''';
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit end;
AssertRunsOnAll(Src, '49' + LineEnding, 0);
end;
procedure TE2EStaticMembersTests.TestRun_StaticVar_SharedAcrossCalls;
const Src =
'''
program P;
type
TCounter = class
private static var
FN: Integer;
public
static function Next: Integer;
end;
static function TCounter.Next: Integer;
begin
FN := FN + 1;
Result := FN;
end;
begin
WriteLn(TCounter.Next());
WriteLn(TCounter.Next());
WriteLn(TCounter.Next())
end.
''';
var LE: string;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit end;
LE := LineEnding;
AssertRunsOnAll(Src, '1' + LE + '2' + LE + '3' + LE, 0);
end;
procedure TE2EStaticMembersTests.TestRun_StaticVar_QualifiedRead;
const Src =
'''
program P;
type
TCounter = class
public static var
Total: Integer;
static procedure Bump;
end;
static procedure TCounter.Bump;
begin
Total := Total + 10;
end;
begin
TCounter.Bump();
TCounter.Bump();
WriteLn(TCounter.Total)
end.
''';
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit end;
AssertRunsOnAll(Src, '20' + LineEnding, 0);
end;
procedure TE2EStaticMembersTests.TestRun_StaticProperty_QualifiedRead;
const Src =
'''
program P;
type
TRegistry = class
private static var
FCounter: Integer;
public
static function NextId: Integer;
static property Counter: Integer read NextId;
end;
static function TRegistry.NextId: Integer;
begin
FCounter := FCounter + 1;
Result := FCounter;
end;
begin
WriteLn(TRegistry.Counter);
WriteLn(TRegistry.Counter)
end.
''';
var LE: string;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit end;
LE := LineEnding;
AssertRunsOnAll(Src, '1' + LE + '2' + LE, 0);
end;
procedure TE2EStaticMembersTests.TestRun_Singleton_LazyGetInstance;
const Src =
'''
program P;
type
TConfig = class
private static var
FInstance: TConfig;
public
FValue: Integer;
static function Instance: TConfig;
end;
static function TConfig.Instance: TConfig;
begin
if FInstance = nil then
FInstance := TConfig.Create();
Result := FInstance;
end;
begin
TConfig.Instance().FValue := 42;
WriteLn(TConfig.Instance().FValue)
end.
''';
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit end;
AssertRunsOnAll(Src, '42' + LineEnding, 0);
end;
procedure TE2EStaticMembersTests.TestRun_StaticConst_OnClass;
const Src =
'''
program P;
type
TLimits = class
public static const
MaxItems = 128;
end;
begin
WriteLn(TLimits.MaxItems)
end.
''';
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit end;
AssertRunsOnAll(Src, '128' + LineEnding, 0);
end;
procedure TE2EStaticMembersTests.TestRun_RecordStaticFactory;
const Src =
'''
program P;
type
TPoint = record
X, Y: Integer;
static function Make(AX, AY: Integer): TPoint;
end;
static function TPoint.Make(AX, AY: Integer): TPoint;
begin
Result.X := AX;
Result.Y := AY;
end;
var Pt: TPoint;
begin
Pt := TPoint.Make(3, 4);
WriteLn(Pt.X + Pt.Y)
end.
''';
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit end;
AssertRunsOnAll(Src, '7' + LineEnding, 0);
end;
initialization
RegisterTest(TE2EStaticMembersTests);
end.

967
compiler/src/test/pascal/cp.test.staticmembers.pas Normal file
View file

@ -0,0 +1,967 @@
{
Blaise - An Object Pascal Compiler
Copyright (c) 2026 Graeme Geldenhuys
SPDX-License-Identifier: Apache-2.0 WITH Swift-exception
Licensed under the Apache License v2.0 with Runtime Library Exception.
See LICENSE file in the project root for full license terms.
}
unit cp.test.staticmembers;
{ Tests for `static` (class-level) members: static var, static const,
static function/procedure, static property, on classes and records.
Feature 1 of the static-members work. Covers the PARSER layer
(TStaticMembersParseTests — the forms parse, the IsStatic / IsClassVar AST
flags are set, and `static constructor` / `static destructor` are rejected)
and the SEMANTIC + IR layer (TStaticMembersSemTests — resolution of static
vars to shared globals, no-Self static methods, qualified static var/property
reads, and the program-exit release of class-typed static vars). End-to-end
compile+run behaviour lives in cp.test.e2e.staticmembers.pas. }
interface
uses
Classes, SysUtils, blaise.testing,
uLexer, uParser, uAST, uSemantic, uSymbolTable, blaise.codegen.qbe;
type
TStaticMembersParseTests = class(TTestCase)
private
function ParseSrc(const ASrc: string): TProgram;
function ClassOf(AProg: TProgram; AIndex: Integer): TClassTypeDef;
function RecordOf(AProg: TProgram; AIndex: Integer): TRecordTypeDef;
procedure ParseExpectError(const ASrc: string);
procedure ParseExpectErrorMsg(const ASrc, AExpectedSubstr: string);
published
{ static var / static const sections on a class }
procedure TestParse_StaticVarSection_SetsIsClassVar;
procedure TestParse_PlainFieldAfterStaticVar_NotClassVar;
procedure TestParse_PrivateStaticVar_SetsIsClassVar;
procedure TestParse_StaticConstSection_OnClass;
procedure TestParse_StaticConstSection_FollowedByMoreMembers;
{ static method prefix and section }
procedure TestParse_StaticFunctionPrefix_SetsIsStatic;
procedure TestParse_StaticProcedurePrefix_SetsIsStatic;
procedure TestParse_StaticSection_AppliesToMethods;
procedure TestParse_PlainMethodAfterStaticSection_NotStatic;
procedure TestParse_BareStaticKeepsCurrentVisibility;
{ static property }
procedure TestParse_StaticProperty_SetsIsStatic;
{ out-of-line static impl }
procedure TestParse_StaticImpl_OutOfLine;
{ records }
procedure TestParse_StaticFunctionInRecord_SetsIsStatic;
procedure TestParse_StaticVarInRecord_SetsIsClassVar;
procedure TestParse_StaticConstInRecord;
{ rejections }
procedure TestParse_StaticConstructor_Rejected;
procedure TestParse_StaticDestructor_Rejected;
end;
implementation
function TStaticMembersParseTests.ParseSrc(const ASrc: string): TProgram;
var L: TLexer; P: TParser;
begin
L := TLexer.Create(ASrc);
P := TParser.Create(L);
try
Result := P.Parse();
finally
P.Free(); L.Free();
end;
end;
function TStaticMembersParseTests.ClassOf(AProg: TProgram; AIndex: Integer): TClassTypeDef;
var TD: TTypeDecl;
begin
TD := TTypeDecl(AProg.Block.TypeDecls.Items[AIndex]);
Result := TD.Def as TClassTypeDef;
end;
function TStaticMembersParseTests.RecordOf(AProg: TProgram; AIndex: Integer): TRecordTypeDef;
var TD: TTypeDecl;
begin
TD := TTypeDecl(AProg.Block.TypeDecls.Items[AIndex]);
Result := TD.Def as TRecordTypeDef;
end;
procedure TStaticMembersParseTests.ParseExpectError(const ASrc: string);
var Prog: TProgram;
begin
try
Prog := ParseSrc(ASrc);
Prog.Free();
Fail('Expected EParseError');
except
on E: EParseError do ;
end;
end;
procedure TStaticMembersParseTests.ParseExpectErrorMsg(const ASrc, AExpectedSubstr: string);
var Prog: TProgram;
begin
try
Prog := ParseSrc(ASrc);
Prog.Free();
Fail('Expected EParseError');
except
on E: EParseError do
AssertTrue('error message contains "' + AExpectedSubstr + '" (got: ' +
E.Message + ')', Pos(AExpectedSubstr, E.Message) >= 0);
end;
end;
{ ------------------------------------------------------------------ }
{ static var / static const }
{ ------------------------------------------------------------------ }
procedure TStaticMembersParseTests.TestParse_StaticVarSection_SetsIsClassVar;
const
Src =
'''
program P;
type
TFoo = class
static var
FInstance: TFoo;
end;
begin end.
''';
var Prog: TProgram; C: TClassTypeDef; F: TFieldDecl;
begin
Prog := ParseSrc(Src);
try
C := ClassOf(Prog, 0);
AssertEquals('one field', 1, C.Fields.Count);
F := TFieldDecl(C.Fields.Items[0]);
AssertEquals('field name', 'FInstance', F.Names[0]);
AssertTrue('FInstance is a class var', F.IsClassVar);
finally
Prog.Free();
end;
end;
procedure TStaticMembersParseTests.TestParse_PlainFieldAfterStaticVar_NotClassVar;
const
Src =
'''
program P;
type
TFoo = class
static var
FShared: Integer;
public
FInst: Integer;
end;
begin end.
''';
var Prog: TProgram; C: TClassTypeDef;
begin
Prog := ParseSrc(Src);
try
C := ClassOf(Prog, 0);
AssertEquals('two fields', 2, C.Fields.Count);
AssertTrue('FShared is class var', TFieldDecl(C.Fields.Items[0]).IsClassVar);
AssertFalse('FInst is NOT class var (section reset by public)',
TFieldDecl(C.Fields.Items[1]).IsClassVar);
finally
Prog.Free();
end;
end;
procedure TStaticMembersParseTests.TestParse_PrivateStaticVar_SetsIsClassVar;
const
Src =
'''
program P;
type
TFoo = class
private static var
FInstance: TFoo;
end;
begin end.
''';
var Prog: TProgram; C: TClassTypeDef;
begin
Prog := ParseSrc(Src);
try
C := ClassOf(Prog, 0);
AssertEquals('one field', 1, C.Fields.Count);
AssertTrue('private static var is class var',
TFieldDecl(C.Fields.Items[0]).IsClassVar);
finally
Prog.Free();
end;
end;
procedure TStaticMembersParseTests.TestParse_StaticConstSection_OnClass;
const
Src =
'''
program P;
type
TFoo = class
static const
MaxItems = 256;
end;
begin end.
''';
var Prog: TProgram; C: TClassTypeDef;
begin
Prog := ParseSrc(Src);
try
C := ClassOf(Prog, 0);
AssertEquals('one const', 1, C.ConstDecls.Count);
finally
Prog.Free();
end;
end;
procedure TStaticMembersParseTests.TestParse_StaticConstSection_FollowedByMoreMembers;
const
{ A static const section is not the last section: the const block must stop
at the following `private` visibility keyword rather than swallowing it. }
Src =
'''
program P;
type
TFoo = class
private static const
MaxEntries = 256;
private
FCount: Integer;
public
function GetCount: Integer;
end;
begin end.
''';
var Prog: TProgram; C: TClassTypeDef;
begin
Prog := ParseSrc(Src);
try
C := ClassOf(Prog, 0);
AssertEquals('one const', 1, C.ConstDecls.Count);
AssertEquals('one field', 1, C.Fields.Count);
AssertEquals('field name', 'FCount', TFieldDecl(C.Fields.Items[0]).Names[0]);
AssertEquals('one method', 1, C.Methods.Count);
finally
Prog.Free();
end;
end;
{ ------------------------------------------------------------------ }
{ static methods }
{ ------------------------------------------------------------------ }
procedure TStaticMembersParseTests.TestParse_StaticFunctionPrefix_SetsIsStatic;
const
Src =
'''
program P;
type
TFoo = class
static function GetInstance: TFoo;
end;
begin end.
''';
var Prog: TProgram; C: TClassTypeDef; M: TMethodDecl;
begin
Prog := ParseSrc(Src);
try
C := ClassOf(Prog, 0);
AssertEquals('one method', 1, C.Methods.Count);
M := TMethodDecl(C.Methods.Items[0]);
AssertEquals('method name', 'GetInstance', M.Name);
AssertTrue('GetInstance is static', M.IsStatic);
finally
Prog.Free();
end;
end;
procedure TStaticMembersParseTests.TestParse_StaticProcedurePrefix_SetsIsStatic;
const
Src =
'''
program P;
type
TFoo = class
static procedure Reset;
end;
begin end.
''';
var Prog: TProgram; C: TClassTypeDef;
begin
Prog := ParseSrc(Src);
try
C := ClassOf(Prog, 0);
AssertTrue('Reset is static', TMethodDecl(C.Methods.Items[0]).IsStatic);
finally
Prog.Free();
end;
end;
procedure TStaticMembersParseTests.TestParse_StaticSection_AppliesToMethods;
const
Src =
'''
program P;
type
TFoo = class
public static
function A: Integer;
function B: Integer;
end;
begin end.
''';
var Prog: TProgram; C: TClassTypeDef;
begin
Prog := ParseSrc(Src);
try
C := ClassOf(Prog, 0);
AssertEquals('two methods', 2, C.Methods.Count);
AssertTrue('A is static', TMethodDecl(C.Methods.Items[0]).IsStatic);
AssertTrue('B is static', TMethodDecl(C.Methods.Items[1]).IsStatic);
finally
Prog.Free();
end;
end;
procedure TStaticMembersParseTests.TestParse_PlainMethodAfterStaticSection_NotStatic;
const
Src =
'''
program P;
type
TFoo = class
public static
function A: Integer;
public
function B: Integer;
end;
begin end.
''';
var Prog: TProgram; C: TClassTypeDef;
begin
Prog := ParseSrc(Src);
try
C := ClassOf(Prog, 0);
AssertTrue('A is static', TMethodDecl(C.Methods.Items[0]).IsStatic);
AssertFalse('B is NOT static (section reset by public)',
TMethodDecl(C.Methods.Items[1]).IsStatic);
finally
Prog.Free();
end;
end;
procedure TStaticMembersParseTests.TestParse_BareStaticKeepsCurrentVisibility;
const
Src =
'''
program P;
type
TFoo = class
private
FInst: Integer;
static
function A: Integer;
end;
begin end.
''';
var Prog: TProgram; C: TClassTypeDef;
begin
Prog := ParseSrc(Src);
try
C := ClassOf(Prog, 0);
AssertFalse('FInst not class var', TFieldDecl(C.Fields.Items[0]).IsClassVar);
AssertTrue('A is static', TMethodDecl(C.Methods.Items[0]).IsStatic);
finally
Prog.Free();
end;
end;
{ ------------------------------------------------------------------ }
{ static property }
{ ------------------------------------------------------------------ }
procedure TStaticMembersParseTests.TestParse_StaticProperty_SetsIsStatic;
const
Src =
'''
program P;
type
TFoo = class
static function GetInstance: TFoo;
static property Instance: TFoo read GetInstance;
end;
begin end.
''';
var Prog: TProgram; C: TClassTypeDef; Pr: TPropertyDecl;
begin
Prog := ParseSrc(Src);
try
C := ClassOf(Prog, 0);
AssertEquals('one property', 1, C.Properties.Count);
Pr := TPropertyDecl(C.Properties.Items[0]);
AssertEquals('property name', 'Instance', Pr.Name);
AssertTrue('Instance property is static', Pr.IsStatic);
finally
Prog.Free();
end;
end;
{ ------------------------------------------------------------------ }
{ out-of-line static impl }
{ ------------------------------------------------------------------ }
procedure TStaticMembersParseTests.TestParse_StaticImpl_OutOfLine;
const
Src =
'''
program P;
type
TFoo = class
static function GetInstance: TFoo;
end;
static function TFoo.GetInstance: TFoo;
begin
Result := nil;
end;
begin end.
''';
var Prog: TProgram; M: TMethodDecl;
begin
Prog := ParseSrc(Src);
try
{ The out-of-line impl is a standalone proc decl in the block. }
AssertEquals('one standalone proc', 1, Prog.Block.ProcDecls.Count);
M := TMethodDecl(Prog.Block.ProcDecls.Items[0]);
AssertTrue('out-of-line impl is static', M.IsStatic);
finally
Prog.Free();
end;
end;
{ ------------------------------------------------------------------ }
{ records }
{ ------------------------------------------------------------------ }
procedure TStaticMembersParseTests.TestParse_StaticFunctionInRecord_SetsIsStatic;
const
Src =
'''
program P;
type
TInfo = record
Category: string;
static function New(const C: string): TInfo;
end;
begin end.
''';
var Prog: TProgram; R: TRecordTypeDef;
begin
Prog := ParseSrc(Src);
try
R := RecordOf(Prog, 0);
AssertEquals('one method', 1, R.Methods.Count);
AssertTrue('New is static', TMethodDecl(R.Methods.Items[0]).IsStatic);
finally
Prog.Free();
end;
end;
procedure TStaticMembersParseTests.TestParse_StaticVarInRecord_SetsIsClassVar;
const
Src =
'''
program P;
type
TInfo = record
Category: string;
static var
Count: Integer;
end;
begin end.
''';
var Prog: TProgram; R: TRecordTypeDef;
begin
Prog := ParseSrc(Src);
try
R := RecordOf(Prog, 0);
AssertEquals('two fields', 2, R.Fields.Count);
AssertFalse('Category not class var', TFieldDecl(R.Fields.Items[0]).IsClassVar);
AssertTrue('Count is class var', TFieldDecl(R.Fields.Items[1]).IsClassVar);
finally
Prog.Free();
end;
end;
procedure TStaticMembersParseTests.TestParse_StaticConstInRecord;
const
Src =
'''
program P;
type
TInfo = record
X: Integer;
static const
Tag = 7;
end;
begin end.
''';
var Prog: TProgram; R: TRecordTypeDef;
begin
Prog := ParseSrc(Src);
try
R := RecordOf(Prog, 0);
AssertEquals('one const', 1, R.ConstDecls.Count);
finally
Prog.Free();
end;
end;
{ ------------------------------------------------------------------ }
{ rejections }
{ ------------------------------------------------------------------ }
procedure TStaticMembersParseTests.TestParse_StaticConstructor_Rejected;
const
Src =
'''
program P;
type
TFoo = class
static constructor Create;
end;
begin end.
''';
begin
ParseExpectErrorMsg(Src, 'static');
end;
procedure TStaticMembersParseTests.TestParse_StaticDestructor_Rejected;
const
Src =
'''
program P;
type
TFoo = class
static destructor Destroy;
end;
begin end.
''';
begin
ParseExpectErrorMsg(Src, 'static');
end;
{ ================================================================== }
{ Semantic + IR (codegen) tests }
{ ================================================================== }
type
TStaticMembersSemTests = class(TTestCase)
private
function AnalyseSrc(const ASrc: string): TProgram;
function GenIR(const ASrc: string): string;
procedure AnalyseExpectErrorMsg(const ASrc, AExpectedSubstr: string);
published
{ static var resolves to a shared global, not an instance field }
procedure TestSem_StaticVar_BareReadResolves;
procedure TestSem_StaticVar_NotAnInstanceField;
procedure TestSem_StaticVar_RejectsStringType;
procedure TestSem_StaticMethod_NoSelf_CannotTouchInstanceField;
procedure TestSem_StaticMethod_CanReadStaticVar;
{ IR: static var lowers to a single global data slot; static method has
no Self parameter. }
procedure TestIR_StaticVar_EmitsGlobalDataSlot;
procedure TestIR_StaticVar_NoInstanceOffset;
procedure TestIR_StaticMethod_NoSelfParam;
procedure TestIR_Singleton_LazyGetInstance;
procedure TestIR_StaticVar_QualifiedRead_LoadsGlobal;
procedure TestIR_StaticProperty_QualifiedRead_CallsGetter;
procedure TestIR_ClassStaticVar_ReleasedAtExit;
end;
function TStaticMembersSemTests.AnalyseSrc(const ASrc: string): TProgram;
var L: TLexer; P: TParser; A: TSemanticAnalyser;
begin
L := TLexer.Create(ASrc);
P := TParser.Create(L);
try
Result := P.Parse();
finally
P.Free(); L.Free();
end;
A := TSemanticAnalyser.Create();
try
A.Analyse(Result);
finally
A.Free();
end;
end;
function TStaticMembersSemTests.GenIR(const ASrc: string): string;
var Prog: TProgram; CG: TCodeGenQBE;
begin
Prog := AnalyseSrc(ASrc);
try
CG := TCodeGenQBE.Create();
try
CG.Generate(Prog);
Result := CG.GetOutput();
finally
CG.Free();
end;
finally
Prog.Free();
end;
end;
procedure TStaticMembersSemTests.AnalyseExpectErrorMsg(const ASrc, AExpectedSubstr: string);
var Prog: TProgram;
begin
try
Prog := AnalyseSrc(ASrc);
Prog.Free();
Fail('Expected ESemanticError');
except
on E: ESemanticError do
AssertTrue('error message contains "' + AExpectedSubstr + '" (got: ' +
E.Message + ')', Pos(AExpectedSubstr, E.Message) >= 0);
end;
end;
procedure TStaticMembersSemTests.TestSem_StaticVar_BareReadResolves;
const
Src =
'''
program P;
type
TFoo = class
private static var
FCount: Integer;
static procedure Bump;
end;
static procedure TFoo.Bump;
begin
FCount := FCount + 1;
end;
begin end.
''';
var Prog: TProgram;
begin
{ Just analysing without an "undeclared identifier" error proves the bare
static-var name resolves inside a static method. }
Prog := AnalyseSrc(Src);
Prog.Free();
end;
procedure TStaticMembersSemTests.TestSem_StaticVar_NotAnInstanceField;
const
Src =
'''
program P;
type
TFoo = class
private static var
FShared: Integer;
public
FInst: Integer;
end;
var
F: TFoo;
begin
F := TFoo.Create();
F.FInst := 7;
end.
''';
var Prog: TProgram; RT: TRecordTypeDesc; Sym: TSymbol;
begin
Prog := AnalyseSrc(Src);
try
Sym := Prog.SymbolTable.Lookup('TFoo');
AssertNotNull('TFoo type present', Sym);
RT := TRecordTypeDesc(Sym.TypeDesc);
{ The class has exactly ONE instance field (FInst); FShared is a static
var and must NOT occupy an instance slot. }
AssertNotNull('FInst is an instance field', RT.FindField('FInst'));
AssertNull('FShared is NOT an instance field', RT.FindField('FShared'));
finally
Prog.Free();
end;
end;
procedure TStaticMembersSemTests.TestSem_StaticVar_RejectsStringType;
const
Src =
'''
program P;
type
TFoo = class
private static var
FName: string;
end;
begin end.
''';
begin
{ String (and dynamic-array) static vars remain deferred; class and
interface are supported (see TestSem_StaticVar_AcceptsClassType). }
AnalyseExpectErrorMsg(Src, 'static var');
end;
procedure TStaticMembersSemTests.TestSem_StaticMethod_NoSelf_CannotTouchInstanceField;
const
Src =
'''
program P;
type
TFoo = class
public
FInst: Integer;
static procedure Bad;
end;
static procedure TFoo.Bad;
begin
FInst := 1;
end;
begin end.
''';
begin
{ A static method has no Self, so an instance field is not in scope. }
AnalyseExpectErrorMsg(Src, 'FInst');
end;
procedure TStaticMembersSemTests.TestSem_StaticMethod_CanReadStaticVar;
const
Src =
'''
program P;
type
TFoo = class
private static var
FCount: Integer;
public
static function GetCount: Integer;
end;
static function TFoo.GetCount: Integer;
begin
Result := FCount;
end;
begin end.
''';
var Prog: TProgram;
begin
Prog := AnalyseSrc(Src);
Prog.Free();
end;
procedure TStaticMembersSemTests.TestIR_StaticVar_EmitsGlobalDataSlot;
const
Src =
'''
program P;
type
TFoo = class
private static var
FCount: Integer;
static procedure Bump;
end;
static procedure TFoo.Bump;
begin
FCount := FCount + 1;
end;
begin end.
''';
var IR: string;
begin
IR := GenIR(Src);
{ A single shared global data slot named TFoo_FCount must be emitted. }
AssertTrue('emits $TFoo_FCount data slot (IR: ' + Copy(IR, 0, 400) + ')',
Pos('data $TFoo_FCount', IR) >= 0);
end;
procedure TStaticMembersSemTests.TestIR_StaticVar_NoInstanceOffset;
const
Src =
'''
program P;
type
TFoo = class
private static var
FCount: Integer;
static procedure Bump;
end;
static procedure TFoo.Bump;
begin
FCount := FCount + 1;
end;
begin end.
''';
var IR: string;
begin
IR := GenIR(Src);
{ The static var read/write must reference the global $TFoo_FCount, not an
instance-offset load from a Self pointer. }
AssertTrue('references $TFoo_FCount global',
Pos('$TFoo_FCount', IR) >= 0);
end;
procedure TStaticMembersSemTests.TestIR_StaticMethod_NoSelfParam;
const
Src =
'''
program P;
type
TFoo = class
private static var
FCount: Integer;
static procedure Bump;
end;
static procedure TFoo.Bump;
begin
FCount := FCount + 1;
end;
begin end.
''';
var IR: string; FnPos: Integer;
begin
IR := GenIR(Src);
FnPos := Pos('function $TFoo_Bump(', IR);
if FnPos < 0 then
FnPos := Pos('$TFoo_Bump(', IR);
AssertTrue('TFoo_Bump function emitted', FnPos >= 0);
{ The signature must NOT contain %_par_Self. }
AssertFalse('static method has no Self parameter',
Pos('%_par_Self', Copy(IR, FnPos, 60)) >= 0);
end;
procedure TStaticMembersSemTests.TestIR_Singleton_LazyGetInstance;
const
Src =
'''
program P;
type
TFoo = class
private static var
FInstanceId: Integer;
public
static function GetId: Integer;
end;
static function TFoo.GetId: Integer;
begin
if FInstanceId = 0 then
FInstanceId := 42;
Result := FInstanceId;
end;
begin end.
''';
var IR: string;
begin
IR := GenIR(Src);
AssertTrue('static var global slot present',
Pos('data $TFoo_FInstanceId', IR) >= 0);
end;
procedure TStaticMembersSemTests.TestIR_StaticVar_QualifiedRead_LoadsGlobal;
const
Src =
'''
program P;
type
TFoo = class
public static var
Total: Integer;
static procedure Bump;
end;
static procedure TFoo.Bump;
begin
Total := Total + 1;
end;
var n: Integer;
begin
n := TFoo.Total;
end.
''';
var IR: string;
begin
IR := GenIR(Src);
{ A qualified read TFoo.Total must load the SAME mangled global slot, not
dereference an instance. }
AssertTrue('qualified read loads $TFoo_Total (IR: ' + Copy(IR, 0, 600) + ')',
Pos('loadw $TFoo_Total', IR) >= 0);
end;
procedure TStaticMembersSemTests.TestIR_StaticProperty_QualifiedRead_CallsGetter;
const
Src =
'''
program P;
type
TFoo = class
private static var
FCount: Integer;
public
static function NextId: Integer;
static property Counter: Integer read NextId;
end;
static function TFoo.NextId: Integer;
begin
FCount := FCount + 1;
Result := FCount;
end;
var n: Integer;
begin
n := TFoo.Counter;
end.
''';
var IR: string;
begin
IR := GenIR(Src);
AssertTrue('static prop read calls $TFoo_NextId() with no Self (IR: ' +
Copy(IR, 0, 800) + ')',
Pos('call $TFoo_NextId()', IR) >= 0);
end;
procedure TStaticMembersSemTests.TestIR_ClassStaticVar_ReleasedAtExit;
const
Src =
'''
program P;
type
TFoo = class
private static var
FInst: TFoo;
public
static procedure Init;
end;
static procedure TFoo.Init;
begin
if FInst = nil then
FInst := TFoo.Create();
end;
begin
TFoo.Init();
end.
''';
var IR: string;
begin
IR := GenIR(Src);
{ A class-typed static var holds one retained reference; the program-exit
cleanup at @main_exit must release the shared global slot. }
AssertTrue('static var class slot present',
Pos('data $TFoo_FInst', IR) >= 0);
AssertTrue('static var released at @main_exit',
(Pos('@main_exit', IR) >= 0) and (Pos('loadl $TFoo_FInst', IR) >= 0));
end;
initialization
RegisterTest(TStaticMembersParseTests);
RegisterTest(TStaticMembersSemTests);
end.

6
compiler/src/test/pascal/cp.test.unitinterface.pas
View file

@ -2681,9 +2681,11 @@ begin
Iface := TUnitInterface.Create('U');
try
Buf := WriteUnitInterface(Iface);
{ Blaise Pos is 0-based; match-at-start returns 0. }
{ Blaise Pos is 0-based; match-at-start returns 0. Version is 3 since the
static-members fields (IsClassVar/ClassVarEmitName, property IsStatic,
record/class ConstDecls) were added to the encoded layout. }
AssertTrue('starts with magic',
Pos('BLAISE-IFACE 2', Buf) = 0);
Pos('BLAISE-IFACE 3', Buf) = 0);
finally
Iface.Free();
end;

63
docs/grammar.ebnf
View file

@ -269,13 +269,17 @@ IntSubrange
* enum-bounded subranges (TLow..THigh, red..blue) are not a named-type form. *)
RecordDef
= [ PACKED ] RECORD { FieldDecl | MethodDecl } END
= [ PACKED ] RECORD { VisibilitySection | FieldDecl | MethodDecl | ConstSection } END
;
(* Records may declare methods alongside fields. Method bodies are written
* out-of-line as TRecordName.MethodName, identical to classes. The
* receiver is passed by pointer (`Self` is a `var` parameter under the hood);
* the language gives normal value semantics — assignments copy the record.
* out-of-line as TRecordName.MethodName, identical to classes. An ordinary
* record method receives the receiver by pointer (`Self` is a `var` parameter
* under the hood); the language gives normal value semantics — assignments
* copy the record. A method declared STATIC (see VisibilitySection /
* MethodDecl) receives no `Self` and is the record's factory / namespaced
* function form, called as TRecordName.Method(...). Records may also carry
* STATIC VAR / STATIC CONST members.
* No constructors, destructors, or virtual methods are allowed in records.
*
* `packed` is permitted only in front of `record`. It disables natural
@ -289,11 +293,34 @@ RecordDef
ClassDef
= CLASS [ LPAREN GenericName { COMMA GenericName } RPAREN ]
{ ConstSection | FieldList }
MethodDeclList
{ VisibilitySection | ConstSection | FieldList | MethodDeclList }
END
;
(* A class body is a sequence of members in any order, optionally grouped under
* visibility / storage sections. A VisibilitySection keyword sets the current
* visibility (and, with STATIC, the current member-association) for every
* member that follows until the next such keyword. *)
VisibilitySection
= ( PRIVATE | PROTECTED | PUBLIC | PUBLISHED ) [ STATIC ]
| STATIC (* STATIC alone keeps current visibility *)
;
(* STATIC as a section qualifier (e.g. `private static`, or a bare `static`
* continuing the current visibility) makes every field, const, method, and
* property declared until the next section keyword a type-associated (class-
* level) member: no implicit Self, a single shared storage slot for vars/
* consts. STATIC may equally be written as a per-member prefix on a single
* method or property (see MethodDecl / PropertyDecl). `private static var`
* and `private static const` are the section forms for static fields and
* static constants. There is no `class var` / `class function` /
* `class property` — the word `class` is never a member qualifier in Blaise.
*
* Visibility keywords (PRIVATE/PROTECTED/PUBLIC/PUBLISHED) and STATIC are
* contextual: outside a class/record body they remain usable as identifiers,
* except those already reserved elsewhere. *)
GenericName
= IDENT [ LESS TypeArgList GREATER ] (* plain name or generic specialisation *)
;
@ -363,7 +390,8 @@ MethodDeclList
;
MethodDecl
= ( PROCEDURE | FUNCTION | CONSTRUCTOR | DESTRUCTOR ) IDENT
= [ STATIC ] (* per-member static prefix (no implicit Self) *)
( PROCEDURE | FUNCTION | CONSTRUCTOR | DESTRUCTOR ) IDENT
[ LESS TypeParamList GREATER ] (* optional generic type params *)
[ LPAREN ParamList RPAREN ]
[ COLON TypeName ] (* return type for functions *)
@ -372,6 +400,12 @@ MethodDecl
[ ( Block | AsmBlock ) SEMICOLON ] (* body absent for forward, external, or abstract decls *)
;
(* A STATIC method (whether via the per-member prefix here or an enclosing
* STATIC VisibilitySection) takes no implicit Self. CONSTRUCTOR / DESTRUCTOR
* may NOT be declared STATIC: Blaise has no type-initialiser construct (no
* `class constructor`); eager one-time setup belongs in the unit
* initialization / finalization sections. See language-rationale.adoc. *)
MethodDirective
= VIRTUAL
| OVERRIDE
@ -401,9 +435,13 @@ ExternalDirective
= EXTERNAL [ NAME StrLit ]
;
(* Standalone procedure/function/constructor/destructor — top-level or within a block. *)
(* Standalone procedure/function/constructor/destructor — top-level or within a block.
* A leading STATIC marks an out-of-line static-method implementation
* (`static function TName.Method ...`); it must agree with the in-class
* declaration's static-ness and takes no implicit Self. *)
StandaloneDecl
= ( PROCEDURE | FUNCTION | CONSTRUCTOR | DESTRUCTOR ) IDENT
= [ STATIC ]
( PROCEDURE | FUNCTION | CONSTRUCTOR | DESTRUCTOR ) IDENT
[ DOT IDENT ] (* TTypeName.MethodName — non-generic class impl *)
[ LESS TypeParamList GREATER DOT IDENT ] (* TName<T>.MethodName — generic class impl *)
[ LESS TypeParamList GREATER ] (* function Identity<T> — generic standalone *)
@ -437,7 +475,8 @@ MethodSignatureList
;
PropertyDecl
= "property" IDENT
= [ STATIC ] (* per-member static prefix *)
"property" IDENT
[ LBRACKET IDENT COLON TypeName RBRACKET ] (* optional index parameter *)
COLON TypeName
[ "read" IDENT ]
@ -446,6 +485,10 @@ PropertyDecl
[ "default" SEMICOLON ] (* default array property *)
;
(* A STATIC property (via the prefix here or an enclosing STATIC section) is
* sugar over a STATIC getter/setter: it occupies no slot and dispatches with
* no Self. A static property's accessors must themselves be static. *)
(* If the index parameter is present, the property is indexed:
* property Items[Index: Integer]: Pointer read Get write Put;
* Indexed reads emit a getter call with one extra argument (the index).

259
docs/language-rationale.adoc
View file

@ -5341,3 +5341,262 @@ the reference and definition sites would disagree.
context.* Heavier plumbing for the same effect; the analyser already owns one
shared table that carries every unit's symbols, so scoping the *view* to the
emitted unit is the smaller, sufficient change.
== `static` Class Members — One Keyword, No `class`-Keyword Overload
=== Decision
Type-associated (class-level) members — fields, constants, methods, and
properties that belong to the type itself rather than to an instance — are
declared with the `static` keyword:
[source,pascal]
----
type
TRegistry = class
private static var
FInstance: TRegistry; { one shared slot, not per-instance }
private static const
MaxEntries = 256;
private
FItems: TList<TEntry>; { ordinary instance field }
static function GetInstance: TRegistry; { no Self; type-associated }
function GetItem(I: Integer): TEntry; { ordinary instance method }
public
static property Instance: TRegistry read GetInstance;
property Items[I: Integer]: TEntry read GetItem;
end;
static function TRegistry.GetInstance: TRegistry; { out-of-line impl }
begin
if FInstance = nil then
FInstance := TRegistry.Create(); { lazy singleton }
Result := FInstance;
end;
----
`static` may appear in two positions:
* as a *section qualifier* — `private static var`, `public static const`,
`protected static` — applying to every member declared until the next
visibility or section keyword; and
* as a *member prefix* — `static function`, `static procedure`,
`static property` — applying to that one member.
A `static` member receives no implicit `Self`. A `static var` / `static const`
occupies a single shared storage slot for the whole type, addressed as a
global; it does not advance the instance layout and is not copied per object.
A `static function` / `static procedure` is an ordinary routine that happens to
be name-qualified by its owning type and may read the type's other `static`
members. A `static property` is pure sugar over a `static` getter/setter.
Inside a record, a method declared `static` is the record's factory /
namespaced-function form — it takes no hidden `Self` pointer and is called as
`RecType.Method(...)`. (An ordinary record method still receives `Self` by
pointer; see <<_record_methods>>.) Records may also carry `static var` and
`static const` members.
Blaise has *no* `class` keyword in member position. The word `class` appears
only where it introduces a reference type (`T = class`), never as a member
qualifier. There is also no `static constructor` / `static destructor` — see
_No type-initialiser construct_ below.
=== Rationale
Delphi and FPC overload the single word `class` into three unrelated meanings:
the reference-type introducer (`T = class`), the member-association qualifier
(`class var`, `class function`, `class property`), and the type-initialiser
form (`class constructor`, `class destructor`). The three concepts have nothing
in common; sharing one keyword forces the reader to disambiguate by position
every time. Blaise has no existing source to keep compatible, so it splits the
concerns: `class` keeps only its structural meaning, and `static` carries the
member-association meaning it already carries in Java, C#, Swift, Rust, Go, and
Kotlin (`companion`/`static`). One keyword, one meaning.
The member-association concept is genuinely needed: the canonical singleton /
registry pattern (a private shared instance reached through a type-level
accessor) cannot be expressed with instance members alone. `static`
delivers it with a single, universally-understood keyword.
==== No type-initialiser construct (`static`/`class constructor`)
Blaise deliberately omits Delphi's `class constructor` / `class destructor`
(the run-once-at-startup type initialiser and its teardown counterpart). The
construct is unnecessary in Blaise because the two jobs it does are already
covered:
* *Zeroing a `static var`.* Blaise guarantees every variable — including
globals — holds its zero value before any code runs (see
<<_zero_initialisation_of_variables>>). A `static var FInstance: TRegistry`
is therefore `nil` at startup with no initialiser. Delphi needs the type
constructor here only because it makes no such guarantee.
* *Non-trivial one-time setup or teardown.* A lazy singleton initialises itself
on first access inside its `static` getter (the `if FInstance = nil` pattern
above); eager setup or teardown that genuinely must run once belongs in the
unit's existing `initialization` / `finalization` sections, which live in the
implementation section where code is permitted and run once in dependency
order. This is exactly Go's package-level `init()` model.
Re-using the spelling `static constructor Create` was rejected for the same
reason `class` was: it overloads `constructor` for something that is not a
callable constructor (it takes no arguments, is never invoked by name, and
cannot be overloaded). A nameless `static begin … end` initialiser block (the
Java/Kotlin shape) was also rejected: Pascal forbids code in the interface
section, where the class declaration lives, so an inline initialiser block
there would be alien to the language. The unit `initialization` section is the
idiomatic Pascal home and needs no new syntax.
=== Cross-language comparison
[cols="1,1,1,1,2", options="header"]
|===
| Language | Static field | Static method | Static property | Type initialiser
| *Blaise*
| `static var`
| `static function`
| `static property`
| none — zero-init + unit `initialization`
| Java
| `static`
| `static`
| (getter)
| `static { }` block (lazy)
| C#
| `static`
| `static`
| `static P { }`
| `static TFoo()` static constructor (lazy)
| Swift
| `static let/var`
| `static func`
| `static var { }`
| none — `static let` lazily initialised per-field
| Rust
| `static` / assoc `const`
| assoc `fn` (no `self`)
| (none)
| none — `static` is const-expr; lazy is library-level
| Go
| package `var`
| package func
| (none)
| `func init()` (package, once at startup)
| Kotlin
| `companion object`
| companion `fun`
| companion `val/var`
| companion `init { }`
| Delphi / FPC / Oxygene
| `class var`
| `class function`
| `class property`
| `class constructor` (lazy)
|===
The languages divide on the type-initialiser question. Java, C#, Kotlin, and
the Delphi family provide an explicit type-constructor block because a static
field can be left null/indeterminate and the programmer must run code to
populate it. Swift, Rust, and Go barely need one — either every static is
zero/const-initialised by the language, or lazy init is a per-field runtime
feature. Blaise sits with the second group precisely because of its zero-init
guarantee, so it follows Swift/Rust/Go and omits the type-constructor entirely
rather than following the Java/C#/Delphi machinery.
=== Visibility
`static` is orthogonal to visibility. It composes with `private`,
`protected`, and `public` (and, once visibility enforcement lands, with
`strict private`). `static` governs *storage and dispatch* — where the slot
lives and whether `Self` is passed — not *who may see the member*. The two
are independent axes and are implemented as independent features (see
<<_member_visibility_enforcement_private_protected_strict>>).
=== Alternatives rejected
* *Keep Delphi's `class var` / `class function` / `class property`.* Rejected.
It preserves the `class`-keyword overload that is the whole confusion this
decision removes, for no compatibility benefit Blaise can collect.
* *Infer static-ness of a record method from whether its body touches `Self`.*
Rejected. The hidden-`Self` ABI would then flip silently when an edit adds or
removes a `Self` reference. `static` makes the calling convention explicit at
the declaration. (See <<_record_methods>>.)
* *Adopt a `static constructor` or `static begin … end` type initialiser.*
Rejected — see _No type-initialiser construct_ above.
== Member Visibility Enforcement — `private` / `protected` / `strict`
=== Status
_Decided; implemented as the second half of the static-members work. This entry
records the decision; the spelling and enforcement rules below are the
committed design._
=== Decision
Visibility modifiers on class and record members are *enforced*, not merely
parsed. A member declared `private` is visible only within the unit that
declares the owning type; a `protected` member is additionally visible within
descendant types; a `public` (or `published`) member is visible everywhere the
type is. Blaise additionally supports `strict private` and `strict protected`,
which narrow visibility to the declaring *type* itself (and, for
`strict protected`, its descendants) rather than the whole declaring unit.
`strict` composes with `static`: `strict private static var FInstance: TFoo;`
is permitted, exactly as in Delphi. The `strict`-ness (who may see the member)
is independent of the `static`-ness (where the slot lives and whether `Self`
is passed).
A non-`strict` `private` member remains visible to the unit's
`initialization` / `finalization` sections and to other code in the same unit,
because those sections are part of the declaring unit. A `strict private`
member is *not* visible to them — it is reachable only from the methods of the
declaring type. This is the one interaction point between visibility and the
static-members feature: a `static var` that the unit `initialization` section
must populate eagerly must therefore not be `strict private`.
=== Rationale
Before this change, Blaise parsed `private` / `protected` / `published` but
enforced none of them, and had no `strict` keyword at all. `private` was
effectively a comment. Enforcing visibility closes a real gap — a unit's
internal class members were silently part of its usable surface — and makes the
`static` singleton pattern honest: a `private static var FInstance` can now be
genuinely unreachable from outside while the `public static property Instance`
is the sole entry point.
`strict` is included because the unit-scoped `private` of classic Pascal is
looser than most programmers coming from Java, C#, Swift, or Rust expect; those
languages scope `private` to the *type*. Offering both the Pascal unit-scoped
`private` and the type-scoped `strict private` lets the author choose, matching
Delphi and FPC.
=== Implementation order
Visibility enforcement lands *after* the `static`-members feature, as a
separate commit. Static members are on the critical path (they unblock real
code and exercise the codegen/OPDF stack); visibility enforcement is a pure
rejection pass with no codegen impact, and is cleaner to write once against the
complete, final set of member kinds (instance and static fields, methods, and
properties) than to write first and revisit when `static` arrives.
=== Alternatives rejected
* *Leave visibility unenforced (status quo).* Rejected — `private` that
protects nothing is a latent footgun and undermines the `static` singleton
pattern's encapsulation.
* *Enforce only the unit-scoped `private` (no `strict`).* Rejected — the
type-scoped `strict private` is the form most non-Pascal programmers expect,
and omitting it would force every genuinely type-private member to leak to
the whole unit.
* *Bundle visibility enforcement into the static-members commit.* Rejected —
the two are independent axes; sequencing them keeps each commit focused and
lets the codegen-touching feature accumulate field exposure first.

71
tools/bif-coverage/bif-coverage.status
View file

@ -68,34 +68,37 @@ TFieldAccessExpr.IsVarParam safe
TFieldAccessExpr.PropIndexExpr serialise
TFieldAccessExpr.IsCharAccess safe
TFieldAccessExpr.IsArrayAccess safe
TFieldAccessExpr.IsClassVarRead safe
TFieldAccessExpr.ClassVarEmitName safe
TFieldAccessExpr.IsStaticPropGet safe
# TIsExpr (uAST.pas:151)
# TIsExpr (uAST.pas:154)
TIsExpr.Obj serialise
TIsExpr.TypeName serialise
# TAsExpr (uAST.pas:159)
# TAsExpr (uAST.pas:162)
TAsExpr.Obj serialise
TAsExpr.TypeName serialise
# TSupportsExpr (uAST.pas:168)
# TSupportsExpr (uAST.pas:171)
TSupportsExpr.Obj serialise
TSupportsExpr.IntfTypeName serialise
TSupportsExpr.OutVarName serialise
TSupportsExpr.OutVarIsGlobal safe
# TInheritedCallExpr (uAST.pas:182)
# TInheritedCallExpr (uAST.pas:185)
TInheritedCallExpr.Name serialise
TInheritedCallExpr.Args serialise
# TBinaryExpr (uAST.pas:199)
# TBinaryExpr (uAST.pas:202)
TBinaryExpr.Op serialise
TBinaryExpr.Left serialise
TBinaryExpr.Right serialise
# TNotExpr (uAST.pas:207)
# TNotExpr (uAST.pas:210)
TNotExpr.Expr serialise
# TAssignment (uAST.pas:219)
# TAssignment (uAST.pas:222)
TAssignment.Name serialise
TAssignment.Expr serialise
TAssignment.IsVarParam safe
@ -104,26 +107,26 @@ TAssignment.IsThreadVar safe
TAssignment.IsWeakLhs safe
TAssignment.ImplicitSelfField safe
# TIfStmt (uAST.pas:235)
# TIfStmt (uAST.pas:238)
TIfStmt.Condition serialise
TIfStmt.ThenStmt serialise
TIfStmt.ElseStmt serialise
# TCompoundStmt (uAST.pas:243)
# TCompoundStmt (uAST.pas:246)
TCompoundStmt.Stmts serialise
# TAsmStmt (uAST.pas:255)
# TAsmStmt (uAST.pas:256)
TAsmStmt.Code serialise
# TWhileStmt (uAST.pas:250)
# TWhileStmt (uAST.pas:261)
TWhileStmt.Condition serialise
TWhileStmt.Body serialise
# TRepeatStmt (uAST.pas:257)
# TRepeatStmt (uAST.pas:268)
TRepeatStmt.Body serialise
TRepeatStmt.Condition serialise
# TForStmt (uAST.pas:264)
# TForStmt (uAST.pas:275)
TForStmt.VarName serialise
TForStmt.IsGlobal safe
TForStmt.StartExpr serialise
@ -131,7 +134,7 @@ TForStmt.EndExpr serialise
TForStmt.IsDownTo serialise
TForStmt.Body serialise
# TForInStmt (uAST.pas:275)
# TForInStmt (uAST.pas:286)
TForInStmt.VarName serialise
TForInStmt.VarIsGlobal safe
TForInStmt.CollExpr serialise
@ -151,34 +154,34 @@ TForInStmt.SetBitCount safe
TForInStmt.SetMaskVarName safe
TForInStmt.SetIsJumbo safe
# TTryFinallyStmt (uAST.pas:312)
# TTryFinallyStmt (uAST.pas:323)
TTryFinallyStmt.TryBody serialise
TTryFinallyStmt.FinallyBody serialise
# TTryExceptStmt (uAST.pas:329)
# TTryExceptStmt (uAST.pas:340)
TTryExceptStmt.TryBody serialise
TTryExceptStmt.Handlers serialise
TTryExceptStmt.ElseBody serialise
TTryExceptStmt.ExceptBody serialise
# TRaiseStmt (uAST.pas:342)
# TRaiseStmt (uAST.pas:353)
TRaiseStmt.Expr serialise
# TExitStmt (uAST.pas:353)
# TExitStmt (uAST.pas:364)
TExitStmt.Value serialise
TExitStmt.ResultAssign safe
# TBreakStmt (uAST.pas:361)
# TBreakStmt (uAST.pas:372)
# TContinueStmt (uAST.pas:364)
# TContinueStmt (uAST.pas:375)
# TCaseStmt (uAST.pas:375)
# TCaseStmt (uAST.pas:386)
TCaseStmt.Selector serialise
TCaseStmt.Branches serialise
TCaseStmt.ElseStmt serialise
TCaseStmt.IsStringCase safe
# TFieldAssignment (uAST.pas:386)
# TFieldAssignment (uAST.pas:397)
TFieldAssignment.RecordName serialise
TFieldAssignment.FieldName serialise
TFieldAssignment.Expr serialise
@ -193,7 +196,7 @@ TFieldAssignment.PropOwnerType safe
TFieldAssignment.PropAccessorVSlot safe
TFieldAssignment.IsElemWrite safe
# TStaticSubscriptAssign (uAST.pas:414)
# TStaticSubscriptAssign (uAST.pas:425)
TStaticSubscriptAssign.ArrayName serialise
TStaticSubscriptAssign.IndexExpr serialise
TStaticSubscriptAssign.ValueExpr serialise
@ -204,11 +207,11 @@ TStaticSubscriptAssign.IsImplicitSelf safe
TStaticSubscriptAssign.PropOwnerType safe
TStaticSubscriptAssign.PropAccessorVSlot safe
# TPointerWriteStmt (uAST.pas:444)
# TPointerWriteStmt (uAST.pas:455)
TPointerWriteStmt.PtrExpr serialise
TPointerWriteStmt.ValExpr serialise
# TProcCall (uAST.pas:452)
# TProcCall (uAST.pas:463)
TProcCall.Name serialise
TProcCall.Args serialise
TProcCall.IsImplicitSelfMethod safe
@ -216,7 +219,7 @@ TProcCall.IsIndirectCall safe
TProcCall.IndirectCallIsGlobal safe
TProcCall.IsProcFieldCall safe
# TFuncCallExpr (uAST.pas:465)
# TFuncCallExpr (uAST.pas:480)
TFuncCallExpr.Name serialise
TFuncCallExpr.Args serialise
TFuncCallExpr.IsImplicitSelfMethod safe
@ -227,18 +230,18 @@ TFuncCallExpr.HasClassAttrClass safe
TFuncCallExpr.HasClassAttrAttr safe
TFuncCallExpr.IsProcFieldCall safe
# TIndirectFuncCallExpr (uAST.pas:491)
# TIndirectFuncCallExpr (uAST.pas:510)
TIndirectFuncCallExpr.CalleeExpr serialise
TIndirectFuncCallExpr.Args serialise
# TDerefExpr (uAST.pas:501)
# TDerefExpr (uAST.pas:520)
TDerefExpr.Expr serialise
# TAddrOfExpr (uAST.pas:508)
# TAddrOfExpr (uAST.pas:527)
TAddrOfExpr.Expr serialise
TAddrOfExpr.ResolvedFreeRoutine safe
# TMethodCallStmt (uAST.pas:520)
# TMethodCallStmt (uAST.pas:539)
TMethodCallStmt.ObjectName serialise
TMethodCallStmt.Name serialise
TMethodCallStmt.Args serialise
@ -249,19 +252,21 @@ TMethodCallStmt.IsVarParam safe
TMethodCallStmt.IsBuiltinToString safe
TMethodCallStmt.IsConstructorCall safe
TMethodCallStmt.IsMetaclassDispatch safe
TMethodCallStmt.IsStaticCall safe
TMethodCallStmt.IsProcFieldCall safe
# TInheritedCallStmt (uAST.pas:554)
# TInheritedCallStmt (uAST.pas:576)
TInheritedCallStmt.Name serialise
TInheritedCallStmt.Args serialise
# TMethodCallExpr (uAST.pas:839)
# TMethodCallExpr (uAST.pas:881)
TMethodCallExpr.ObjectName serialise
TMethodCallExpr.Name serialise
TMethodCallExpr.Args serialise
TMethodCallExpr.ObjExpr serialise
TMethodCallExpr.IsConstructorCall safe
TMethodCallExpr.IsMetaclassDispatch safe
TMethodCallExpr.IsStaticCall safe
TMethodCallExpr.IsGlobal safe
TMethodCallExpr.IsVarParam safe
TMethodCallExpr.IsBuiltinToString safe
@ -305,7 +310,7 @@ TUnitInterface.UsedUnits serialise
TUnitInterface.ImplUsedUnits serialise
TUnitInterface.HasInitialization serialise
# TMethodParam (uAST.pas:764)
# TMethodParam (uAST.pas:798)
TMethodParam.ParamName serialise
TMethodParam.TypeName serialise
TMethodParam.IsVarParam serialise

6
tools/bif-coverage/src/main/pascal/BifCoverage.pas
View file

@ -357,7 +357,7 @@ begin
Tok := ReadIdent(Stripped, P);
if Tok = '' then
begin
Result.Clear;
Result.Clear();
Exit;
end;
Result.Add(Tok);
@ -372,7 +372,7 @@ begin
(* Must be followed by `:` then a type, then a `;` somewhere. *)
if (P >= Len) or (StrAt(Stripped, P) <> Ord(':')) then
begin
Result.Clear;
Result.Clear();
Exit;
end;
end;
@ -515,7 +515,7 @@ begin
Allow.Add(GIfaceTypes[I]);
ScanClassFile(GIfaceFile, GIfaceNames, GIfaceObjs, Allow);
Allow.Clear;
Allow.Clear();
Allow.Add('TMethodParam');
ScanClassFile(GAstFile, GIfaceNames, GIfaceObjs, Allow);
end;