paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-02 15:24:11 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Remove loaded_from in tmodule. The same unit can be loaded from different places

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-02-01 12:02:12 +01:00 committed by Michael Van Canneyt
parent 9cc30829fa
commit 8aa9ac99a6
4 changed files with 112 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler/browcol.pas
View File

@ -1778,9 +1778,11 @@ begin
name:=GetStr(T.Name);
msource:=hp.mainsource;
New(UnitS, Init(Name,msource));
{ // A unit can be loaded from many other places, so a single loaded_from is misleading.
if Assigned(hp.loaded_from) then
if assigned(hp.loaded_from.globalsymtable) then
UnitS^.SetLoadedFrom(tsymtable(hp.loaded_from.globalsymtable).name^);
}
{ pimportlist(current_module^.imports^.first);}
if assigned(hp.sourcefiles) then

36
compiler/fmodule.pas
View File

@ -172,7 +172,6 @@ interface
externasmsyms : TFPHashObjectList; { contains the assembler symbols which are imported from another unit }
unitimportsyms : tfpobjectlist; { list of symbols that are imported from other units }
debuginfo : TObject;
loaded_from : tmodule;
_exports : tlinkedlist;
dllscannerinputlist : TFPHashList;
localnamespacelist,
@ -247,10 +246,11 @@ interface
destructor destroy;override;
procedure reset;virtual;
procedure loadlocalnamespacelist;
procedure adddependency(callermodule:tmodule);
procedure adddependency(callermodule:tmodule; frominterface : boolean);
procedure flagdependent(callermodule:tmodule);
procedure addimportedsym(sym:TSymEntry);
function addusedunit(hp:tmodule;inuses:boolean;usym:tunitsym):tused_unit;
function usesmodule_in_interface(m : tmodule) : boolean;
procedure updatemaps;
function derefidx_unit(id:longint):longint;
function resolve_unit(id:longint):tmodule;
@ -279,7 +279,8 @@ interface
tdependent_unit = class(tlinkedlistitem)
u : tmodule;
constructor create(_u : tmodule);
in_interface : boolean;
constructor create(_u : tmodule; frominterface : boolean);
end;
var
@ -535,9 +536,10 @@ implementation
TDENPENDENT_UNIT
****************************************************************************}
constructor tdependent_unit.create(_u : tmodule);
constructor tdependent_unit.create(_u: tmodule; frominterface: boolean);
begin
u:=_u;
in_interface:=frominterface;
end;
@ -631,7 +633,6 @@ implementation
localsymtable:=nil;
globalmacrosymtable:=nil;
localmacrosymtable:=nil;
loaded_from:=LoadedFrom;
do_reload:=false;
do_compile:=false;
sources_avail:=true;
@ -661,7 +662,7 @@ implementation
end;
destructor tmodule.Destroy;
destructor tmodule.destroy;
var
i : longint;
current_debuginfo_reset : boolean;
@ -974,13 +975,13 @@ implementation
end;
procedure tmodule.adddependency(callermodule:tmodule);
procedure tmodule.adddependency(callermodule: tmodule; frominterface: boolean);
begin
{ This is not needed for programs }
if not callermodule.is_unit then
exit;
Message2(unit_u_add_depend_to,callermodule.modulename^,modulename^);
dependent_units.concat(tdependent_unit.create(callermodule));
dependent_units.concat(tdependent_unit.create(callermodule,frominterface));
end;
@ -1026,6 +1027,21 @@ implementation
addusedunit:=pu;
end;
function tmodule.usesmodule_in_interface(m: tmodule): boolean;
var
u : tused_unit;
begin
result:=False;
u:=tused_unit(used_units.First);
while assigned(u) do
begin
if (u.u=m) then
exit(u.in_interface) ;
u:=tused_unit(u.next);
end;
end;
procedure tmodule.updatemaps;
var
@ -1211,8 +1227,8 @@ implementation
end;
procedure TModule.AddExternalImport(const libname,symname,symmangledname:string;
OrdNr: longint;isvar:boolean;ImportByOrdinalOnly:boolean);
procedure tmodule.AddExternalImport(const libname, symname, symmangledname: string; OrdNr: longint; isvar: boolean;
ImportByOrdinalOnly: boolean);
var
ImportLibrary,OtherIL : TImportLibrary;
ImportSymbol : TImportSymbol;

