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

feat(lang): carry static members across separately-compiled units

Browse source 
Follow-up to the within-unit static-members feature (0977dc16).  Static
class/record members declared in one unit can now be used from another through
the compiled `.bif` interface (the `--unit-cache` / separate-compilation path),
not only when every unit is recompiled from source.

The `.bif` wire format already carried most static facts; the values were being
dropped by consumers around the serialiser:

* Export clones — CloneFieldDecl / ClonePropertyDecl / CloneMethodDecl now copy
  IsClassVar / ClassVarEmitName, property IsStatic, and method IsStatic.  The
  same clone gap silently broke the pre-existing IsWeak / IsDefault round-trip
  ([Weak] fields and `default` properties exported as plain) — fixed here too.
* Method static-ness — TRoutineSig gained an IsStatic field (a final non-virtual
  instance method and a static method both carry VTableSlot = -1, so a dedicated
  flag is required).  Populated on export, encoded/decoded symmetrically
  (BLAISE-IFACE version 3 -> 4), and applied to the synthesised TMethodDecl on
  import so `TypeName.StaticMethod()` resolution succeeds.
* Import — ImportClassEntry / ImportRecordEntry register an imported static var
  as the shared global (bare + qualified skVariable symbols carrying the
  *decoded* GlobalEmitName, never recomputed — the importing unit's prefix
  differs), carry property IsStatic onto TPropertyInfo, and import the type's
  static ConstDecls so `TFoo.MaxItems` resolves.
* Parser — out-of-line `static function T.M` bodies in a unit's implementation
  section are now parsed (mirrors the program-level standalone path).

Tests: TestStaticMembers_CrossUnit_QBE / _Native in cp.test.e2e.sepcompile
(cold + warm `--unit-cache` round-trip, both backends), and
TestRoundTrip_StaticMembers_Preserved /
TestRoundTrip_WeakField_And_DefaultProperty_Preserved in cp.test.unitinterface.
Full suite green on QBE- and native-built runners (3912 tests); all fixpoints
pass (incl. warmcache, which exercises the .bif round-trip); bif-coverage clean.
This commit is contained in:
Graeme Geldenhuys 2026-06-28 16:35:36 +01:00
parent 0977dc16cb
commit 02de7b694a
9 changed files with 424 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -2269,6 +2269,15 @@ begin
Result.Names.Add(ASrc.Names.Strings[I]);
for I := 0 to ASrc.Attributes.Count - 1 do
Result.Attributes.Add(ASrc.Attributes.Strings[I]);
{ Carry the resolved semantic flags through the export clone. Without
these, the .bif encoder sees defaults: a [Weak]/[Unretained] field
round-trips as a plain owning field, and a `static var` loses both its
class-var marker and its mangled emit label — so a cross-unit consumer
cannot register the shared global. }
Result.IsWeak := ASrc.IsWeak;
Result.IsUnretained := ASrc.IsUnretained;
Result.IsClassVar := ASrc.IsClassVar;
Result.ClassVarEmitName := ASrc.ClassVarEmitName;
end;
function ClonePropertyDecl(ASrc: TPropertyDecl): TPropertyDecl;
@ -2280,6 +2289,10 @@ begin
Result.WriteName := ASrc.WriteName;
Result.IndexParamName := ASrc.IndexParamName;
Result.IndexTypeName := ASrc.IndexTypeName;
{ IsDefault round-trips the `default` directive; IsStatic marks a static
property whose accessors take no Self. Both were silently dropped. }
Result.IsDefault := ASrc.IsDefault;
Result.IsStatic := ASrc.IsStatic;
end;
function CloneTypeDecl(ASrc: TTypeDecl): TTypeDecl;
@ -2394,6 +2407,10 @@ begin
Result.ExternalName := ASrc.ExternalName;
Result.CallingConv := ASrc.CallingConv;
Result.IsRecordMethod := ASrc.IsRecordMethod;
{ Static (class-level) methods take no implicit Self. Dropping this in the
export clone made every cross-unit static method look like a normal
instance method, so TypeName.StaticMethod() resolution failed. }
Result.IsStatic := ASrc.IsStatic;
for I := 0 to ASrc.Params.Count - 1 do
Result.Params.Add(CloneMethodParam(TMethodParam(ASrc.Params.Items[I])));
if ASrc.TypeParams <> nil then

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

