fix(units): tolerate an implementation-section circular dependency
The unit loader treated any back-edge into a unit still on the load stack as a circular dependency, rejecting a legal Object Pascal arrangement: a unit whose implementation uses a unit whose interface (transitively) uses it back. That is not a real cycle — interfaces are compiled before bodies, so the back-referenced interface is available by the time the body needs it. Split cycle detection into two stacks. FLoading still guards re-entry / infinite recursion across every edge. FIfaceChain tracks only the units reached along an unbroken chain of interface-section uses; a back-edge is a true circular dependency exactly when it closes that chain. Implementation- section uses are traversed with a fresh interface chain, so a back-edge reached through one is tolerated (the unit is already loading higher up the stack) instead of raising. An interface↔interface cycle still errors. Test: a two-unit fixture where BackA's interface uses BackB and BackB's implementation uses BackA now loads without ECircularDependency, while the existing interface↔interface DetectsCycle test still raises.
This commit is contained in:
parent
ff2d73f70d
commit
4d5fb3ac96
|
|
@ -60,7 +60,8 @@ type
|
|||
private
|
||||
FSearchPaths: TStringList; { not owned }
|
||||
FDefines: TStringList; { not owned — conditional symbols for each unit's lexer }
|
||||
FLoading: TStringList; { units currently on the load stack — cycle detection }
|
||||
FLoading: TStringList; { units currently on the load stack (any edge) — guards re-entry / infinite recursion }
|
||||
FIfaceChain: TStringList; { units reached along an unbroken chain of interface-section uses — a back-edge into this set is a true circular dependency. Implementation-section uses do NOT extend this chain (Pascal allows them to point back), so following one starts a fresh chain. }
|
||||
FLoadedNames: TStringList; { units already fully loaded }
|
||||
FSourceLoadedNames: TStringList; { units taken via the SOURCE-recompile
|
||||
path (stale cache or no cache). A
|
||||
|
|
@ -309,18 +310,29 @@ end;
|
|||
|
||||
procedure TUnitLoader.LoadTransitive(const AName: string);
|
||||
var
|
||||
Path: string;
|
||||
ObjPath: string;
|
||||
Iface: TUnitInterface;
|
||||
U: TUnit;
|
||||
I: Integer;
|
||||
Path: string;
|
||||
ObjPath: string;
|
||||
Iface: TUnitInterface;
|
||||
U: TUnit;
|
||||
I: Integer;
|
||||
SavedChain: TStringList;
|
||||
begin
|
||||
if IsBuiltin(AName) then Exit;
|
||||
if FLoadedNames.IndexOf(AName) >= 0 then Exit; { already in result list }
|
||||
|
||||
if FLoading.IndexOf(AName) >= 0 then
|
||||
raise ECircularDependency.Create(Format(
|
||||
'Circular unit dependency: ''%s''', [AName]));
|
||||
begin
|
||||
{ Already on the load stack. This is a true circular dependency only when
|
||||
the back-edge closes a chain of interface-section uses (those cannot be
|
||||
satisfied — each unit's interface needs the other's first). A back-edge
|
||||
reached through an implementation-section use is legal in Pascal, so it
|
||||
is simply skipped: the unit is already being loaded higher up the stack
|
||||
and its interface will be available by the time bodies are compiled. }
|
||||
if FIfaceChain.IndexOf(AName) >= 0 then
|
||||
raise ECircularDependency.Create(Format(
|
||||
'Circular unit dependency: ''%s''', [AName]));
|
||||
Exit;
|
||||
end;
|
||||
|
||||
{ Auto-discovery: prefer a pre-built '<name>.o' on the search path
|
||||
when it carries an embedded iface section. The .o + embedded
|
||||
|
|
@ -348,7 +360,10 @@ begin
|
|||
if Iface <> nil then
|
||||
begin
|
||||
FLoading.Add(AName);
|
||||
FIfaceChain.Add(AName);
|
||||
try
|
||||
{ A prebuilt .bif carries only interface-section uses, so these all
|
||||
extend the interface chain. }
|
||||
for I := 0 to Iface.UsedUnits.Count - 1 do
|
||||
LoadTransitive(Iface.UsedUnits.Strings[I]);
|
||||
{ Staleness propagation: if any interface-use dependency was taken via
|
||||
|
|
@ -385,6 +400,7 @@ begin
|
|||
end;
|
||||
finally
|
||||
FLoading.Delete(FLoading.IndexOf(AName));
|
||||
FIfaceChain.Delete(FIfaceChain.IndexOf(AName));
|
||||
end;
|
||||
if Iface <> nil then
|
||||
Exit; { cached path taken — done. Otherwise fall through to source. }
|
||||
|
|
@ -397,17 +413,33 @@ begin
|
|||
'Unit ''%s'' not found in search paths', [AName]));
|
||||
|
||||
FLoading.Add(AName);
|
||||
FIfaceChain.Add(AName);
|
||||
U := nil;
|
||||
try
|
||||
U := LoadOne(Path);
|
||||
{ Post-order DFS: process dependencies before this unit.
|
||||
Both interface- and implementation-section uses are loaded —
|
||||
they are stored on separate lists since the parser was
|
||||
taught to split them, but the loader still needs both. }
|
||||
{ Post-order DFS: process dependencies before this unit. Both interface-
|
||||
and implementation-section uses are loaded — the parser splits them into
|
||||
separate lists.
|
||||
|
||||
Interface-section uses extend the interface chain, so a loop among them
|
||||
is reported as a circular dependency. Implementation-section uses are
|
||||
traversed with a FRESH interface chain: Pascal permits a unit's
|
||||
implementation to use a unit whose interface (transitively) uses it
|
||||
back, and that is not a real cycle (interfaces compile first, bodies
|
||||
after). A back-edge into a unit still on the load stack is then
|
||||
tolerated by the guard at the top of this routine. }
|
||||
for I := 0 to U.UsedUnits.Count - 1 do
|
||||
LoadTransitive(U.UsedUnits.Strings[I]);
|
||||
for I := 0 to U.ImplUsedUnits.Count - 1 do
|
||||
LoadTransitive(U.ImplUsedUnits.Strings[I]);
|
||||
SavedChain := FIfaceChain;
|
||||
FIfaceChain := TStringList.Create();
|
||||
FIfaceChain.CaseSensitive := False;
|
||||
try
|
||||
for I := 0 to U.ImplUsedUnits.Count - 1 do
|
||||
LoadTransitive(U.ImplUsedUnits.Strings[I]);
|
||||
finally
|
||||
FIfaceChain.Free();
|
||||
FIfaceChain := SavedChain;
|
||||
end;
|
||||
{ Append this unit after all its dependencies }
|
||||
FResult.Add(U);
|
||||
FLoadedNames.Add(AName);
|
||||
|
|
@ -420,6 +452,7 @@ begin
|
|||
finally
|
||||
U.Free(); { no-op if U = nil (success path) or on error }
|
||||
FLoading.Delete(FLoading.IndexOf(AName));
|
||||
FIfaceChain.Delete(FIfaceChain.IndexOf(AName));
|
||||
end;
|
||||
end;
|
||||
|
||||
|
|
@ -431,6 +464,8 @@ begin
|
|||
FDefines := ADefines;
|
||||
FLoading := TStringList.Create();
|
||||
FLoading.CaseSensitive := False;
|
||||
FIfaceChain := TStringList.Create();
|
||||
FIfaceChain.CaseSensitive := False;
|
||||
FLoadedNames := TStringList.Create();
|
||||
FLoadedNames.CaseSensitive := False;
|
||||
FSourceLoadedNames := TStringList.Create();
|
||||
|
|
@ -452,6 +487,7 @@ begin
|
|||
FPrebuiltIfaces.Free();
|
||||
FSourceLoadedNames.Free();
|
||||
FLoadedNames.Free();
|
||||
FIfaceChain.Free();
|
||||
FLoading.Free();
|
||||
inherited Destroy();
|
||||
end;
|
||||
|
|
|
|||
|
|
@ -37,6 +37,7 @@ type
|
|||
procedure TestUnitLoader_LocatesUnitInSearchPath;
|
||||
procedure TestUnitLoader_RaisesOnMissingUnit;
|
||||
procedure TestUnitLoader_DetectsCycle;
|
||||
procedure TestUnitLoader_ImplSectionBackEdge_Tolerated;
|
||||
procedure TestUnitLoader_DependencyOrder;
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ AnalyseUnitForExport }
|
||||
|
|
@ -241,6 +242,57 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
procedure TMultifileTests.TestUnitLoader_ImplSectionBackEdge_Tolerated;
|
||||
const
|
||||
{ BackA's INTERFACE uses BackB; BackB's IMPLEMENTATION uses BackA. This is a
|
||||
legal Object Pascal arrangement — interfaces are compiled before bodies, so
|
||||
BackB's body may name BackA even though BackA's interface (transitively)
|
||||
needs BackB. It must load without an ECircularDependency, unlike the
|
||||
interface↔interface cycle above. }
|
||||
SrcA =
|
||||
'''
|
||||
unit BackA;
|
||||
interface
|
||||
uses BackB;
|
||||
implementation
|
||||
end.
|
||||
''';
|
||||
SrcB =
|
||||
'''
|
||||
unit BackB;
|
||||
interface
|
||||
implementation
|
||||
uses BackA;
|
||||
end.
|
||||
''';
|
||||
var
|
||||
Paths: TStringList;
|
||||
Loader: TUnitLoader;
|
||||
Names: TStringList;
|
||||
Units: TObjectList;
|
||||
begin
|
||||
WriteUnit('BackA', SrcA);
|
||||
WriteUnit('BackB', SrcB);
|
||||
|
||||
Paths := MakeSearchPaths();
|
||||
Loader := TUnitLoader.Create(Paths);
|
||||
Names := TStringList.Create();
|
||||
try
|
||||
Names.Add('BackA');
|
||||
{ Must NOT raise — the back-edge is through an implementation-section use. }
|
||||
Units := Loader.LoadAll(Names);
|
||||
try
|
||||
AssertEquals('both units loaded', 2, Units.Count);
|
||||
finally
|
||||
Units.Free();
|
||||
end;
|
||||
finally
|
||||
Names.Free();
|
||||
Loader.Free();
|
||||
Paths.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMultifileTests.TestUnitLoader_DependencyOrder;
|
||||
const
|
||||
SrcC =
|
||||
|
|
|
|||
Loading…
Reference in a new issue