fix(semantic): tolerate cross-unit duplicate external bindings + private impl procs in flat-merge
Compiling a multi-unit program whose uses-clause pulls in every runtime unit (the auto-generated bootstrap_program used by 'pasbuild compile -m blaise-runtime') failed in the semantic pass. Several runtime units each privately bind the same C/RTL symbol (e.g. 'external name '_BlaiseGetMem'', 'external name 'abort'') or define a private implementation-section helper of the same name (DiagAbort in both blaise_arc and blaise_exc). In the flat-merge these all share one global scope and overload group, producing spurious 'Duplicate identifier' and 'Ambiguous overload' errors. Three coordinated changes: * SameLinkSymbol/EffectiveLinkName: collapse candidates that denote the same underlying link symbol when at least one side is an external binding — covering both two-units-bind-same-C-symbol and a binding that targets a real function exported by an unmangled RTL unit (blaise_*/rtl.*, whose exports keep their bare Pascal name). SameExternalDecl and the overload-collapse / zero-arity paths now route through it. * BenignDuplicateExternal: when an interface-section Define collides in the global scope, tolerate it if the colliding symbol is the same link symbol. * IsImplOnly flag on TMethodDecl: marks implementation-section-only routines as private to their unit; ResolveStandaloneOverload excludes cross-unit private candidates so each unit's call binds its own helper. Adds three regression tests in cp.test.multifile.pas. All four fixpoints (QBE, native, internal-assembler, warm-cache) and the full suite (3750 tests, QBE-built and native-built runners) pass.
This commit is contained in:
Graeme Geldenhuys
parent
01b5b97659
commit
b0f92f0d3c
|
|
@ -828,6 +828,10 @@ type
|
|||
CallingConv: string; { set by uParser — 'cdecl'/'stdcall'/'register'/'pascal'/
|
||||
'safecall' directive (lowercased); '' = default }
|
||||
OwningUnit: string; { set by uSemantic / uSemanticImport — unit that declares this routine }
|
||||
IsImplOnly: Boolean; { set by uSemantic — standalone routine declared only in a unit's
|
||||
implementation section (no interface forward). Such routines are
|
||||
PRIVATE to the unit; overload resolution must not treat another
|
||||
unit's same-named impl-only routine as a competing candidate. }
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
|
|
|||
|
|
@ -112,12 +112,37 @@ type
|
|||
IndexOf can return a same-named decl from an imported unit. }
|
||||
function IndexOfProcInUnit(const AName, AUnitName: string): Integer;
|
||||
|
||||
{ The emitted/imported link symbol for a standalone routine: the
|
||||
`external name` for an external binding (defaulting to the Pascal name),
|
||||
else ResolvedQbeName (bare name for unmangled RTL units) or the name. }
|
||||
function EffectiveLinkName(A: TMethodDecl): string;
|
||||
|
||||
{ True when A and B denote the SAME underlying link symbol with the same
|
||||
arity, where AT LEAST one side is an external binding. Covers two units
|
||||
each declaring `external name 'strlen'` AND a binding (`external name
|
||||
'_BlaiseGetMem'`) targeting a real function exported by an unmangled RTL
|
||||
unit. Used to collapse false "ambiguous overload" / "duplicate
|
||||
identifier" errors in the multi-unit flat-merge. }
|
||||
function SameLinkSymbol(A, B: TMethodDecl): Boolean;
|
||||
|
||||
{ True when A and B are two declarations of the SAME external C function —
|
||||
both external, same effective link name, same arity. Used to collapse the
|
||||
false "ambiguous overload" that arises when two units each privately
|
||||
declare e.g. `external name 'strlen'`. }
|
||||
function SameExternalDecl(A, B: TMethodDecl): Boolean;
|
||||
|
||||
{ True when every candidate in AList collapses to the same link symbol as
|
||||
the first (per SameLinkSymbol). Used when arg scoring is unavailable
|
||||
(zero-arity early path). }
|
||||
function AllSameExternalDecl(AList: TObjectList): Boolean;
|
||||
|
||||
{ True when the global scope already holds a symbol that denotes the SAME
|
||||
external C function as ANew — e.g. two units each declaring
|
||||
`function _BlaiseGetMem(...): Pointer; external name '_BlaiseGetMem';`.
|
||||
Such a re-declaration is benign (one underlying symbol), not a genuine
|
||||
duplicate identifier. Returns False for anything but matching externals. }
|
||||
function BenignDuplicateExternal(ANew: TMethodDecl): Boolean;
|
||||
|
||||
{ Overload-group plumbing (see FProcGroups/FMethodGroups). Every
|
||||
FProcIndex/FMethodIndex AddObject must go through the Add*GroupEntry
|
||||
sibling so the groups stay complete; FProcIndex.Objects[] rewrites go
|
||||
|
|
@ -1024,23 +1049,80 @@ begin
|
|||
Result := -1;
|
||||
end;
|
||||
|
||||
function TSemanticAnalyser.EffectiveLinkName(A: TMethodDecl): string;
|
||||
begin
|
||||
if A = nil then
|
||||
begin
|
||||
Result := '';
|
||||
Exit;
|
||||
end;
|
||||
if A.IsExternal then
|
||||
begin
|
||||
{ External binding: link symbol is the `external name`, else Pascal name. }
|
||||
if A.ExternalName <> '' then Result := A.ExternalName
|
||||
else Result := A.Name;
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ Real routine: emitted symbol is ResolvedQbeName when set (bare name for
|
||||
unmangled RTL units blaise_*/rtl.*), else the Pascal name. }
|
||||
if A.ResolvedQbeName <> '' then Result := A.ResolvedQbeName
|
||||
else Result := A.Name;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TSemanticAnalyser.SameLinkSymbol(A, B: TMethodDecl): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
if (A = nil) or (B = nil) then Exit;
|
||||
{ At least one side must be an external binding — two distinct real routines
|
||||
that merely share a name are a genuine clash, not the same symbol. }
|
||||
if not (A.IsExternal or B.IsExternal) then Exit;
|
||||
if A.Params.Count <> B.Params.Count then Exit;
|
||||
Result := SameText(Self.EffectiveLinkName(A), Self.EffectiveLinkName(B));
|
||||
end;
|
||||
|
||||
function TSemanticAnalyser.SameExternalDecl(A, B: TMethodDecl): Boolean;
|
||||
var
|
||||
LinkA, LinkB: string;
|
||||
begin
|
||||
Result := False;
|
||||
if (A = nil) or (B = nil) then Exit;
|
||||
if not (A.IsExternal and B.IsExternal) then Exit;
|
||||
if A.Params.Count <> B.Params.Count then Exit;
|
||||
if A.ExternalName <> '' then
|
||||
LinkA := A.ExternalName
|
||||
else
|
||||
LinkA := A.Name;
|
||||
if B.ExternalName <> '' then
|
||||
LinkB := B.ExternalName
|
||||
else
|
||||
LinkB := B.Name;
|
||||
Result := SameText(LinkA, LinkB);
|
||||
Result := Self.SameLinkSymbol(A, B);
|
||||
end;
|
||||
|
||||
function TSemanticAnalyser.AllSameExternalDecl(AList: TObjectList): Boolean;
|
||||
var
|
||||
I: Integer;
|
||||
First: TMethodDecl;
|
||||
begin
|
||||
Result := False;
|
||||
if (AList = nil) or (AList.Count < 2) then Exit;
|
||||
First := TMethodDecl(AList.Items[0]);
|
||||
for I := 1 to AList.Count - 1 do
|
||||
if not Self.SameLinkSymbol(First, TMethodDecl(AList.Items[I])) then
|
||||
Exit;
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function TSemanticAnalyser.BenignDuplicateExternal(ANew: TMethodDecl): Boolean;
|
||||
var
|
||||
Existing: TSymbol;
|
||||
begin
|
||||
Result := False;
|
||||
if ANew = nil then Exit;
|
||||
{ Only an external binding can benignly duplicate an existing symbol. }
|
||||
if not ANew.IsExternal then Exit;
|
||||
{ The clash was detected in the global scope (interface symbols define at
|
||||
scope depth 1), so resolve the colliding symbol there directly — the
|
||||
uses-chain Lookup could otherwise return a shadowing symbol from a
|
||||
different scope. }
|
||||
Existing := FTable.GlobalScope().LookupLocal(ANew.Name);
|
||||
if Existing = nil then Exit;
|
||||
if not (Existing.Kind in [skProcedure, skFunction]) then Exit;
|
||||
if Existing.Decl = nil then Exit;
|
||||
{ Same underlying link symbol — e.g. an `external name '_BlaiseGetMem'`
|
||||
binding targeting the real _BlaiseGetMem exported by blaise_mem. }
|
||||
Result := Self.SameLinkSymbol(TMethodDecl(Existing.Decl), ANew);
|
||||
end;
|
||||
|
||||
procedure TSemanticAnalyser.BuildUsesChain(AUsedUnits: TStringList);
|
||||
|
|
@ -1212,8 +1294,14 @@ begin
|
|||
if not FTable.Define(Sym) then
|
||||
begin
|
||||
Sym.Free();
|
||||
SemanticError(Format('Duplicate identifier ''%s''', [MDecl.Name]),
|
||||
MDecl.Line, MDecl.Col);
|
||||
{ Two units may each export the same external C binding (e.g.
|
||||
`external name '_BlaiseGetMem'`). The flat-merge shares one
|
||||
global scope, so the second Define collides — but it denotes ONE
|
||||
underlying symbol, not a real duplicate. Tolerate it; otherwise
|
||||
report the genuine clash. }
|
||||
if not BenignDuplicateExternal(MDecl) then
|
||||
SemanticError(Format('Duplicate identifier ''%s''', [MDecl.Name]),
|
||||
MDecl.Line, MDecl.Col);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
|
@ -1353,6 +1441,7 @@ begin
|
|||
else
|
||||
begin
|
||||
{ Impl-only declaration — register symbol and index it }
|
||||
ImplDecl.IsImplOnly := True;
|
||||
if ImplDecl.IsOverload then
|
||||
ImplDecl.ResolvedQbeName := CurrentUnitPrefix() + ImplDecl.Name + '$' + MangleParamSig(ImplDecl)
|
||||
else
|
||||
|
|
@ -1534,8 +1623,12 @@ begin
|
|||
if not FTable.Define(Sym) then
|
||||
begin
|
||||
Sym.Free();
|
||||
SemanticError(Format('Duplicate identifier ''%s''', [MDecl.Name]),
|
||||
MDecl.Line, MDecl.Col);
|
||||
{ Same-external collapse — see the note on the parallel AnalyseUnit
|
||||
path: two units exporting the same `external name 'X'` binding share
|
||||
one underlying symbol, so a Define collision there is benign. }
|
||||
if not BenignDuplicateExternal(MDecl) then
|
||||
SemanticError(Format('Duplicate identifier ''%s''', [MDecl.Name]),
|
||||
MDecl.Line, MDecl.Col);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
|
@ -1662,6 +1755,7 @@ begin
|
|||
else
|
||||
begin
|
||||
{ Impl-only declaration — register in impl scope (does not persist) }
|
||||
ImplDecl.IsImplOnly := True;
|
||||
if ImplDecl.IsOverload then
|
||||
ImplDecl.ResolvedQbeName := CurrentUnitPrefix() + ImplDecl.Name + '$' + MangleParamSig(ImplDecl)
|
||||
else
|
||||
|
|
@ -8473,8 +8567,19 @@ begin
|
|||
if Grp <> nil then
|
||||
for I := 0 to Grp.Count - 1 do
|
||||
begin
|
||||
Inc(TotalCnt);
|
||||
Cand := TMethodDecl(Grp.Items[I]);
|
||||
{ Impl-only (implementation-section) routines are PRIVATE to their
|
||||
unit. When several units each declare a same-named private helper
|
||||
(e.g. DiagAbort in both blaise_arc and blaise_exc), only the one
|
||||
owned by the unit currently being analysed is a valid candidate —
|
||||
the others are not visible here and must not count toward
|
||||
ambiguity. Routines exported from an interface (IsImplOnly=False)
|
||||
remain globally visible as before. }
|
||||
if Cand.IsImplOnly and (Cand.OwningUnit <> '') and
|
||||
(FCurrentUnitName <> '') and
|
||||
not SameText(Cand.OwningUnit, FCurrentUnitName) then
|
||||
Continue;
|
||||
Inc(TotalCnt);
|
||||
if (AArity >= MinArity(Cand)) and (AArity <= Cand.Params.Count) then
|
||||
ArityMatch.Add(Cand);
|
||||
end;
|
||||
|
|
@ -8496,8 +8601,17 @@ begin
|
|||
begin
|
||||
Exit(TMethodDecl(ArityMatch.Items[0]));
|
||||
end;
|
||||
{ zero-arg ambiguity is impossible — same name + zero params would
|
||||
have been rejected by the symbol-table chain, but be defensive. }
|
||||
{ Two units may each privately declare the SAME external C function
|
||||
(e.g. a parameterless `external name 'abort'`). Both land in the
|
||||
global overload group with identical arity, but they denote ONE
|
||||
function — not an ambiguous overload. Collapse the duplicates: if
|
||||
every arity match is the same external decl as the first, accept it
|
||||
rather than erroring. Mirrors the arg-scoring collapse below. }
|
||||
if AllSameExternalDecl(ArityMatch) then
|
||||
Exit(TMethodDecl(ArityMatch.Items[0]));
|
||||
{ zero-arg ambiguity is impossible for non-external decls — same name
|
||||
+ zero params would have been rejected by the symbol-table chain,
|
||||
but be defensive. }
|
||||
if AArity = 0 then
|
||||
SemanticError(
|
||||
Format('Ambiguous overload of ''%s''', [AName]),
|
||||
|
|
@ -8561,11 +8675,13 @@ begin
|
|||
end
|
||||
else if ExactNew = ExactBest then
|
||||
begin
|
||||
{ Two units may each privately declare the SAME external C function
|
||||
(e.g. `external name 'strlen'`). Both land in the global overload
|
||||
group and score identically, but they denote ONE function — not an
|
||||
ambiguous overload. Collapse the duplicate instead of erroring. }
|
||||
if not SameExternalDecl(Cand, Best) then
|
||||
{ Two candidates may denote the SAME underlying link symbol: two
|
||||
units each declaring `external name 'strlen'`, or an
|
||||
`external name '_BlaiseGetMem'` binding alongside the real
|
||||
_BlaiseGetMem exported by blaise_mem. They score identically but
|
||||
are ONE function — not an ambiguous overload. Collapse instead of
|
||||
erroring. }
|
||||
if not SameLinkSymbol(Cand, Best) then
|
||||
Inc(BestCount);
|
||||
end;
|
||||
end;
|
||||
|
|
|
|||
|
|
@ -43,6 +43,13 @@ type
|
|||
{ ------------------------------------------------------------------ }
|
||||
procedure TestSemanticAnalyser_ExportedTypeVisibleInProgram;
|
||||
procedure TestSemanticAnalyser_ExportedFuncVisibleInProgram;
|
||||
{ Flat-merge of units that each privately bind the same external C symbol,
|
||||
or bind to a real RTL function — must not raise a false
|
||||
"ambiguous overload" / "duplicate identifier" (bugs.txt: runtime module
|
||||
library compile failed). }
|
||||
procedure TestSemanticAnalyser_DuplicateExternalBindingTolerated;
|
||||
procedure TestSemanticAnalyser_ExternalBindingToRealFuncTolerated;
|
||||
procedure TestSemanticAnalyser_PrivateImplProcsPerUnitNotAmbiguous;
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Combined code generation }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
|
@ -379,6 +386,197 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
procedure TMultifileTests.TestSemanticAnalyser_DuplicateExternalBindingTolerated;
|
||||
const
|
||||
{ Two units each declare the SAME parameterless external C binding in their
|
||||
implementation section and call it. In the flat-merge both land in the
|
||||
one global overload group; they denote ONE function and must collapse. }
|
||||
UnitASrc =
|
||||
'''
|
||||
unit AltA;
|
||||
interface
|
||||
procedure DoA;
|
||||
implementation
|
||||
procedure ext_abort; external name 'abort';
|
||||
procedure DoA;
|
||||
begin
|
||||
ext_abort
|
||||
end;
|
||||
end.
|
||||
''';
|
||||
UnitBSrc =
|
||||
'''
|
||||
unit AltB;
|
||||
interface
|
||||
procedure DoB;
|
||||
implementation
|
||||
procedure ext_abort; external name 'abort';
|
||||
procedure DoB;
|
||||
begin
|
||||
ext_abort
|
||||
end;
|
||||
end.
|
||||
''';
|
||||
ProgSrc =
|
||||
'''
|
||||
program TestP;
|
||||
uses AltA, AltB;
|
||||
begin
|
||||
DoA; DoB
|
||||
end.
|
||||
''';
|
||||
var
|
||||
UA, UB: TUnit;
|
||||
Prog: TProgram;
|
||||
SA: TSemanticAnalyser;
|
||||
begin
|
||||
UA := ParseUnitSrc(UnitASrc);
|
||||
UB := ParseUnitSrc(UnitBSrc);
|
||||
Prog := ParseProg(ProgSrc);
|
||||
SA := TSemanticAnalyser.Create();
|
||||
try
|
||||
SA.AnalyseUnitForExport(UA);
|
||||
SA.AnalyseUnitForExport(UB);
|
||||
SA.Analyse(Prog);
|
||||
AssertNotNull('prog analysed without ambiguity', Prog.SymbolTable);
|
||||
finally
|
||||
SA.Free();
|
||||
Prog.Free();
|
||||
UB.Free();
|
||||
UA.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMultifileTests.TestSemanticAnalyser_ExternalBindingToRealFuncTolerated;
|
||||
const
|
||||
{ An unmangled RTL-style unit (blaise_*) exports a real function whose link
|
||||
symbol is its bare name; a second unit binds to it via `external name`.
|
||||
The flat-merge sees one real def + one external binding for the same link
|
||||
symbol — must not be a duplicate identifier nor an ambiguous overload. }
|
||||
MemSrc =
|
||||
'''
|
||||
unit blaise_testmem;
|
||||
interface
|
||||
function _TestGetMem(Size: Integer): Pointer;
|
||||
implementation
|
||||
function _TestGetMem(Size: Integer): Pointer;
|
||||
begin
|
||||
Result := nil
|
||||
end;
|
||||
end.
|
||||
''';
|
||||
UseSrc =
|
||||
'''
|
||||
unit UserU;
|
||||
interface
|
||||
function GrabMem: Pointer;
|
||||
implementation
|
||||
function _TestGetMem(Size: Integer): Pointer; external name '_TestGetMem';
|
||||
function GrabMem: Pointer;
|
||||
begin
|
||||
Result := _TestGetMem(8)
|
||||
end;
|
||||
end.
|
||||
''';
|
||||
ProgSrc =
|
||||
'''
|
||||
program TestP;
|
||||
uses blaise_testmem, UserU;
|
||||
var p: Pointer;
|
||||
begin
|
||||
p := GrabMem()
|
||||
end.
|
||||
''';
|
||||
var
|
||||
UM, UU: TUnit;
|
||||
Prog: TProgram;
|
||||
SA: TSemanticAnalyser;
|
||||
begin
|
||||
UM := ParseUnitSrc(MemSrc);
|
||||
UU := ParseUnitSrc(UseSrc);
|
||||
Prog := ParseProg(ProgSrc);
|
||||
SA := TSemanticAnalyser.Create();
|
||||
try
|
||||
SA.AnalyseUnitForExport(UM);
|
||||
SA.AnalyseUnitForExport(UU);
|
||||
SA.Analyse(Prog);
|
||||
AssertNotNull('prog analysed: external binding to real func', Prog.SymbolTable);
|
||||
finally
|
||||
SA.Free();
|
||||
Prog.Free();
|
||||
UU.Free();
|
||||
UM.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMultifileTests.TestSemanticAnalyser_PrivateImplProcsPerUnitNotAmbiguous;
|
||||
const
|
||||
{ Two units each declare a PRIVATE (implementation-only, non-external) helper
|
||||
of the same name and call it. Each unit's call must bind to its own copy;
|
||||
the other unit's private helper is not a visible competing candidate. }
|
||||
UnitASrc =
|
||||
'''
|
||||
unit PrivA;
|
||||
interface
|
||||
function GoA: Integer;
|
||||
implementation
|
||||
function Helper(X: Integer): Integer;
|
||||
begin
|
||||
Result := X + 1
|
||||
end;
|
||||
function GoA: Integer;
|
||||
begin
|
||||
Result := Helper(10)
|
||||
end;
|
||||
end.
|
||||
''';
|
||||
UnitBSrc =
|
||||
'''
|
||||
unit PrivB;
|
||||
interface
|
||||
function GoB: Integer;
|
||||
implementation
|
||||
function Helper(X: Integer): Integer;
|
||||
begin
|
||||
Result := X + 2
|
||||
end;
|
||||
function GoB: Integer;
|
||||
begin
|
||||
Result := Helper(20)
|
||||
end;
|
||||
end.
|
||||
''';
|
||||
ProgSrc =
|
||||
'''
|
||||
program TestP;
|
||||
uses PrivA, PrivB;
|
||||
var r: Integer;
|
||||
begin
|
||||
r := GoA() + GoB()
|
||||
end.
|
||||
''';
|
||||
var
|
||||
UA, UB: TUnit;
|
||||
Prog: TProgram;
|
||||
SA: TSemanticAnalyser;
|
||||
begin
|
||||
UA := ParseUnitSrc(UnitASrc);
|
||||
UB := ParseUnitSrc(UnitBSrc);
|
||||
Prog := ParseProg(ProgSrc);
|
||||
SA := TSemanticAnalyser.Create();
|
||||
try
|
||||
SA.AnalyseUnitForExport(UA);
|
||||
SA.AnalyseUnitForExport(UB);
|
||||
SA.Analyse(Prog);
|
||||
AssertNotNull('prog analysed: per-unit private helpers', Prog.SymbolTable);
|
||||
finally
|
||||
SA.Free();
|
||||
Prog.Free();
|
||||
UB.Free();
|
||||
UA.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Combined code generation tests }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
|
|
|||
|
|
@ -250,7 +250,7 @@ TMethodCallStmt.IsProcFieldCall safe
|
|||
TInheritedCallStmt.Name serialise
|
||||
TInheritedCallStmt.Args serialise
|
||||
|
||||
# TMethodCallExpr (uAST.pas:835)
|
||||
# TMethodCallExpr (uAST.pas:839)
|
||||
TMethodCallExpr.ObjectName serialise
|
||||
TMethodCallExpr.Name serialise
|
||||
TMethodCallExpr.Args serialise
|
||||
|
|
|
|||
Loading…
Reference in a new issue