@ -4480,9 +4480,18 @@ begin
ParseUsesList(Result.ImplUsedUnits); { implementation-only deps — loaded but not re-exported }
while Check(tkProcedure) or Check(tkFunction) or
Check(tkConstructor) or Check(tkDestructor) or
Check(tkVar) or Check(tkThreadVar) or Check(tkConst) or Check(tkType) do
Check(tkVar) or Check(tkThreadVar) or Check(tkConst) or Check(tkType) or
(Check(tkIdent) and SameText(FCurrent.Value, 'static') and
(PeekKind() in [tkFunction, tkProcedure])) do
begin
if Check(tkFunction) then
if Check(tkIdent) and SameText(FCurrent.Value, 'static') and
(PeekKind() in [tkFunction, tkProcedure]) then
{ Out-of-line static-method body in the implementation section:
`static function T.M ...`. Mirror the program-level standalone path
(ParseStandaloneDecl) — consume `static`, parse the routine, mark it
IsStatic so it reconciles against the in-class static declaration. }
ParseStandaloneDecl(Result.ImplBlock)
else if Check(tkFunction) then
Result.ImplBlock.ProcDecls.Add(ParseMethodDecl(True, True))
else if Check(tkVar) or Check(tkThreadVar) then
ParseVarBlock(Result.ImplBlock)

4
compiler/src/main/pascal/uSemanticExport.pas
View file

@ -230,6 +230,10 @@ begin
Result.ResolvedQbeName := ASrc.ResolvedQbeName;
Result.IsVirtual := ASrc.IsVirtual;
Result.IsOverride := ASrc.IsOverride;
{ Carry static-ness so a cross-unit TypeName.StaticMethod() call resolves —
VTableSlot alone cannot distinguish a static method from a final
non-virtual instance method (both are -1). }
Result.IsStatic := ASrc.IsStatic;
Result.ReturnType := ResolveTypeRef(ASrc.ReturnTypeName, AIface, ADeps);
for I := 0 to ASrc.Params.Count - 1 do

103
compiler/src/main/pascal/uSemanticImport.pas
View file

