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

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

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;

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 }

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