From 02de7b694ab79934015ffdaff2df24185a7aa19f Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Sun, 28 Jun 2026 16:35:36 +0100 Subject: [PATCH] feat(lang): carry static members across separately-compiled units MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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. --- compiler/src/main/pascal/uAST.pas | 17 +++ compiler/src/main/pascal/uParser.pas | 13 +- compiler/src/main/pascal/uSemanticExport.pas | 4 + compiler/src/main/pascal/uSemanticImport.pas | 103 ++++++++++++- compiler/src/main/pascal/uUnitInterface.pas | 5 + compiler/src/main/pascal/uUnitInterfaceIO.pas | 14 +- .../test/pascal/cp.test.e2e.sepcompile.pas | 142 ++++++++++++++++++ .../src/test/pascal/cp.test.unitinterface.pas | 133 +++++++++++++++- tools/bif-coverage/bif-coverage.status | 7 +- 9 files changed, 424 insertions(+), 14 deletions(-) diff --git a/compiler/src/main/pascal/uAST.pas b/compiler/src/main/pascal/uAST.pas index 9b11bb8..23fbc2a 100644 --- a/compiler/src/main/pascal/uAST.pas +++ b/compiler/src/main/pascal/uAST.pas @@ -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 diff --git a/compiler/src/main/pascal/uParser.pas b/compiler/src/main/pascal/uParser.pas index 46b9105..31d2235 100644 --- a/compiler/src/main/pascal/uParser.pas +++ b/compiler/src/main/pascal/uParser.pas @@ -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) diff --git a/compiler/src/main/pascal/uSemanticExport.pas b/compiler/src/main/pascal/uSemanticExport.pas index 8ecf642..699d6ae 100644 --- a/compiler/src/main/pascal/uSemanticExport.pas +++ b/compiler/src/main/pascal/uSemanticExport.pas @@ -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 diff --git a/compiler/src/main/pascal/uSemanticImport.pas b/compiler/src/main/pascal/uSemanticImport.pas index 85de3f5..e8df86c 100644 --- a/compiler/src/main/pascal/uSemanticImport.pas +++ b/compiler/src/main/pascal/uSemanticImport.pas @@ -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]); diff --git a/compiler/src/main/pascal/uUnitInterface.pas b/compiler/src/main/pascal/uUnitInterface.pas index 754bce9..57ee4b9 100644 --- a/compiler/src/main/pascal/uUnitInterface.pas +++ b/compiler/src/main/pascal/uUnitInterface.pas @@ -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; diff --git a/compiler/src/main/pascal/uUnitInterfaceIO.pas b/compiler/src/main/pascal/uUnitInterfaceIO.pas index c24553e..f7b7009 100644 --- a/compiler/src/main/pascal/uUnitInterfaceIO.pas +++ b/compiler/src/main/pascal/uUnitInterfaceIO.pas @@ -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 diff --git a/compiler/src/test/pascal/cp.test.e2e.sepcompile.pas b/compiler/src/test/pascal/cp.test.e2e.sepcompile.pas index fdba89b..dd5d28b 100644 --- a/compiler/src/test/pascal/cp.test.e2e.sepcompile.pas +++ b/compiler/src/test/pascal/cp.test.e2e.sepcompile.pas @@ -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); diff --git a/compiler/src/test/pascal/cp.test.unitinterface.pas b/compiler/src/test/pascal/cp.test.unitinterface.pas index 2b0c7d7..e39a537 100644 --- a/compiler/src/test/pascal/cp.test.unitinterface.pas +++ b/compiler/src/test/pascal/cp.test.unitinterface.pas @@ -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; diff --git a/tools/bif-coverage/bif-coverage.status b/tools/bif-coverage/bif-coverage.status index f5bba32..89ddcae 100644 --- a/tools/bif-coverage/bif-coverage.status +++ b/tools/bif-coverage/bif-coverage.status @@ -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