diff --git a/compiler/browcol.pas b/compiler/browcol.pas index 49148954d6..571840e16c 100644 --- a/compiler/browcol.pas +++ b/compiler/browcol.pas @@ -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 diff --git a/compiler/fmodule.pas b/compiler/fmodule.pas index 517f485fe3..d7c5d5c0e2 100644 --- a/compiler/fmodule.pas +++ b/compiler/fmodule.pas @@ -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; diff --git a/compiler/fppu.pas b/compiler/fppu.pas index bda6d50263..8f3ffc7bde 100644 --- a/compiler/fppu.pas +++ b/compiler/fppu.pas @@ -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 } diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas index dea07de7be..3cac1de8ba 100644 --- a/compiler/pmodules.pas +++ b/compiler/pmodules.pas @@ -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