From e86882580d4ebcf6392ad27d18f2de1382656804 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C3=ABl=20Van=20Canneyt?= Date: Mon, 15 Jul 2024 14:09:49 +0200 Subject: [PATCH] * Do not free used units during reset, they can be in use during load cycle. Fixes issue #40852 --- compiler/fmodule.pas | 37 +++++++++++++++++++++++++++++++++---- compiler/fppu.pas | 32 ++++++++++++++++++++++---------- 2 files changed, 55 insertions(+), 14 deletions(-) diff --git a/compiler/fmodule.pas b/compiler/fmodule.pas index b1b4b0c58a..29d8034882 100644 --- a/compiler/fmodule.pas +++ b/compiler/fmodule.pas @@ -251,13 +251,14 @@ interface to that when creating link.res!!!!(mazen)} constructor create(LoadedFrom:TModule;const amodulename: string; const afilename:TPathStr;_is_unit:boolean); destructor destroy;override; - procedure reset;virtual; + procedure reset(for_recompile: boolean);virtual; procedure loadlocalnamespacelist; 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; + function findusedunit(m : tmodule) : tused_unit; function usedunitsloaded(interface_units: boolean; out firstwaiting : tmodule): boolean; function nowaitingforunits(out firstwaiting : tmodule) : Boolean; procedure updatemaps; @@ -276,6 +277,8 @@ interface function ToString: RTLString; override; end; + { tused_unit } + tused_unit = class(tlinkedlistitem) checksum, interface_checksum, @@ -789,13 +792,14 @@ implementation end; - procedure tmodule.reset; + procedure tmodule.reset(for_recompile: boolean); var i : longint; current_debuginfo_reset : boolean; m : tmodule; begin is_reset:=true; + LoadCount:=0; if assigned(scanner) then begin { also update current_scanner if it was pointing @@ -895,8 +899,18 @@ implementation _exports:=tlinkedlist.create; dllscannerinputlist.free; 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:=TLinkedList.Create; resourcefiles.Free; @@ -1111,6 +1125,21 @@ implementation 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; var oldmapsize : longint; diff --git a/compiler/fppu.pas b/compiler/fppu.pas index ab761bd269..d9036f6a65 100644 --- a/compiler/fppu.pas +++ b/compiler/fppu.pas @@ -65,7 +65,7 @@ interface {$endif def Test_Double_checksum} constructor create(LoadedFrom:TModule;const amodulename: string; const afilename:TPathStr;_is_unit:boolean); destructor destroy;override; - procedure reset;override; + procedure reset(for_recompile: boolean);override; procedure re_resolve(loadfrom: tmodule); function openppufile:boolean; function openppustream(strm:TCStream):boolean; @@ -182,14 +182,14 @@ var end; - procedure tppumodule.reset; + procedure tppumodule.reset(for_recompile : boolean); begin inc(currentdefgeneration); discardppu; freederefunitimportsyms; unitimportsymsderefs.free; unitimportsymsderefs:=tfplist.create; - inherited reset; + inherited reset(for_recompile); end; procedure tppumodule.re_resolve(loadfrom: tmodule); @@ -1318,6 +1318,7 @@ var isnew : boolean; begin + while not ppufile.endofentry do begin hs:=ppufile.getstring; @@ -1329,8 +1330,16 @@ var hp:=registerunit(self,hs,'',isnew); if isnew then 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.interface_checksum:=intfchecksum; pu.indirect_checksum:=indchecksum; @@ -1944,7 +1953,6 @@ var begin if current_module<>self then internalerror(200212284); - { load the used units from interface } in_interface:=true; pu:=tused_unit(used_units.first); @@ -1953,8 +1961,8 @@ var if pu.in_interface then begin 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; { add this unit to the dependencies } pu.u.adddependency(self,true); @@ -2196,7 +2204,7 @@ var { Flag modules to reload } flagdependent(from_module); { Reset the module } - reset; + reset(false); if state in CompileStates then begin Message1(unit_u_second_compile_unit,modulename^); @@ -2269,7 +2277,7 @@ var { Flag modules to reload } flagdependent(from_module); { Reset the module } - reset; + reset(true); { mark this module for recompilation } if not (state in [ms_compile]) then state:=ms_compile; @@ -2307,6 +2315,7 @@ var second_time : boolean; begin + Inc(LoadCount); Result:=false; Message3(unit_u_load_unit,from_module.modulename^, @@ -2382,6 +2391,9 @@ var { we are back, restore current_module } set_current_module(from_module); + { safety, so it does not become negative } + if LoadCount>0 then + Dec(LoadCount); end; procedure tppumodule.discardppu;