100
compiler/fppu.pas
View File

@ -84,8 +84,8 @@ interface
defsgeneration : longint;
function openppu(ppufiletime:longint):boolean;
function search_unit_files(onlysource:boolean):boolean;
function search_unit(onlysource,shortname:boolean):boolean;
function search_unit_files(loaded_from : tmodule; onlysource:boolean):boolean;
function search_unit(loaded_from : tmodule; onlysource,shortname:boolean):boolean;
function loadfrompackage:boolean;
procedure load_interface;
procedure load_implementation;
@ -399,23 +399,23 @@ var
end;
function tppumodule.search_unit_files(onlysource:boolean):boolean;
function tppumodule.search_unit_files(loaded_from : tmodule; onlysource:boolean):boolean;
var
found : boolean;
begin
found:=false;
if search_unit(onlysource,false) then
if search_unit(loaded_from,onlysource,false) then
found:=true;
if (not found) and
(ft83 in AllowedFilenameTransFormations) and
(length(modulename^)>8) and
search_unit(onlysource,true) then
search_unit(loaded_from,onlysource,true) then
found:=true;
search_unit_files:=found;
end;
function tppumodule.search_unit(onlysource,shortname:boolean):boolean;
function tppumodule.search_unit(loaded_from : tmodule; onlysource,shortname:boolean):boolean;
var
singlepathstring,
filename : TCmdStr;
@ -1899,7 +1899,7 @@ var
if state=ms_compiled then
exit;
{ add this unit to the dependencies }
pu.u.adddependency(self);
pu.u.adddependency(self,true);
{ need to recompile the current unit, check the interface
crc. And when not compiled with -Ur then check the complete
crc }
@ -1960,7 +1960,7 @@ var
if state=ms_compiled then
exit;
{ add this unit to the dependencies }
pu.u.adddependency(self);
pu.u.adddependency(self,false);
{ need to recompile the current unit ? }
if (pu.u.interface_crc<>pu.interface_checksum) or
(pu.u.indirect_crc<>pu.indirect_checksum) then
@ -2090,7 +2090,6 @@ var
modulename^);
{ Update loaded_from to detect cycles }
loaded_from:=from_module ;
{ check if the globalsymtable is already available, but
we must reload when the do_reload flag is set }
@ -2206,7 +2205,7 @@ var
if not do_compile then
begin
Message1(unit_u_loading_unit,modulename^);
search_unit_files(false);
search_unit_files(from_module,false);
if not do_compile then
begin
load_interface;
@ -2231,7 +2230,7 @@ var
{ recompile the unit or give a fatal error if sources not available }
if not(sources_avail) then
begin
search_unit_files(true);
search_unit_files(from_module,true);
if not(sources_avail) then
begin
printcomments;
@ -2314,15 +2313,61 @@ var
function registerunit(callermodule:tmodule;const s : TIDString;const fn:string) : tppumodule;
function FindCycle(aFile, SearchFor: TModule; var Cycle: TFPList): boolean;
// Note: when traversing, add every search file to Cycle, to avoid running in circles.
// When a cycle is detected, clear the Cycle list and build the cycle path
var
aParent: tdependent_unit;
begin
Cycle.Add(aFile);
aParent:=tdependent_unit(afile.dependent_units.First);
While Assigned(aParent) do
begin
if aParent.in_interface then
begin
// writeln('Registering ',Callermodule.get_modulename,': checking cyclic dependency of ',aFile.get_modulename, ' on ',aparent.u.get_modulename);
if aParent.u=SearchFor then
begin
// unit cycle found
Cycle.Clear;
Cycle.Add(aParent.u);
Cycle.Add(aFile);
// Writeln('exit at ',aParent.u.get_modulename);
exit(true);
end;
if Cycle.IndexOf(aParent.u)<0 then
if FindCycle(aParent.u,SearchFor,Cycle) then
begin
// Writeln('Cycle found, exit at ',aParent.u.get_modulename);
Cycle.Add(aFile);
exit(true);
end;
end;
aParent:=tdependent_unit(aParent.Next);
end;
Result:=false;
end;
var
ups : TIDString;
hp : tppumodule;
hp2 : tmodule;
cycle : TFPList;
havecycle: boolean;
{$IFDEF DEBUGCYCLE}
cyclepath : ansistring
{$ENDIF}
begin
{ Info }
ups:=upper(s);
{ search all loaded units }
hp:=tppumodule(loaded_units.first);
hp2:=nil;
while assigned(hp) do
begin
if hp.modulename^=ups then
@ -2333,18 +2378,30 @@ var
if hp.is_unit then
begin
{ both units in interface ? }
if callermodule.in_interface and
hp.in_interface then
if hp.in_interface and callermodule.usesmodule_in_interface(hp) then
begin
{ check for a cycle }
hp2:=callermodule.loaded_from;
while assigned(hp2) and (hp2<>hp) do
begin
if hp2.in_interface then
hp2:=hp2.loaded_from
else
hp2:=nil;
end;
Cycle:=TFPList.Create;
try
HaveCycle:=FindCycle(CallerModule,hp,Cycle);
Writeln('Done cycle check, have cycle: ',HaveCycle);
if HaveCycle then
begin
{$IFDEF DEBUGCYCLE}
Writeln('Done cycle check');
CyclePath:='';
hp2:=TModule(Cycle[Cycle.Count-1]);
for i:=0 to Cycle.Count-1 do begin
if i>0 then CyclePath:=CyclePath+',';
CyclePath:=CyclePath+TModule(Cycle[i]).realmodulename^;
end;
Writeln('Unit cycle detected: ',CyclePath);
{$ENDIF}
Message2(unit_f_circular_unit_reference,callermodule.realmodulename^,hp.realmodulename^);
end;
finally
Cycle.Free;
end;
if assigned(hp2) then
Message2(unit_f_circular_unit_reference,callermodule.realmodulename^,hp.realmodulename^);
end;
@ -2360,7 +2417,6 @@ var
begin
Message1(unit_u_registering_new_unit,ups);
hp:=tppumodule.create(callermodule,s,fn,true);
hp.loaded_from:=callermodule;
addloadedunit(hp);
end;
{ return }

