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

feat(semantic): resolve type-qualified enum members (TEnum.Member)

Browse source 
A bare or type-qualified enum member (`Color.cRed`, or `cRed` where the
target type is known) now resolves correctly.

Also adds TSymbolTable.InCodegen, set by both backends around code
emission, which disables the analysis-time impl-private suppression in
Lookup.  That guard exists only to stop an implementation-section symbol
of unit A leaking into a different unit B DURING ANALYSIS; at codegen a
backend legitimately resolves a unit's own impl-section classes to emit
their typeinfo/vtable/_FieldCleanup.  FDefineOwningUnit can drift to a
dependency unit mid-emit, which previously made the suppression wrongly
fire and silently drop an impl-section class's typeinfo — leaving a
dangling `typeinfo_<Unit>_<Class>` reference the linker bound to a garbage
address (an out-of-range-metaclass crash, e.g. via RegisterTest).  This
is the robust, both-backend root-cause fix for that crash, which this
commit's layout change re-exposed; it supersedes the narrower
EmitClassSection DefineOwningUnit-pin added earlier.
This commit is contained in:
Andrew Haines 2026-06-28 11:03:21 -04:00 committed by Graeme Geldenhuys
parent edf4ffe374
commit 4d0c7c461d
6 changed files with 139 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -17449,6 +17449,7 @@ var
VD: TVarDecl;
Decl: TMethodDecl;
begin
if FSymTable <> nil then FSymTable.InCodegen := True;
FCurrentUnitName := AProg.Name;
FDbgSrcFile := '';
FProgramName := AProg.Name;
@ -17724,6 +17725,10 @@ begin
UnitSym := AUnit.SymbolTable
else
UnitSym := FSymTable;
{ Disable the analysis-time impl-private suppression in Lookup for the table
EmitClassSection consults — at codegen the backend must resolve THIS unit's
own implementation-section classes (see TSymbolTable.FInCodegen). }
if UnitSym <> nil then UnitSym.InCodegen := True;
{ Re-assert the viewing context (see the init-block note above): the class
section emits unit-qualified typeinfo/vtable/_FieldCleanup names via
ClassSymName, which must resolve THIS unit's own impl-section classes. }

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

@ -14472,6 +14472,10 @@ begin
begin
SavedDOU := FSymTable.DefineOwningUnit;
FSymTable.DefineOwningUnit := AUnit.Name;
{ Disable the analysis-time impl-private suppression in Lookup: at codegen
the backend must resolve THIS unit's own implementation-section classes to
emit their typeinfo/vtable/_FieldCleanup (see TSymbolTable.FInCodegen). }
FSymTable.InCodegen := True;
end;
{ Combined type-decl list (interface first, then implementation) — borrowed

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

@ -11333,6 +11333,7 @@ var
BaseType: TTypeDesc;
IntfDesc: TInterfaceTypeDesc;
MDecl: TMethodDecl;
EnumOrd: Integer;
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
@ -11678,6 +11679,26 @@ begin
AAccess.RecordName := RecSym.Name; { normalise to declared casing }
{ Type-qualified enum member: TMyEnum.meValue. Resolve the member straight
from the named enum's own member list, so the reference is unambiguous even
when another enum in scope declares a member of the same name (the bare name
resolves to whichever enum claimed the global slot; the qualified form
always names this one). }
if (RecSym.Kind = skType) and (RecSym.TypeDesc <> nil) and
(RecSym.TypeDesc.Kind = tyEnum) then
begin
EnumOrd := TEnumTypeDesc(RecSym.TypeDesc).OrdinalOf(AAccess.FieldName);
if EnumOrd < 0 then
SemanticError(
Format('Enum ''%s'' has no member ''%s''',
[AAccess.RecordName, AAccess.FieldName]),
AAccess.Line, AAccess.Col);
AAccess.IsConstant := True;
AAccess.ConstValue := EnumOrd;
AAccess.ResolvedType := RecSym.TypeDesc;
Exit(RecSym.TypeDesc);
end;
{ Constructor call: TypeName.Create }
if RecSym.Kind = skType then
begin

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

@ -547,6 +547,23 @@ type
retrieve the canonical TSymbol — without this flag we'd loop. }
FBypassUsesChain: Boolean;
FInCodegen: Boolean; { True while a backend is emitting code.
Disables the Layer-6 impl-private
suppression in Lookup: that guard exists
only to stop an implementation-section
symbol of unit A leaking into a different
unit B DURING ANALYSIS. At codegen time a
backend legitimately resolves a unit's own
impl-section classes (to emit their
typeinfo/vtable/_FieldCleanup and the
references to them), but FDefineOwningUnit
can have drifted to a dependency unit
mid-emit, which made the suppression wrongly
fire and silently drop the class's typeinfo
— a dangling symbol the linker binds to
garbage. Set by the QBE and native
backends around Generate/GenerateUnit. }
FDefineOwningUnit: string; { auto-applied to Sym.OwningUnit on Define
when the symbol has no explicit value;
set by AnalyseUnit/AnalyseUnitForExport
@ -604,6 +621,9 @@ type
property BypassUsesChain: Boolean read FBypassUsesChain
write FBypassUsesChain;
{ Set by a backend for the duration of code emission; see FInCodegen. }
property InCodegen: Boolean read FInCodegen write FInCodegen;
{ Type lookup — case-insensitive, returns nil if not found }
function FindType(const AName: string): TTypeDesc;
@ -2043,9 +2063,16 @@ begin
The check only runs while a unit/program is being analysed
(FDefineOwningUnit <> '') and the chain walker is not mid-callback; outside
analysis (some codegen-side lookups clear FDefineOwningUnit) the residue is
returned unchanged so unit-prefix mangling still resolves owned symbols. }
returned unchanged so unit-prefix mangling still resolves owned symbols.
It is also disabled during code emission (FInCodegen): the leak it guards is
purely an analysis-time concern, whereas a backend legitimately resolves a
unit's own implementation-section classes to emit their typeinfo/vtable/
_FieldCleanup. FDefineOwningUnit can have drifted to a dependency unit
mid-emit, which would otherwise make this suppression wrongly fire and drop
the class's typeinfo, leaving a dangling symbol the linker binds to garbage. }
if (Sym <> nil) and Sym.IsImplPrivate and (FDefineOwningUnit <> '')
and not FBypassUsesChain
and not FBypassUsesChain and not FInCodegen
and not SameText(Sym.OwningUnit, FDefineOwningUnit) then
begin
Result := nil;

45
compiler/src/test/pascal/cp.test.caseenum.pas
View file

@ -61,6 +61,8 @@ type
{ ------------------------------------------------------------------ }
procedure TestCodegen_Enum_MemberEmitsIntegerCopy;
procedure TestCodegen_Enum_AssignEmitsStore;
procedure TestCodegen_ScopedEnum_QualifiedMemberEmitsOrdinal;
procedure TestSemantic_ScopedEnum_UnknownMemberRejected;
{ ------------------------------------------------------------------ }
{ enum + case integration }
@ -576,6 +578,49 @@ begin
Pos('_StringEquals', IR) < 0);
end;
procedure TCaseEnumTests.TestCodegen_ScopedEnum_QualifiedMemberEmitsOrdinal;
const
Src =
'''
program P;
type TDir = (dN, dE, dS, dW);
var x: Integer;
begin
x := Ord(TDir.dS)
end.
''';
var
IR: string;
begin
IR := GenIR(Src);
{ TDir.dS is the third member (ordinal 2); the type-qualified reference must
resolve to that member and emit copy 2, exactly as the bare dS would. }
AssertTrue('TDir.dS emits copy 2', Pos('copy 2', IR) > 0);
end;
procedure TCaseEnumTests.TestSemantic_ScopedEnum_UnknownMemberRejected;
const
Src =
'''
program P;
type TDir = (dN, dE, dS, dW);
var x: Integer;
begin
x := Ord(TDir.dNope)
end.
''';
var
Raised: Boolean;
begin
Raised := False;
try
SemanticOK(Src);
except
on E: Exception do Raised := True;
end;
AssertTrue('unknown enum member via TEnum.Member rejected', Raised);
end;
initialization
RegisterTest(TCaseEnumTests);

35
compiler/src/test/pascal/cp.test.e2e.caseenum.pas
View file

@ -28,6 +28,7 @@ type
procedure TestRun_Enum_ExplicitOrdinals;
procedure TestRun_Enum_AutoContinueAfterExplicit;
procedure TestRun_Enum_ExplicitInCase;
procedure TestRun_Enum_ScopedAccess;
end;
implementation
@ -225,6 +226,40 @@ begin
AssertEquals('NotFound=404 matches case 404', 'not found', Trim(Output));
end;
procedure TE2ECaseEnumTests.TestRun_Enum_ScopedAccess;
const
{ Two enums in one unit share the member name 'Red'. The bare name resolves
to whichever enum claimed the global slot (TColorA), so TColorB.Red and
TColorB.Blue are reachable ONLY through the type-qualified form. }
Src =
'''
program P;
type
TColorA = (Red, Green);
TColorB = (Red, Blue);
begin
WriteLn(Ord(TColorA.Red));
WriteLn(Ord(TColorA.Green));
WriteLn(Ord(TColorB.Red));
WriteLn(Ord(TColorB.Blue))
end.
''';
var Output: string; RCode: Integer; Lines: TStringList;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRun(Src, Output, RCode));
Lines := TStringList.Create();
try
Lines.Text := Trim(Output);
AssertEquals('TColorA.Red', '0', Lines.Strings[0]);
AssertEquals('TColorA.Green','1', Lines.Strings[1]);
AssertEquals('TColorB.Red', '0', Lines.Strings[2]);
AssertEquals('TColorB.Blue', '1', Lines.Strings[3]);
finally
Lines.Free();
end;
end;
initialization
RegisterTest(TE2ECaseEnumTests);