Browse Source

* Do not free used units during reset, they can be in use during load cycle. Fixes issue #40852

Michaël Van Canneyt 1 year ago
parent
commit
e86882580d
2 changed files with 55 additions and 14 deletions
  1. 33 4
      compiler/fmodule.pas
  2. 22 10
      compiler/fppu.pas

+ 33 - 4
compiler/fmodule.pas

@@ -251,13 +251,14 @@ interface
         to that when creating link.res!!!!(mazen)}
         to that when creating link.res!!!!(mazen)}
         constructor create(LoadedFrom:TModule;const amodulename: string; const afilename:TPathStr;_is_unit:boolean);
         constructor create(LoadedFrom:TModule;const amodulename: string; const afilename:TPathStr;_is_unit:boolean);
         destructor destroy;override;
         destructor destroy;override;
-        procedure reset;virtual;
+        procedure reset(for_recompile: boolean);virtual;
         procedure loadlocalnamespacelist;
         procedure loadlocalnamespacelist;
         procedure adddependency(callermodule:tmodule; frominterface : boolean);
         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;
         function  usesmodule_in_interface(m : tmodule) : boolean;
+        function findusedunit(m : tmodule) : tused_unit;
         function usedunitsloaded(interface_units: boolean; out firstwaiting : tmodule): boolean;
         function usedunitsloaded(interface_units: boolean; out firstwaiting : tmodule): boolean;
         function nowaitingforunits(out firstwaiting : tmodule) : Boolean;
         function nowaitingforunits(out firstwaiting : tmodule) : Boolean;
         procedure updatemaps;
         procedure updatemaps;
@@ -276,6 +277,8 @@ interface
         function ToString: RTLString; override;
         function ToString: RTLString; override;
       end;
       end;
 
 
+       { tused_unit }
+
        tused_unit = class(tlinkedlistitem)
        tused_unit = class(tlinkedlistitem)
           checksum,
           checksum,
           interface_checksum,
           interface_checksum,
@@ -789,13 +792,14 @@ implementation
       end;
       end;
 
 
 
 
-    procedure tmodule.reset;
+    procedure tmodule.reset(for_recompile: boolean);
       var
       var
         i   : longint;
         i   : longint;
         current_debuginfo_reset : boolean;
         current_debuginfo_reset : boolean;
         m : tmodule;
         m : tmodule;
       begin
       begin
         is_reset:=true;
         is_reset:=true;