12
compiler/pmodules.pas
View File

@ -188,7 +188,7 @@ implementation
{ load unit }
hp:=registerunit(curr,s,'');
hp.loadppu(curr);
hp.adddependency(curr);
hp.adddependency(curr,curr.in_interface);
{ add to symtable stack }
symtablestack.push(hp.globalsymtable);
if (m_mac in current_settings.modeswitches) and
@ -571,7 +571,7 @@ implementation
until false;
end;
procedure loadunits(curr: tmodule; preservest:tsymtable);
procedure loadunits(curr: tmodule; preservest:tsymtable; frominterface : boolean);
var
s,sorg : ansistring;
@ -613,7 +613,7 @@ implementation
exit;
end;
{ add this unit to the dependencies }
pu.u.adddependency(curr);
pu.u.adddependency(curr,frominterface);
{ save crc values }
pu.checksum:=pu.u.crc;
pu.interface_checksum:=pu.u.interface_crc;
@ -1088,7 +1088,7 @@ type
{ Read the implementation units }
if token=_USES then
begin
loadunits(curr,curr.globalsymtable);
loadunits(curr,curr.globalsymtable,false);
consume(_SEMICOLON);
end;
end;
@ -1230,7 +1230,7 @@ type
curr.Loadlocalnamespacelist
else
current_namespacelist:=Nil;
loadunits(curr, nil);
loadunits(curr, nil,true);
{ has it been compiled at a higher level ?}
if curr.state=ms_compiled then
begin
@ -2703,7 +2703,7 @@ type
curr.Loadlocalnamespacelist
else
current_namespacelist:=Nil;
loadunits(curr,nil);
loadunits(curr,nil,false);
consume_semicolon_after_uses:=true;
end
else