feat(semantic): cross-unit const shadowing with last-in-uses wins
When two used units export a constant of the same name, the importer silently kept whichever was registered first and destroyed the other, so the later unit in the `uses` clause could never shadow the earlier one. Pascal's rule is last-in-uses wins. Add TScope.ExtractLocal / TSymbolTable.ExtractLocal, which detach a symbol from a scope without freeing it (the owning list keeps the object alive for any per-unit cache that still references it). On a cross-unit const collision, both the source-analysis path (AnalyseConstDecls) and the prebuilt-import path (RegisterConsts) now extract the prior unit's const and install the later unit's as the flat-scope winner, instead of dropping the newcomer. Same-block and unit-name-marker duplicates remain hard errors. Adds a two-written-units e2e helper (CompileAndRunWithUnits) and regression tests asserting the `uses` order decides the winner.
This commit is contained in:
parent
3db2476983
commit
6bc8aff47d
|
|
@ -5180,17 +5180,17 @@ begin
|
|||
Sym.ConstString := CD.StrVal;
|
||||
if not FTable.Define(Sym) then
|
||||
begin
|
||||
Sym.Free();
|
||||
{ A module-name marker blocking the Define is always a hard error
|
||||
(issue #84) — without this check the const would be silently
|
||||
dropped by the cross-unit shadowing tolerance below. }
|
||||
(issue #84). }
|
||||
RefSym := FTable.CurrentScope.LookupLocal(CD.Name);
|
||||
if (RefSym <> nil) and (RefSym.Kind = skModule) then
|
||||
begin
|
||||
Sym.Free();
|
||||
SemanticError(Format('Duplicate identifier ''%s''', [CD.Name]),
|
||||
CD.Line, CD.Col);
|
||||
{ Only error for same-block duplicates. Cross-unit const shadowing
|
||||
(e.g. a unit redefining a system.pas constant) is silently accepted,
|
||||
matching FPC behaviour and preserving the existing test coverage. }
|
||||
end;
|
||||
{ Same-block duplicate (the unit declares the name twice itself) is a
|
||||
hard error. }
|
||||
IsSameBlockDup := False;
|
||||
for J := 0 to I - 1 do
|
||||
if SameText(TConstDecl(ABlock.ConstDecls.Items[J]).Name, CD.Name) then
|
||||
|
|
@ -5199,7 +5199,17 @@ begin
|
|||
Break;
|
||||
end;
|
||||
if IsSameBlockDup then
|
||||
begin
|
||||
Sym.Free();
|
||||
SemanticError(Format('Duplicate identifier ''%s''', [CD.Name]), CD.Line, CD.Col);
|
||||
end;
|
||||
{ Cross-unit collision: last-in-uses wins. Detach the prior unit's
|
||||
const — kept alive via the per-unit cache for qualified access
|
||||
(Unit.Const) — and install this unit's const as the flat winner.
|
||||
Mirrors RegisterConsts on the prebuilt-import path so source-loaded
|
||||
and prebuilt deps behave identically. }
|
||||
FTable.ExtractLocal(CD.Name);
|
||||
FTable.Define(Sym);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
|
|
|||
|
|
@ -896,7 +896,13 @@ begin
|
|||
Sym.ConstString := Entry.Decl.StrVal;
|
||||
Sym.OwningUnit := AIface.Name;
|
||||
if not ATable.Define(Sym) then
|
||||
Sym.Free(); { duplicate — silently skip }
|
||||
begin
|
||||
{ EXPERIMENT (last-wins): on a duplicate name, detach the slot the
|
||||
table already holds (kept alive via the per-unit cache for
|
||||
qualified access) and store this later unit's symbol instead. }
|
||||
ATable.ExtractLocal(Entry.Decl.Name);
|
||||
ATable.Define(Sym);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
|
|
|||
|
|
@ -470,6 +470,13 @@ type
|
|||
references through every Register* helper. }
|
||||
function SymbolCount: Integer;
|
||||
function SymbolAt(AIdx: Integer): TSymbol;
|
||||
{ Detach a directly-defined symbol from this scope WITHOUT freeing
|
||||
it (FSymbols owns, so Extract not Remove). Returns the detached
|
||||
symbol, or nil if not present. Caller takes responsibility for
|
||||
the object's lifetime — used so a duplicate import can hand the
|
||||
flat-scope slot to a later unit while a per-unit cache keeps the
|
||||
original alive. }
|
||||
function ExtractLocal(const AName: string): TSymbol;
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
|
@ -595,6 +602,9 @@ type
|
|||
function Define(ASymbol: TSymbol): Boolean;
|
||||
{ Define in global (outermost) scope regardless of current push depth. }
|
||||
function DefineGlobal(ASymbol: TSymbol): Boolean;
|
||||
{ Detach a symbol from the current scope without freeing it (see
|
||||
TScope.ExtractLocal). Returns the detached symbol or nil. }
|
||||
function ExtractLocal(const AName: string): TSymbol;
|
||||
function Lookup(const AName: string): TSymbol;
|
||||
|
||||
{ Auto-OwningUnit context. When set, Define()/DefineGlobal() will
|
||||
|
|
@ -1352,6 +1362,17 @@ begin
|
|||
Result := True;
|
||||
end;
|
||||
|
||||
function TScope.ExtractLocal(const AName: string): TSymbol;
|
||||
var
|
||||
Idx: Integer;
|
||||
begin
|
||||
Result := nil;
|
||||
if not FKeys.Find(AName, Idx) then Exit;
|
||||
Result := TSymbol(FKeys.Objects[Idx]);
|
||||
FKeys.Delete(Idx); { free the name }
|
||||
FSymbols.Extract(Result); { detach without freeing }
|
||||
end;
|
||||
|
||||
function TScope.LookupLocal(const AName: string): TSymbol;
|
||||
var
|
||||
Idx: Integer;
|
||||
|
|
@ -1986,6 +2007,11 @@ begin
|
|||
Result := CurrentScope.Define(ASymbol);
|
||||
end;
|
||||
|
||||
function TSymbolTable.ExtractLocal(const AName: string): TSymbol;
|
||||
begin
|
||||
Result := CurrentScope.ExtractLocal(AName);
|
||||
end;
|
||||
|
||||
function TSymbolTable.Lookup(const AName: string): TSymbol;
|
||||
var
|
||||
I: Integer;
|
||||
|
|
|
|||
|
|
@ -146,6 +146,15 @@ type
|
|||
function CompileAndRunWithUnitNative(const AUnitName, AUnitSrc, ASrc: string;
|
||||
out AStdout: string;
|
||||
out AExitCode: Integer): Boolean;
|
||||
{ Two-written-units compile+run (QBE). Writes both units to the scratch
|
||||
dir (filename derived from each `unit <name>;` header) so the program's
|
||||
`uses` clause resolves them, then lowers + links + runs. Needed for
|
||||
cross-unit tests (two units exporting the same name: last-wins shadowing,
|
||||
unit-qualified disambiguation). Kept at 5 params (Self+5 = 6 register
|
||||
slots) so the stage-1 native ABI does not overflow. }
|
||||
function CompileAndRunWithUnits(const AUnit1Src, AUnit2Src, ASrc: string;
|
||||
out AStdout: string;
|
||||
out AExitCode: Integer): Boolean;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
|
@ -884,4 +893,91 @@ begin
|
|||
Result := True
|
||||
end;
|
||||
|
||||
{ Extract the unit name from a 'unit <name>;' header so the source can be
|
||||
written to the matching <name>.pas the unit loader expects. Strings are
|
||||
byte-indexed (S[i] returns a Byte); Pos is 0-based and returns -1 when the
|
||||
substring is absent. }
|
||||
function UnitNameOf(const ASrc: string): string;
|
||||
var
|
||||
P, Q: Integer;
|
||||
begin
|
||||
P := Pos('unit ', ASrc);
|
||||
if P < 0 then begin Result := ''; Exit; end;
|
||||
P := P + 5; { skip past 'unit ' }
|
||||
Q := P;
|
||||
while (Q < Length(ASrc)) and (ASrc[Q] <> Ord(';')) and (ASrc[Q] <> Ord(' '))
|
||||
and (ASrc[Q] <> 10) and (ASrc[Q] <> 13) do
|
||||
Q := Q + 1;
|
||||
Result := Copy(ASrc, P, Q - P);
|
||||
end;
|
||||
|
||||
function TE2ETestCase.CompileAndRunWithUnits(const AUnit1Src, AUnit2Src,
|
||||
ASrc: string;
|
||||
out AStdout: string;
|
||||
out AExitCode: Integer): Boolean;
|
||||
var
|
||||
Lexer: TLexer;
|
||||
Parser: TParser;
|
||||
Prog: TProgram;
|
||||
Semantic: TSemanticAnalyser;
|
||||
QCG: TCodeGenQBE;
|
||||
CG: ICodeGen;
|
||||
Loader: TUnitLoader;
|
||||
Units: TObjectList;
|
||||
SearchPaths: TStringList;
|
||||
Emitted: string;
|
||||
IRFile, AsmFile, BinFile, ToolOut: string;
|
||||
Rc, I: Integer;
|
||||
begin
|
||||
Result := False;
|
||||
Inc(FCounter);
|
||||
IRFile := FScratch + '/t' + IntToStr(FCounter) + '.ssa';
|
||||
AsmFile := FScratch + '/t' + IntToStr(FCounter) + '.s';
|
||||
BinFile := FScratch + '/t' + IntToStr(FCounter);
|
||||
|
||||
{ Write both user units to the scratch dir so the loader resolves them.
|
||||
Filenames are derived from each unit's own `unit <name>;` header. }
|
||||
WriteFile(FScratch + '/' + UnitNameOf(AUnit1Src) + '.pas', AUnit1Src);
|
||||
WriteFile(FScratch + '/' + UnitNameOf(AUnit2Src) + '.pas', AUnit2Src);
|
||||
|
||||
Lexer := nil; Parser := nil; Prog := nil; Semantic := nil;
|
||||
QCG := nil; CG := nil;
|
||||
Loader := nil; Units := nil; SearchPaths := nil;
|
||||
try
|
||||
Lexer := TLexer.Create(ASrc);
|
||||
Parser := TParser.Create(Lexer);
|
||||
Prog := Parser.Parse();
|
||||
Semantic := TSemanticAnalyser.Create();
|
||||
SearchPaths := TStringList.Create();
|
||||
SearchPaths.Add(FScratch);
|
||||
SearchPaths.Add(FRTLUnitPath);
|
||||
SearchPaths.Add(FStdlibUnitPath);
|
||||
Loader := TUnitLoader.Create(SearchPaths);
|
||||
Units := Loader.LoadAll(Prog.UsedUnits);
|
||||
for I := 0 to Units.Count - 1 do
|
||||
Semantic.AnalyseUnitForExport(TUnit(Units.Items[I]));
|
||||
Semantic.Analyse(Prog);
|
||||
QCG := TCodeGenQBE.Create();
|
||||
CG := QCG;
|
||||
CG.SetSymbolTable(Prog.SymbolTable);
|
||||
for I := 0 to Units.Count - 1 do
|
||||
CG.AppendUnit(TUnit(Units.Items[I]));
|
||||
CG.AppendProgram(Prog);
|
||||
Emitted := CG.GetOutput()
|
||||
finally
|
||||
QCG.Free();
|
||||
Semantic.Free();
|
||||
Units.Free(); Loader.Free(); SearchPaths.Free();
|
||||
Prog.Free(); Parser.Free(); Lexer.Free()
|
||||
end;
|
||||
|
||||
WriteFile(IRFile, Emitted);
|
||||
Rc := RunProc(FQBE, ['-o', AsmFile, IRFile], ToolOut);
|
||||
if Rc <> 0 then begin AStdout := 'qbe failed: ' + ToolOut; AExitCode := Rc; Exit end;
|
||||
Rc := LinkWithRTL(AsmFile, BinFile, ToolOut);
|
||||
if Rc <> 0 then begin AStdout := 'cc failed: ' + ToolOut; AExitCode := Rc; Exit end;
|
||||
AExitCode := RunProcNoArgs(BinFile, AStdout);
|
||||
Result := True
|
||||
end;
|
||||
|
||||
end.
|
||||
|
|
|
|||
|
|
@ -33,6 +33,11 @@ type
|
|||
procedure TestRun_QualifiedSystem_CallExprAndStmt;
|
||||
procedure TestRun_QualifiedUnit_CallAndVar;
|
||||
procedure TestRun_DottedQualifiedUnit_CallAndVar;
|
||||
{ Cross-unit const shadowing: two used units export the same const name;
|
||||
the unit later in the `uses` clause wins (last-in-uses), and reversing
|
||||
the order flips the winner. }
|
||||
procedure TestRun_CrossUnitConst_LastWins;
|
||||
procedure TestRun_CrossUnitConst_LastWins_Reversed;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
|
@ -187,6 +192,60 @@ begin
|
|||
AssertEquals('Add3(10) = 13', '13' + LE, Output);
|
||||
end;
|
||||
|
||||
const
|
||||
UA_Const = '''
|
||||
unit ua;
|
||||
interface
|
||||
const Foo = 100;
|
||||
implementation
|
||||
end.
|
||||
''';
|
||||
UB_Const = '''
|
||||
unit ub;
|
||||
interface
|
||||
const Foo = 200;
|
||||
implementation
|
||||
end.
|
||||
''';
|
||||
|
||||
procedure TE2EUsesChainTests.TestRun_CrossUnitConst_LastWins;
|
||||
const
|
||||
DrvSrc = '''
|
||||
program P;
|
||||
uses ua, ub;
|
||||
begin
|
||||
WriteLn(Foo)
|
||||
end.
|
||||
''';
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
{ Both ua and ub export `Foo`; ub is later in `uses`, so bare Foo = 200. }
|
||||
AssertTrue('compile+link+run',
|
||||
CompileAndRunWithUnits(UA_Const, UB_Const, DrvSrc, Output, RCode));
|
||||
AssertEquals('exit 0', 0, RCode);
|
||||
AssertEquals('last-in-uses (ub) wins', '200' + LE, Output);
|
||||
end;
|
||||
|
||||
procedure TE2EUsesChainTests.TestRun_CrossUnitConst_LastWins_Reversed;
|
||||
const
|
||||
DrvSrc = '''
|
||||
program P;
|
||||
uses ub, ua;
|
||||
begin
|
||||
WriteLn(Foo)
|
||||
end.
|
||||
''';
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
{ Reversed `uses` order: ua is now later, so bare Foo = 100. }
|
||||
AssertTrue('compile+link+run',
|
||||
CompileAndRunWithUnits(UA_Const, UB_Const, DrvSrc, Output, RCode));
|
||||
AssertEquals('exit 0', 0, RCode);
|
||||
AssertEquals('last-in-uses (ua) wins', '100' + LE, Output);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterTest(TE2EUsesChainTests);
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue