paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-10 03:07:40 +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); name:=GetStr(T.Name);
msource:=hp.mainsource; msource:=hp.mainsource;
New(UnitS, Init(Name,msource)); 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) then
if assigned(hp.loaded_from.globalsymtable) then if assigned(hp.loaded_from.globalsymtable) then
UnitS^.SetLoadedFrom(tsymtable(hp.loaded_from.globalsymtable).name^); UnitS^.SetLoadedFrom(tsymtable(hp.loaded_from.globalsymtable).name^);
}
{ pimportlist(current_module^.imports^.first);} { pimportlist(current_module^.imports^.first);}
if assigned(hp.sourcefiles) then 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 } externasmsyms : TFPHashObjectList; { contains the assembler symbols which are imported from another unit }
unitimportsyms : tfpobjectlist; { list of symbols that are imported from other units } unitimportsyms : tfpobjectlist; { list of symbols that are imported from other units }
debuginfo : TObject; debuginfo : TObject;
loaded_from : tmodule;
_exports : tlinkedlist; _exports : tlinkedlist;
dllscannerinputlist : TFPHashList; dllscannerinputlist : TFPHashList;
localnamespacelist, localnamespacelist,
@ -247,10 +246,11 @@ interface
destructor destroy;override; destructor destroy;override;
procedure reset;virtual; procedure reset;virtual;
procedure loadlocalnamespacelist; procedure loadlocalnamespacelist;
procedure adddependency(callermodule:tmodule); procedure adddependency(callermodule:tmodule; frominterface : boolean);
procedure flagdependent(callermodule:tmodule); procedure flagdependent(callermodule:tmodule);
procedure addimportedsym(sym:TSymEntry); procedure addimportedsym(sym:TSymEntry);
function addusedunit(hp:tmodule;inuses:boolean;usym:tunitsym):tused_unit; function addusedunit(hp:tmodule;inuses:boolean;usym:tunitsym):tused_unit;
function usesmodule_in_interface(m : tmodule) : boolean;
procedure updatemaps; procedure updatemaps;
function derefidx_unit(id:longint):longint; function derefidx_unit(id:longint):longint;
function resolve_unit(id:longint):tmodule; function resolve_unit(id:longint):tmodule;
@ -279,7 +279,8 @@ interface
tdependent_unit = class(tlinkedlistitem) tdependent_unit = class(tlinkedlistitem)
u : tmodule; u : tmodule;
constructor create(_u : tmodule); in_interface : boolean;
constructor create(_u : tmodule; frominterface : boolean);
end; end;
var var
@ -535,9 +536,10 @@ implementation
TDENPENDENT_UNIT TDENPENDENT_UNIT
****************************************************************************} ****************************************************************************}
constructor tdependent_unit.create(_u : tmodule); constructor tdependent_unit.create(_u: tmodule; frominterface: boolean);
begin begin
u:=_u; u:=_u;
in_interface:=frominterface;
end; end;
@ -631,7 +633,6 @@ implementation
localsymtable:=nil; localsymtable:=nil;
globalmacrosymtable:=nil; globalmacrosymtable:=nil;
localmacrosymtable:=nil; localmacrosymtable:=nil;
loaded_from:=LoadedFrom;
do_reload:=false; do_reload:=false;
do_compile:=false; do_compile:=false;
sources_avail:=true; sources_avail:=true;
@ -661,7 +662,7 @@ implementation
end; end;
destructor tmodule.Destroy; destructor tmodule.destroy;
var var
i : longint; i : longint;
current_debuginfo_reset : boolean; current_debuginfo_reset : boolean;
@ -974,13 +975,13 @@ implementation
end; end;
procedure tmodule.adddependency(callermodule:tmodule); procedure tmodule.adddependency(callermodule: tmodule; frominterface: boolean);
begin begin
{ This is not needed for programs } { This is not needed for programs }
if not callermodule.is_unit then if not callermodule.is_unit then
exit; exit;
Message2(unit_u_add_depend_to,callermodule.modulename^,modulename^); 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; end;
@ -1026,6 +1027,21 @@ implementation
addusedunit:=pu; addusedunit:=pu;
end; 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; procedure tmodule.updatemaps;
var var
@ -1211,8 +1227,8 @@ implementation
end; end;
procedure TModule.AddExternalImport(const libname,symname,symmangledname:string; procedure tmodule.AddExternalImport(const libname, symname, symmangledname: string; OrdNr: longint; isvar: boolean;
OrdNr: longint;isvar:boolean;ImportByOrdinalOnly:boolean); ImportByOrdinalOnly: boolean);
var var
ImportLibrary,OtherIL : TImportLibrary; ImportLibrary,OtherIL : TImportLibrary;
ImportSymbol : TImportSymbol; ImportSymbol : TImportSymbol;

96
compiler/fppu.pas
View File

