fix(codegen): emit data items for typed array consts inside function bodies
A typed array constant declared inside a function body (or class method
body) had its element values held in TConstDecl.ArrayElements but no
`data $Name = { ... }` item was emitted in the data section. The function
code referenced `$Name` (e.g. `add $Days, %_t`), which produced
`undefined reference to Name` at link time.
EmitGlobalConstData walked only the top-level program/unit blocks; method
bodies were never visited. Add EmitLocalArrayConstsInBlock /
EmitLocalArrayConstsInTypeDecls / EmitLocalArrayConstsInProgram /
EmitLocalArrayConstsInUnit which sweep standalone procs and class/record
methods and emit any locally-declared typed array constants.
Wired into all four IR-emission sites: Generate / AppendProgram /
GenerateUnit / AppendUnit. GenerateUnit was also missing the existing
EmitGlobalConstData calls for IntfBlock/ImplBlock — added those for
consistency.
Tests:
- IR: TestArrayConst_LocalInFunction_EmitsDataItem,
TestArrayConst_LocalInProcedure_EmitsDataItem,
TestArrayConst_LocalInMethod_EmitsDataItem assert the IR contains
`data $Name =` for each scope.
- E2E: TestRun_Const_LocalArrayInFunction compiles+links+runs a program
whose function uses a local typed array constant and reads three
elements, verifying the full toolchain catches the link error.
Unblocks 36 previously-failing DateUtils e2e tests (blaise_time.pas
declared `Days: array[1..12] of Integer` inside _TimeDaysInMonth).
This commit is contained in:
Graeme Geldenhuys
parent
4b4e560b27
commit
fa69ae1b1c
|
|
@ -148,6 +148,10 @@ type
|
|||
procedure EmitArrayConstData(CD: TConstDecl; const APrefix: string);
|
||||
procedure EmitClassConstData(AClassDef: TClassTypeDef; const AClassName: string);
|
||||
procedure EmitGlobalConstData(ABlock: TBlock);
|
||||
procedure EmitLocalArrayConstsInBlock(ABlock: TBlock);
|
||||
procedure EmitLocalArrayConstsInTypeDecls(ABlock: TBlock);
|
||||
procedure EmitLocalArrayConstsInProgram(AProg: TProgram);
|
||||
procedure EmitLocalArrayConstsInUnit(AUnit: TUnit);
|
||||
procedure EmitParamAllocs(AMethod: TMethodDecl; AClassType: TRecordTypeDesc);
|
||||
procedure EmitArcCleanup(ABlock: TBlock);
|
||||
procedure EmitExcPathArcCleanup(ABlock: TBlock);
|
||||
|
|
@ -1646,6 +1650,81 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
procedure TCodeGenQBE.EmitLocalArrayConstsInBlock(ABlock: TBlock);
|
||||
{ Walk ABlock's standalone proc/func decls and emit any local typed array
|
||||
constants as top-level data items. Local consts share the unprefixed
|
||||
global symbol namespace, which is fine in practice because block-scoped
|
||||
names are unique per program; if collisions ever arise a prefix mangling
|
||||
would go here. }
|
||||
var
|
||||
I, J: Integer;
|
||||
Decl: TMethodDecl;
|
||||
CD: TConstDecl;
|
||||
begin
|
||||
if ABlock = nil then Exit;
|
||||
for I := 0 to ABlock.ProcDecls.Count - 1 do
|
||||
begin
|
||||
Decl := TMethodDecl(ABlock.ProcDecls.Items[I]);
|
||||
if Decl.Body = nil then Continue;
|
||||
for J := 0 to Decl.Body.ConstDecls.Count - 1 do
|
||||
begin
|
||||
CD := TConstDecl(Decl.Body.ConstDecls.Items[J]);
|
||||
EmitArrayConstData(CD, '');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCodeGenQBE.EmitLocalArrayConstsInTypeDecls(ABlock: TBlock);
|
||||
{ Walk ABlock's type decls and emit local typed array constants found in
|
||||
class/record method bodies as top-level data items. }
|
||||
var
|
||||
I, J, K: Integer;
|
||||
TD: TTypeDecl;
|
||||
Methods: TObjectList;
|
||||
Decl: TMethodDecl;
|
||||
CD: TConstDecl;
|
||||
begin
|
||||
if ABlock = nil then Exit;
|
||||
for I := 0 to ABlock.TypeDecls.Count - 1 do
|
||||
begin
|
||||
TD := TTypeDecl(ABlock.TypeDecls.Items[I]);
|
||||
if TD.Def is TClassTypeDef then
|
||||
Methods := TClassTypeDef(TD.Def).Methods
|
||||
else if TD.Def is TRecordTypeDef then
|
||||
Methods := TRecordTypeDef(TD.Def).Methods
|
||||
else
|
||||
Continue;
|
||||
for J := 0 to Methods.Count - 1 do
|
||||
begin
|
||||
Decl := TMethodDecl(Methods.Items[J]);
|
||||
if Decl.Body = nil then Continue;
|
||||
for K := 0 to Decl.Body.ConstDecls.Count - 1 do
|
||||
begin
|
||||
CD := TConstDecl(Decl.Body.ConstDecls.Items[K]);
|
||||
EmitArrayConstData(CD, '');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCodeGenQBE.EmitLocalArrayConstsInProgram(AProg: TProgram);
|
||||
{ Emit local typed array constants from class/record method bodies and
|
||||
standalone procs in the program block as top-level data items. Mirrors
|
||||
the EmitMethodDefs + EmitStandaloneDefs sweep but only looks at consts. }
|
||||
begin
|
||||
EmitLocalArrayConstsInTypeDecls(AProg.Block);
|
||||
EmitLocalArrayConstsInBlock(AProg.Block);
|
||||
end;
|
||||
|
||||
procedure TCodeGenQBE.EmitLocalArrayConstsInUnit(AUnit: TUnit);
|
||||
begin
|
||||
if AUnit = nil then Exit;
|
||||
EmitLocalArrayConstsInTypeDecls(AUnit.IntfBlock);
|
||||
EmitLocalArrayConstsInTypeDecls(AUnit.ImplBlock);
|
||||
EmitLocalArrayConstsInBlock(AUnit.IntfBlock);
|
||||
EmitLocalArrayConstsInBlock(AUnit.ImplBlock);
|
||||
end;
|
||||
|
||||
procedure TCodeGenQBE.EmitArcCleanup(ABlock: TBlock);
|
||||
{ Release every ARC-managed local variable (string, class, or interface) at
|
||||
block exit. Mirrors the insertion pattern used at assignment sites: each
|
||||
|
|
@ -8700,6 +8779,7 @@ begin
|
|||
EmitDataSection;
|
||||
EmitGlobalVarData(AProg.Block);
|
||||
EmitGlobalConstData(AProg.Block);
|
||||
EmitLocalArrayConstsInProgram(AProg);
|
||||
EmitInterfaceDefs(AProg);
|
||||
EmitTypeInfoDefs(AProg);
|
||||
EmitVTableDefs(AProg);
|
||||
|
|
@ -8770,6 +8850,9 @@ begin
|
|||
EmitDataSection;
|
||||
EmitGlobalVarData(AUnit.IntfBlock);
|
||||
EmitGlobalVarData(AUnit.ImplBlock);
|
||||
EmitGlobalConstData(AUnit.IntfBlock);
|
||||
EmitGlobalConstData(AUnit.ImplBlock);
|
||||
EmitLocalArrayConstsInUnit(AUnit);
|
||||
for I := 0 to AUnit.GenericInstances.Count - 1 do
|
||||
begin
|
||||
GI := TGenericInstance(AUnit.GenericInstances.Items[I]);
|
||||
|
|
@ -9047,6 +9130,7 @@ begin
|
|||
EmitGlobalVarData(AUnit.ImplBlock);
|
||||
EmitGlobalConstData(AUnit.IntfBlock);
|
||||
EmitGlobalConstData(AUnit.ImplBlock);
|
||||
EmitLocalArrayConstsInUnit(AUnit);
|
||||
|
||||
FOutput.AppendBuffer(Body);
|
||||
|
||||
|
|
@ -9120,6 +9204,7 @@ begin
|
|||
EmitDataSection; { emits remaining string literals + $__fmt_* (once) }
|
||||
EmitGlobalVarData(AProg.Block);
|
||||
EmitGlobalConstData(AProg.Block);
|
||||
EmitLocalArrayConstsInProgram(AProg);
|
||||
EmitInterfaceDefs(AProg);
|
||||
EmitTypeInfoDefs(AProg);
|
||||
EmitVTableDefs(AProg);
|
||||
|
|
|
|||
|
|
@ -86,6 +86,12 @@ type
|
|||
{ Class-level array constants }
|
||||
procedure TestClassArrayConst_RangeIndexed_InIR;
|
||||
procedure TestClassArrayConst_EnumIndexed_InIR;
|
||||
|
||||
{ Function-local typed array constants — must emit a data item in the
|
||||
data section, not just reference $Name from the function body. }
|
||||
procedure TestArrayConst_LocalInFunction_EmitsDataItem;
|
||||
procedure TestArrayConst_LocalInProcedure_EmitsDataItem;
|
||||
procedure TestArrayConst_LocalInMethod_EmitsDataItem;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
|
@ -951,6 +957,83 @@ begin
|
|||
AssertTrue('Names in IR', IRContains(IR, 'Names'));
|
||||
end;
|
||||
|
||||
{ Regression: a typed array constant declared inside a function body
|
||||
was referenced as `$Days` from the function code but no
|
||||
`data $Days = ...` item was emitted, so the linker failed with
|
||||
`undefined reference to Days`. EmitGlobalConstData was only called on
|
||||
the top-level program/unit blocks and never recursed into method
|
||||
bodies. }
|
||||
procedure TConstTests.TestArrayConst_LocalInFunction_EmitsDataItem;
|
||||
var IR: string;
|
||||
begin
|
||||
IR := GenIR(
|
||||
'''
|
||||
program P;
|
||||
function DaysInMonth(M: Integer): Integer;
|
||||
const
|
||||
Days: array[1..12] of Integer = (31,28,31,30,31,30,31,31,30,31,30,31);
|
||||
begin
|
||||
Result := Days[M]
|
||||
end;
|
||||
begin
|
||||
end.
|
||||
''');
|
||||
AssertTrue('IR non-empty', IR <> '');
|
||||
AssertTrue('$Days data item emitted',
|
||||
Pos('data $Days =', IR) >= 0);
|
||||
AssertTrue('Days[M] reference present',
|
||||
Pos('add $Days', IR) >= 0);
|
||||
end;
|
||||
|
||||
procedure TConstTests.TestArrayConst_LocalInProcedure_EmitsDataItem;
|
||||
var IR: string;
|
||||
begin
|
||||
IR := GenIR(
|
||||
'''
|
||||
program P;
|
||||
procedure Dump;
|
||||
const
|
||||
Tbl: array[0..2] of Integer = (10, 20, 30);
|
||||
begin
|
||||
WriteLn(Tbl[0])
|
||||
end;
|
||||
begin
|
||||
end.
|
||||
''');
|
||||
AssertTrue('IR non-empty', IR <> '');
|
||||
AssertTrue('$Tbl data item emitted',
|
||||
Pos('data $Tbl =', IR) >= 0);
|
||||
end;
|
||||
|
||||
procedure TConstTests.TestArrayConst_LocalInMethod_EmitsDataItem;
|
||||
var IR: string;
|
||||
begin
|
||||
IR := GenIR(
|
||||
'''
|
||||
program P;
|
||||
type
|
||||
TFoo = class
|
||||
public
|
||||
function Lookup(I: Integer): Integer;
|
||||
end;
|
||||
function TFoo.Lookup(I: Integer): Integer;
|
||||
const
|
||||
Vals: array[0..3] of Integer = (7, 8, 9, 10);
|
||||
begin
|
||||
Result := Vals[I]
|
||||
end;
|
||||
var F: TFoo;
|
||||
begin
|
||||
F := TFoo.Create;
|
||||
WriteLn(F.Lookup(0));
|
||||
F.Free
|
||||
end.
|
||||
''');
|
||||
AssertTrue('IR non-empty', IR <> '');
|
||||
AssertTrue('$Vals data item emitted',
|
||||
Pos('data $Vals =', IR) >= 0);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterTest(TConstTests);
|
||||
|
||||
|
|
|
|||
|
|
@ -33,6 +33,7 @@ type
|
|||
procedure TestRun_Const_IntegerConst;
|
||||
procedure TestRun_Const_StringConst;
|
||||
procedure TestRun_Const_NegativeConst;
|
||||
procedure TestRun_Const_LocalArrayInFunction;
|
||||
|
||||
{ Procedural types }
|
||||
procedure TestRun_ProcType_CallViaVariable;
|
||||
|
|
@ -164,6 +165,24 @@ const
|
|||
end.
|
||||
''';
|
||||
|
||||
{ Regression: typed array constant declared inside a function body was
|
||||
referenced as $Name but never emitted as a data item, producing a
|
||||
link error. Exercises the full toolchain (codegen + QBE + ld). }
|
||||
SrcConstLocalArrayInFunc = '''
|
||||
program P;
|
||||
function DaysInMonth(M: Integer): Integer;
|
||||
const
|
||||
Days: array[1..12] of Integer = (31,28,31,30,31,30,31,31,30,31,30,31);
|
||||
begin
|
||||
Result := Days[M]
|
||||
end;
|
||||
begin
|
||||
WriteLn(DaysInMonth(1));
|
||||
WriteLn(DaysInMonth(2));
|
||||
WriteLn(DaysInMonth(12))
|
||||
end.
|
||||
''';
|
||||
|
||||
SrcProcTypeVar = '''
|
||||
program P;
|
||||
type TFn = function(X: Integer): Integer;
|
||||
|
|
@ -496,6 +515,16 @@ begin
|
|||
AssertEquals('Hello', 'Hello' + LE, Output);
|
||||
end;
|
||||
|
||||
procedure TE2EMiscTests.TestRun_Const_LocalArrayInFunction;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRun(SrcConstLocalArrayInFunc, Output, RCode));
|
||||
AssertEquals('exit code 0', 0, RCode);
|
||||
AssertEquals('Jan Feb Dec days',
|
||||
'31' + LE + '28' + LE + '31' + LE, Output);
|
||||
end;
|
||||
|
||||
procedure TE2EMiscTests.TestRun_Const_NegativeConst;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
|
|
|
|||
Loading…
Reference in a new issue