paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-05 16:27:58 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-07-15 14:09:49 +02:00
parent 73bf0c82bb
commit e86882580d
2 changed files with 55 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
compiler/fmodule.pas
View File

@ -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;
{ 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;

30
compiler/fppu.pas
View File

@ -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));
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;