@ -84,8 +84,8 @@ interface
defsgeneration : longint; defsgeneration : longint;
function openppu(ppufiletime:longint):boolean; function openppu(ppufiletime:longint):boolean;
function search_unit_files(onlysource:boolean):boolean; function search_unit_files(loaded_from : tmodule; onlysource:boolean):boolean;
function search_unit(onlysource,shortname:boolean):boolean; function search_unit(loaded_from : tmodule; onlysource,shortname:boolean):boolean;
function loadfrompackage:boolean; function loadfrompackage:boolean;
procedure load_interface; procedure load_interface;
procedure load_implementation; procedure load_implementation;
@ -399,23 +399,23 @@ var
end; end;
function tppumodule.search_unit_files(onlysource:boolean):boolean; function tppumodule.search_unit_files(loaded_from : tmodule; onlysource:boolean):boolean;
var var
found : boolean; found : boolean;
begin begin
found:=false; found:=false;
if search_unit(onlysource,false) then if search_unit(loaded_from,onlysource,false) then
found:=true; found:=true;
if (not found) and if (not found) and
(ft83 in AllowedFilenameTransFormations) and (ft83 in AllowedFilenameTransFormations) and
(length(modulename^)>8) and (length(modulename^)>8) and
search_unit(onlysource,true) then search_unit(loaded_from,onlysource,true) then
found:=true; found:=true;
search_unit_files:=found; search_unit_files:=found;
end; end;
function tppumodule.search_unit(onlysource,shortname:boolean):boolean; function tppumodule.search_unit(loaded_from : tmodule; onlysource,shortname:boolean):boolean;
var var
singlepathstring, singlepathstring,
filename : TCmdStr; filename : TCmdStr;
@ -1899,7 +1899,7 @@ var
if state=ms_compiled then if state=ms_compiled then
exit; exit;
{ add this unit to the dependencies } { add this unit to the dependencies }
pu.u.adddependency(self); pu.u.adddependency(self,true);
{ need to recompile the current unit, check the interface { need to recompile the current unit, check the interface
crc. And when not compiled with -Ur then check the complete crc. And when not compiled with -Ur then check the complete
crc } crc }
@ -1960,7 +1960,7 @@ var
if state=ms_compiled then if state=ms_compiled then
exit; exit;
{ add this unit to the dependencies } { add this unit to the dependencies }
pu.u.adddependency(self); pu.u.adddependency(self,false);
{ need to recompile the current unit ? } { need to recompile the current unit ? }
if (pu.u.interface_crc<>pu.interface_checksum) or if (pu.u.interface_crc<>pu.interface_checksum) or
(pu.u.indirect_crc<>pu.indirect_checksum) then (pu.u.indirect_crc<>pu.indirect_checksum) then
@ -2090,7 +2090,6 @@ var
modulename^); modulename^);
{ Update loaded_from to detect cycles } { Update loaded_from to detect cycles }
loaded_from:=from_module ;
{ check if the globalsymtable is already available, but { check if the globalsymtable is already available, but
we must reload when the do_reload flag is set } we must reload when the do_reload flag is set }
@ -2206,7 +2205,7 @@ var
if not do_compile then if not do_compile then
begin begin
Message1(unit_u_loading_unit,modulename^); Message1(unit_u_loading_unit,modulename^);
search_unit_files(false); search_unit_files(from_module,false);
if not do_compile then if not do_compile then
begin begin
load_interface; load_interface;
@ -2231,7 +2230,7 @@ var
{ recompile the unit or give a fatal error if sources not available } { recompile the unit or give a fatal error if sources not available }
if not(sources_avail) then if not(sources_avail) then
begin begin
search_unit_files(true); search_unit_files(from_module,true);
if not(sources_avail) then if not(sources_avail) then
begin begin
printcomments; printcomments;
@ -2314,15 +2313,61 @@ var
function registerunit(callermodule:tmodule;const s : TIDString;const fn:string) : tppumodule; 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 var
ups : TIDString; ups : TIDString;
hp : tppumodule; hp : tppumodule;
hp2 : tmodule; hp2 : tmodule;
cycle : TFPList;
havecycle: boolean;
{$IFDEF DEBUGCYCLE}
cyclepath : ansistring
{$ENDIF}
begin begin
{ Info } { Info }
ups:=upper(s); ups:=upper(s);
{ search all loaded units } { search all loaded units }
hp:=tppumodule(loaded_units.first); hp:=tppumodule(loaded_units.first);
hp2:=nil;
while assigned(hp) do while assigned(hp) do
begin begin
if hp.modulename^=ups then if hp.modulename^=ups then
@ -2333,17 +2378,29 @@ var
if hp.is_unit then if hp.is_unit then
begin begin
{ both units in interface ? } { both units in interface ? }
if callermodule.in_interface and if hp.in_interface and callermodule.usesmodule_in_interface(hp) then
hp.in_interface then
begin begin
{ check for a cycle } { check for a cycle }
hp2:=callermodule.loaded_from; Cycle:=TFPList.Create;
while assigned(hp2) and (hp2<>hp) do try
HaveCycle:=FindCycle(CallerModule,hp,Cycle);
Writeln('Done cycle check, have cycle: ',HaveCycle);
if HaveCycle then
begin begin
if hp2.in_interface then {$IFDEF DEBUGCYCLE}
hp2:=hp2.loaded_from Writeln('Done cycle check');
else CyclePath:='';
hp2:=nil; 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; end;
if assigned(hp2) then if assigned(hp2) then
Message2(unit_f_circular_unit_reference,callermodule.realmodulename^,hp.realmodulename^); Message2(unit_f_circular_unit_reference,callermodule.realmodulename^,hp.realmodulename^);
@ -2360,7 +2417,6 @@ var
begin begin
Message1(unit_u_registering_new_unit,ups); Message1(unit_u_registering_new_unit,ups);
hp:=tppumodule.create(callermodule,s,fn,true); hp:=tppumodule.create(callermodule,s,fn,true);
hp.loaded_from:=callermodule;
addloadedunit(hp); addloadedunit(hp);
end; end;
{ return } { return }

12
compiler/pmodules.pas
View File

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