+        LoadCount:=0;
         if assigned(scanner) then
         if assigned(scanner) then
           begin
           begin
             { also update current_scanner if it was pointing
             { also update current_scanner if it was pointing
@@ -895,8 +899,18 @@ implementation
         _exports:=tlinkedlist.create;
         _exports:=tlinkedlist.create;
         dllscannerinputlist.free;
         dllscannerinputlist.free;
         dllscannerinputlist:=TFPHashList.create;
         dllscannerinputlist:=TFPHashList.create;
-        used_units.free;
-        used_units:=TLinkedList.Create;
+        { During reload, the list of used units cannot change.
+          It can only change while recompiling.
+          Because the used_units is used in loops in the load cycle(s) which
+          can recurse into the same unit due to circular dependencies,
+          we do not destroy the list, we only update the contents.
+          As a result so the loop variable does not get reset during the loop.
+          For recompile, we recreate the list }
+        if for_recompile then
+          begin
+          used_units.free;
+          used_units:=TLinkedList.Create;
+          end;
         dependent_units.free;
         dependent_units.free;
         dependent_units:=TLinkedList.Create;
         dependent_units:=TLinkedList.Create;
         resourcefiles.Free;
         resourcefiles.Free;
@@ -1111,6 +1125,21 @@ implementation
           end;
           end;
       end;
       end;
 
 
+    function tmodule.findusedunit(m: tmodule): tused_unit;
+    var
+      u : tused_unit;
+
+    begin
+      result:=nil;
+      u:=tused_unit(used_units.First);
+      while assigned(u) do
+        begin
+        if (u.u=m) then
+          exit(u);
+        u:=tused_unit(u.next);
+        end;
+    end;
+
     procedure tmodule.updatemaps;
     procedure tmodule.updatemaps;
       var
       var
         oldmapsize : longint;
         oldmapsize : longint;

+ 22 - 10
compiler/fppu.pas

@@ -65,7 +65,7 @@ interface
 {$endif def Test_Double_checksum}
 {$endif def Test_Double_checksum}
           constructor create(LoadedFrom:TModule;const amodulename: string; const afilename:TPathStr;_is_unit:boolean);
           constructor create(LoadedFrom:TModule;const amodulename: string; const afilename:TPathStr;_is_unit:boolean);
           destructor destroy;override;
           destructor destroy;override;
-          procedure reset;override;
+          procedure reset(for_recompile: boolean);override;
           procedure re_resolve(loadfrom: tmodule);
           procedure re_resolve(loadfrom: tmodule);
           function  openppufile:boolean;
           function  openppufile:boolean;
           function  openppustream(strm:TCStream):boolean;
           function  openppustream(strm:TCStream):boolean;
@@ -182,14 +182,14 @@ var
       end;
       end;
 
 
 
 
-    procedure tppumodule.reset;
+    procedure tppumodule.reset(for_recompile : boolean);
       begin
       begin
         inc(currentdefgeneration);
         inc(currentdefgeneration);
         discardppu;
         discardppu;
         freederefunitimportsyms;
         freederefunitimportsyms;
         unitimportsymsderefs.free;
         unitimportsymsderefs.free;
         unitimportsymsderefs:=tfplist.create;
         unitimportsymsderefs:=tfplist.create;
-        inherited reset;
+        inherited reset(for_recompile);
       end;
       end;
 
 
     procedure tppumodule.re_resolve(loadfrom: tmodule);
     procedure tppumodule.re_resolve(loadfrom: tmodule);
@@ -1318,6 +1318,7 @@ var
         isnew : boolean;
         isnew : boolean;
 
 
       begin
       begin
+
         while not ppufile.endofentry do
         while not ppufile.endofentry do
          begin
          begin
            hs:=ppufile.getstring;
            hs:=ppufile.getstring;
@@ -1329,8 +1330,16 @@ var
            hp:=registerunit(self,hs,'',isnew);
            hp:=registerunit(self,hs,'',isnew);
            if isnew then
            if isnew then
              usedunits.Concat(tused_unit.create(hp,in_interface,true,nil));
              usedunits.Concat(tused_unit.create(hp,in_interface,true,nil));
-
-           pu:=addusedunit(hp,false,nil);
+           if LoadCount=1 then
+             pu:=addusedunit(hp,false,nil)
+           else
+             begin
+             pu:=findusedunit(hp);
+             { Safety, normally this should not happen:
+               The used units list cannot change between loads unless recompiled and then loadcount is 1... }
+             if pu=nil then
+               pu:=addusedunit(hp,false,nil);
+             end;
            pu.checksum:=checksum;
            pu.checksum:=checksum;
            pu.interface_checksum:=intfchecksum;
            pu.interface_checksum:=intfchecksum;
            pu.indirect_checksum:=indchecksum;
            pu.indirect_checksum:=indchecksum;
@@ -1944,7 +1953,6 @@ var
       begin
       begin
         if current_module<>self then
         if current_module<>self then
          internalerror(200212284);
          internalerror(200212284);
-
         { load the used units from interface }
         { load the used units from interface }
         in_interface:=true;
         in_interface:=true;
         pu:=tused_unit(used_units.first);
         pu:=tused_unit(used_units.first);
@@ -1953,8 +1961,8 @@ var
            if pu.in_interface then
            if pu.in_interface then
             begin
             begin
               tppumodule(pu.u).loadppu(self);
               tppumodule(pu.u).loadppu(self);
-              { if this unit is compiled we can stop }
-              if state in [ms_compiled,ms_processed] then
+              { if this unit is scheduled for compilation or compiled we can stop }
+              if state in [ms_compile,ms_compiled,ms_processed] then
                exit;
                exit;
               { add this unit to the dependencies }
               { add this unit to the dependencies }
               pu.u.adddependency(self,true);
               pu.u.adddependency(self,true);
@@ -2196,7 +2204,7 @@ var
           { Flag modules to reload }
           { Flag modules to reload }
           flagdependent(from_module);
           flagdependent(from_module);
           { Reset the module }
           { Reset the module }
-          reset;
+          reset(false);
           if state in CompileStates then
           if state in CompileStates then
             begin
             begin
               Message1(unit_u_second_compile_unit,modulename^);
               Message1(unit_u_second_compile_unit,modulename^);
@@ -2269,7 +2277,7 @@ var
         { Flag modules to reload }
         { Flag modules to reload }
         flagdependent(from_module);
         flagdependent(from_module);
         { Reset the module }
         { Reset the module }
-        reset;
+        reset(true);
         { mark this module for recompilation }
         { mark this module for recompilation }
         if not (state in [ms_compile]) then
         if not (state in [ms_compile]) then
           state:=ms_compile;
           state:=ms_compile;
@@ -2307,6 +2315,7 @@ var
         second_time        : boolean;
         second_time        : boolean;
 
 
       begin
       begin
+        Inc(LoadCount);
 
 
         Result:=false;
         Result:=false;
         Message3(unit_u_load_unit,from_module.modulename^,
         Message3(unit_u_load_unit,from_module.modulename^,
@@ -2382,6 +2391,9 @@ var
 
 
         { we are back, restore current_module }
         { we are back, restore current_module }
         set_current_module(from_module);
         set_current_module(from_module);
+        { safety, so it does not become negative }
+        if LoadCount>0 then
+          Dec(LoadCount);
       end;
       end;
 
 
     procedure tppumodule.discardppu;
     procedure tppumodule.discardppu;