@ -260,6 +260,74 @@ begin
ART.SetVTableSlotAt(ASig.VTableSlot, ASig.Name, ImplName);
end;
{ Register the shared globals for a `static var` (class variable) imported
from a .bif. Mirrors uSemantic.AnalyseTypeDecls (the IsClassVar branch):
a static var is NOT an instance field, so it must not advance the type
layout — instead it becomes one shared global reachable both bare (inside
the type's own methods) and qualified ('TFoo.Name' from anywhere).
CRITICAL: ClassVarEmitName is the mangled label computed at the DEFINING
unit's export time and serialised verbatim. The importer must use the
DECODED value, never recompute it — the importing unit's own prefix
differs, so re-deriving would produce a label that does not match the data
slot the exporting unit emitted. }
procedure RegisterImportedClassVar(const ATypeName, AFieldName,
AEmitName: string;
AFieldType: TTypeDesc;
ATable: TSymbolTable);
var
Sym: TSymbol;
begin
{ Bare name — usable unqualified inside the type's own methods. }
Sym := TSymbol.Create(AFieldName, skVariable, AFieldType);
Sym.IsGlobal := True;
Sym.IsClassVar := True;
Sym.GlobalEmitName := AEmitName;
if not ATable.Define(Sym) then Sym.Free();
{ Qualified name — usable as TFoo.Name from anywhere. }
Sym := TSymbol.Create(ATypeName + '.' + AFieldName, skVariable, AFieldType);
Sym.IsGlobal := True;
Sym.IsClassVar := True;
Sym.GlobalEmitName := AEmitName;
if not ATable.Define(Sym) then Sym.Free();
end;
{ Register class/record-level `static const` declarations imported from a
.bif. Mirrors the within-unit registration in uSemantic.AnalyseTypeDecls:
each const is reachable both bare and qualified ('TFoo.Tag'). Array consts
are out of scope here (the within-unit path supports them, but no cached
consumer needs them yet); only scalar int/string consts are imported. }
procedure RegisterImportedTypeConsts(const ATypeName: string;
AConstDecls: TObjectList;
ATable: TSymbolTable);
var
J: Integer;
CD: TConstDecl;
Par: TTypeDesc;
Sym: TSymbol;
begin
if AConstDecls = nil then Exit;
for J := 0 to AConstDecls.Count - 1 do
begin
CD := TConstDecl(AConstDecls.Items[J]);
if CD.IsArrayConst then Continue; { array static consts not yet imported }
if CD.IsString then
Par := ATable.FindType('string')
else
Par := ATable.FindType('Integer');
{ Unqualified name — usable inside the type's own methods without prefix. }
Sym := TSymbol.Create(CD.Name, skConstant, Par);
Sym.ConstValue := CD.IntVal;
Sym.ConstString := CD.StrVal;
if not ATable.Define(Sym) then Sym.Free();
{ Qualified name — usable as TFoo.Tag from anywhere. }
Sym := TSymbol.Create(ATypeName + '.' + CD.Name, skConstant, Par);
Sym.ConstValue := CD.IntVal;
Sym.ConstString := CD.StrVal;
if not ATable.Define(Sym) then Sym.Free();
end;
end;
function ResolveParentClassByName(const AParentName: string;
ATable: TSymbolTable): TRecordTypeDesc;
var
@ -473,8 +541,17 @@ begin
raise EImportError.CreateFmt(
'Class %s field type %s unresolved',
[AEntry.Name, FldDecl.TypeName]);
for J := 0 to FldDecl.Names.Count - 1 do
RT.AddField(FldDecl.Names.Strings[J], FldType);
if FldDecl.IsClassVar then
{ `static var`: a shared global, NOT an instance field — do not AddField
(that would advance the layout). Register the global under the
DECODED emit label. Multi-name static-var decls are not produced by
the parser (ClassVarEmitName is only set for single-name decls), so
the single decoded label applies to FldDecl.Names[0]. }
RegisterImportedClassVar(AEntry.Name, FldDecl.Names.Strings[0],
FldDecl.ClassVarEmitName, FldType, ATable)
else
for J := 0 to FldDecl.Names.Count - 1 do
RT.AddField(FldDecl.Names.Strings[J], FldType);
end;
{ Methods: walk TRoutineSig list; for virtual/override, register
@ -550,9 +627,16 @@ begin
if (FldSym <> nil) and (FldSym.Kind = skType) then
PropInfo.IndexTypeDesc := FldSym.TypeDesc;
end;
{ Static-property facts — TypeName.Prop reads/writes dispatch with no
implicit Self. Mirrors the within-unit pass (PropInfo.IsStatic). }
PropInfo.IsDefault := PropDecl.IsDefault;
PropInfo.IsStatic := PropDecl.IsStatic;
RT.AddProperty(PropInfo);
end;
{ Class-level `static const` declarations — reachable bare and qualified. }
RegisterImportedTypeConsts(AEntry.Name, ClassDef.ConstDecls, ATable);
{ Class attributes. uSemanticExport currently copies the raw
attribute names ('Threaded', not 'ThreadedAttribute') — but
AddClassAttribute downstream wants the resolved-name form.
@ -609,9 +693,17 @@ begin
raise EImportError.CreateFmt(
'Record %s field type %s unresolved',
[AEntry.Name, FldDecl.TypeName]);
for J := 0 to FldDecl.Names.Count - 1 do
RecDesc.AddField(FldDecl.Names.Strings[J], FldType);
if FldDecl.IsClassVar then
{ record-level `static var`: shared global, not an instance field. }
RegisterImportedClassVar(AEntry.Name, FldDecl.Names.Strings[0],
FldDecl.ClassVarEmitName, FldType, ATable)
else
for J := 0 to FldDecl.Names.Count - 1 do
RecDesc.AddField(FldDecl.Names.Strings[J], FldType);
end;
{ record-level `static const` declarations — reachable bare and qualified. }
RegisterImportedTypeConsts(AEntry.Name, RecDef.ConstDecls, ATable);
end;
procedure RegisterProcType(AEntry: TTypeEntry; ATable: TSymbolTable;
@ -866,6 +958,9 @@ begin
Result.VTableSlot := ASig.VTableSlot;
Result.IsVirtual := ASig.IsVirtual;
Result.IsOverride := ASig.IsOverride;
{ Carry static-ness so the semantic pass's TypeName.StaticMethod() resolution
(which checks MDecl.IsStatic) succeeds for a method imported from a .bif. }
Result.IsStatic := ASig.IsStatic;
for J := 0 to ASig.Params.Count - 1 do
begin
Param := TMethodParam(ASig.Params.Items[J]);

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

@ -89,6 +89,11 @@ type
IsVirtual: Boolean; { virtual method that allocates a new
vtable slot }
IsOverride: Boolean; { override that replaces a parent slot }
IsStatic: Boolean; { static (class-level) method — takes no
implicit Self. VTableSlot is -1 for both
static and final non-virtual instance
methods, so this is a distinct flag rather
than being inferred from the slot. }
constructor Create;
destructor Destroy; override;
end;

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

@ -53,7 +53,14 @@ uses
const
IFACE_MAGIC = 'BLAISE-IFACE';
IFACE_VERSION = 3; { v3 (this cycle): `static` (class-level) member facts now
IFACE_VERSION = 4; { v4 (this cycle): TRoutineSig.IsStatic added to
EncodeMethodSig/ReadMethodSig so a cross-unit
TypeName.StaticMethod() call resolves through the
cached .bif (VTableSlot alone cannot distinguish a
static method from a final non-virtual instance
method — both are -1). The method-sig layout grew,
so v3 readers must reject these .bif and recompile.
v3: `static` (class-level) member facts now
serialised — TFieldDecl.IsClassVar + ClassVarEmitName in
EncodeFieldList/ReadFieldList, TPropertyDecl.IsStatic in
EncodePropertyList/ReadPropertyList, and record/class
@ -325,6 +332,9 @@ begin
EncodeBool (AR.IsOverride) +
EncodeLpstr(AR.ResolvedQbeName) +
EncodeLpstr(IntToStr(AR.VTableSlot)) +
{ static-method flag — distinct from VTableSlot (both static and final
non-virtual instance methods carry slot -1). }
EncodeBool (AR.IsStatic) +
EncodeCount(AR.Params.Count);
for J := 0 to AR.Params.Count - 1 do
begin
@ -1888,6 +1898,8 @@ begin
Result.IsOverride := DecodeBool(AText, APos);
Result.ResolvedQbeName := ReadLpstrAt(AText, APos);
Result.VTableSlot := StrToInt(ReadLpstrAt(AText, APos));
{ Order must mirror EncodeMethodSig: IsStatic follows VTableSlot. }
Result.IsStatic := DecodeBool(AText, APos);
Pc := DecodeCount(AText, APos);
for J := 1 to Pc do
begin

142
compiler/src/test/pascal/cp.test.e2e.sepcompile.pas
View file

@ -107,6 +107,19 @@ type
walk dead-ended and reported "Undeclared procedure". }
procedure TestIncrementalRebuild_QualifiedGrandparentMethod;
procedure TestDebugOpdf_PerUnitSection_InDependencyObject;
{ Regression (F1-followup cross-unit static members): a class with `static`
members — a static var, a static method, and a static const — declared in
one unit and used through the COMPILED .bif boundary from another unit.
The wire format already encoded the static facts, but the export clone
dropped TFieldDecl.IsClassVar/ClassVarEmitName, TMethodDecl.IsStatic and
TPropertyDecl.IsStatic before encoding; the importer ignored them and the
decoded ConstDecls; and TRoutineSig carried no IsStatic field at all. So
a cross-unit TReg.Next() failed with "is not a static method", a static
var did not register as a shared global, and TReg.Tag did not resolve.
Driving through --unit-cache exercises the real .bif write+read path on
both backends. }
procedure TestStaticMembers_CrossUnit_QBE;
procedure TestStaticMembers_CrossUnit_Native;
end;
implementation
@ -1422,6 +1435,135 @@ begin
Captured)
end;
{ Shared source for the two cross-unit static-member tests below. RegModU
declares a class with all three static member forms; the consuming program
reaches them across the compiled .bif boundary. }
const
StaticRegModSrc =
'''
unit RegModU;
interface
type
TReg = class
private static var
FCount: Integer;
public
static function Next: Integer;
public static const
Tag = 7;
end;
implementation
static function TReg.Next: Integer;
begin
FCount := FCount + 1;
Result := FCount;
end;
end.
''';
StaticRegProgSrc =
'''
program UseReg;
uses RegModU;
begin
WriteLn(TReg.Next());
WriteLn(TReg.Next());
WriteLn(TReg.Tag)
end.
''';
procedure TSepCompileTests.TestStaticMembers_CrossUnit_QBE;
var
UnitPas, ProgPas, ProgBin, CacheDir: string;
Captured: string;
Rc: Integer;
begin
if not ToolchainAvailable() then
begin
Fail('toolchain missing — qbe or RTL not found');
Exit
end;
if not FileExists(BlaisePath()) then
begin
Fail('blaise binary missing at ' + BlaisePath());
Exit
end;
UnitPas := FScratch + '/RegModU.pas';
ProgPas := FScratch + '/use_reg_qbe.pas';
ProgBin := FScratch + '/use_reg_qbe';
CacheDir := FScratch + '/units-static-qbe';
WriteFile(UnitPas, StaticRegModSrc);
WriteFile(ProgPas, StaticRegProgSrc);
ForceDirectories(CacheDir);
{ Build 1 (clean cache): RegModU compiled from source, .o/.bif cached. }
Rc := RunBlaise(['--source', ProgPas, '--output', ProgBin,
'--backend', 'qbe',
'--unit-cache', CacheDir,
'--unit-path', FScratch], Captured);
AssertEquals('qbe build1 exit (out: ' + Captured + ')', 0, Rc);
Rc := RunBinary(ProgBin, Captured);
AssertEquals('qbe build1 run exit', 0, Rc);
AssertEquals('qbe build1 stdout', '1' + #10 + '2' + #10 + '7' + #10, Captured);
{ Build 2 (warm cache): RegModU loaded purely from its cached .bif — the
static facts must survive the .bif round-trip. }
Rc := RunBlaise(['--source', ProgPas, '--output', ProgBin,
'--backend', 'qbe',
'--unit-cache', CacheDir,
'--unit-path', FScratch], Captured);
AssertEquals('qbe build2 exit (out: ' + Captured + ')', 0, Rc);
Rc := RunBinary(ProgBin, Captured);
AssertEquals('qbe build2 run exit', 0, Rc);
AssertEquals('qbe build2 stdout', '1' + #10 + '2' + #10 + '7' + #10, Captured)
end;
procedure TSepCompileTests.TestStaticMembers_CrossUnit_Native;
var
UnitPas, ProgPas, ProgBin, CacheDir: string;
Captured: string;
Rc: Integer;
begin
if not ToolchainAvailable() then
begin
Fail('toolchain missing — qbe or RTL not found');
Exit
end;
if not FileExists(BlaisePath()) then
begin
Fail('blaise binary missing at ' + BlaisePath());
Exit
end;
UnitPas := FScratch + '/RegModU.pas';
ProgPas := FScratch + '/use_reg_native.pas';
ProgBin := FScratch + '/use_reg_native';
CacheDir := FScratch + '/units-static-native';
WriteFile(UnitPas, StaticRegModSrc);
WriteFile(ProgPas, StaticRegProgSrc);
ForceDirectories(CacheDir);
Rc := RunBlaise(['--source', ProgPas, '--output', ProgBin,
'--backend', 'native',
'--unit-cache', CacheDir,
'--unit-path', FScratch], Captured);
AssertEquals('native build1 exit (out: ' + Captured + ')', 0, Rc);
Rc := RunBinary(ProgBin, Captured);
AssertEquals('native build1 run exit', 0, Rc);
AssertEquals('native build1 stdout', '1' + #10 + '2' + #10 + '7' + #10, Captured);
Rc := RunBlaise(['--source', ProgPas, '--output', ProgBin,
'--backend', 'native',
'--unit-cache', CacheDir,
'--unit-path', FScratch], Captured);
AssertEquals('native build2 exit (out: ' + Captured + ')', 0, Rc);
Rc := RunBinary(ProgBin, Captured);
AssertEquals('native build2 run exit', 0, Rc);
AssertEquals('native build2 stdout', '1' + #10 + '2' + #10 + '7' + #10, Captured)
end;
initialization
RegisterTest(TSepCompileTests);

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

@ -263,6 +263,16 @@ type
preserves statements/expressions through write+read. }
procedure TestDiskPath_GenericRoutine_BodyPreserved;
procedure TestRoundTrip_InlineBody_Preserved;
{ Static (class-level) member facts must survive export-clone → encode →
decode. The export clone previously dropped TFieldDecl.IsClassVar /
ClassVarEmitName, TMethodDecl.IsStatic and TPropertyDecl.IsStatic, so
they encoded as defaults. }
procedure TestRoundTrip_StaticMembers_Preserved;
{ Pre-existing clone bug uncovered alongside the static-members work: a
[Weak] field and a `default` property round-tripped as plain owning /
non-default because CloneFieldDecl / ClonePropertyDecl dropped IsWeak
and IsDefault before encoding. }
procedure TestRoundTrip_WeakField_And_DefaultProperty_Preserved;
end;
{ ----- ImportUnitInterface round-trip (Phase 6c-A) -------------- }
@ -2681,11 +2691,11 @@ begin
Iface := TUnitInterface.Create('U');
try
Buf := WriteUnitInterface(Iface);
{ 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. }
{ Blaise Pos is 0-based; match-at-start returns 0. Version is 4 since
TRoutineSig.IsStatic was added to the method-sig encoded layout (on top
of v3's IsClassVar/ClassVarEmitName, property IsStatic, ConstDecls). }
AssertTrue('starts with magic',
Pos('BLAISE-IFACE 3', Buf) = 0);
Pos('BLAISE-IFACE 4', Buf) = 0);
finally
Iface.Free();
end;
@ -3400,6 +3410,121 @@ begin
end;
end;
procedure TIfaceIOTests.TestRoundTrip_StaticMembers_Preserved;
const
SRC =
'unit U;' + #10 +
'interface' + #10 +
'type TReg = class' + #10 +
' private static var' + #10 +
' FCount: Integer;' + #10 +
' public' + #10 +
' static function Next: Integer;' + #10 +
' static property Counter: Integer read Next;' + #10 +
' public static const' + #10 +
' Tag = 7;' + #10 +
'end;' + #10 +
'implementation' + #10 +
'static function TReg.Next: Integer; begin Result := FCount end;' + #10 +
'end.' + #10;
var
Iface, Round: TUnitInterface;
Buf: string;
E: TTypeEntry;
Def: TClassTypeDef;
Fld: TFieldDecl;
M: TRoutineSig;
Prop: TPropertyDecl;
begin
Iface := ParseAnalyseAndExport(SRC);
try
Buf := WriteUnitInterface(Iface);
Round := ReadUnitInterface(Buf);
try
E := Round.FindType('TReg');
AssertTrue('TReg present', E <> nil);
Def := TClassTypeDef(E.Def);
{ static var FCount: IsClassVar set, mangled emit label round-tripped. }
AssertEquals('1 field decl', 1, Def.Fields.Count);
Fld := TFieldDecl(Def.Fields.Items[0]);
AssertEquals('field name', 'FCount', Fld.Names.Strings[0]);
AssertTrue('FCount IsClassVar', Fld.IsClassVar);
AssertEquals('FCount emit label', 'U_TReg_FCount', Fld.ClassVarEmitName);
{ static method Next: IsStatic carried on the routine sig. }
AssertEquals('1 method', 1, E.Methods.Count);
M := TRoutineSig(E.Methods.Items[0]);
AssertEquals('method name', 'Next', M.Name);
AssertTrue('Next IsStatic', M.IsStatic);
{ static property Counter: IsStatic carried on the property decl. }
AssertEquals('1 property', 1, Def.Properties.Count);
Prop := TPropertyDecl(Def.Properties.Items[0]);
AssertEquals('prop name', 'Counter', Prop.Name);
AssertTrue('Counter IsStatic', Prop.IsStatic);
{ static const Tag: carried in the class ConstDecls list. }
AssertEquals('1 const decl', 1, Def.ConstDecls.Count);
AssertEquals('const name', 'Tag',
TConstDecl(Def.ConstDecls.Items[0]).Name);
AssertEquals('const value', 7,
TConstDecl(Def.ConstDecls.Items[0]).IntVal);
finally
Round.Free();
end;
finally
Iface.Free();
end;
end;
procedure TIfaceIOTests.TestRoundTrip_WeakField_And_DefaultProperty_Preserved;
const
SRC =
'unit U;' + #10 +
'interface' + #10 +
'type TNode = class' + #10 +
' [Weak] FNext: TNode;' + #10 +
' function Get(I: Integer): Integer;' + #10 +
' property Items[I: Integer]: Integer read Get; default;' + #10 +
'end;' + #10 +
'implementation' + #10 +
'function TNode.Get(I: Integer): Integer; begin Result := I end;' + #10 +
'end.' + #10;
var
Iface, Round: TUnitInterface;
Buf: string;
E: TTypeEntry;
Def: TClassTypeDef;
Fld: TFieldDecl;
Prop: TPropertyDecl;
begin
Iface := ParseAnalyseAndExport(SRC);
try
Buf := WriteUnitInterface(Iface);
Round := ReadUnitInterface(Buf);
try
E := Round.FindType('TNode');
AssertTrue('TNode present', E <> nil);
Def := TClassTypeDef(E.Def);
AssertEquals('1 field decl', 1, Def.Fields.Count);
Fld := TFieldDecl(Def.Fields.Items[0]);
AssertEquals('field name', 'FNext', Fld.Names.Strings[0]);
AssertTrue('FNext IsWeak survives clone+round-trip', Fld.IsWeak);
AssertEquals('1 property', 1, Def.Properties.Count);
Prop := TPropertyDecl(Def.Properties.Items[0]);
AssertEquals('prop name', 'Items', Prop.Name);
AssertTrue('Items IsDefault survives clone+round-trip', Prop.IsDefault);
finally
Round.Free();
end;
finally
Iface.Free();
end;
end;
procedure TIfaceIOTests.TestRead_VersionMismatch_Raises;
var
Caught: Boolean;

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

@ -290,17 +290,18 @@ TRoutineSig.VTableSlot serialise
TRoutineSig.ResolvedQbeName serialise
TRoutineSig.IsVirtual serialise
TRoutineSig.IsOverride serialise
TRoutineSig.IsStatic serialise
# TConstEntry (uUnitInterface.pas:97)
# TConstEntry (uUnitInterface.pas:102)
TConstEntry.Decl serialise
TConstEntry.TypeRef serialise
# TVarEntry (uUnitInterface.pas:105)
# TVarEntry (uUnitInterface.pas:110)
TVarEntry.Name serialise
TVarEntry.TypeRef serialise
TVarEntry.IsThreadVar serialise
# TUnitInterface (uUnitInterface.pas:169)
# TUnitInterface (uUnitInterface.pas:174)
TUnitInterface.Name serialise
TUnitInterface.SourceFile serialise
TUnitInterface.SourceHash serialise