paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-15 11:49:55 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: catch errors while releasing project file descriptors

Browse Source 
git-svn-id: trunk@60681 -
This commit is contained in:
mattias 2019-03-15 14:02:49 +00:00
parent 2f1e9f4be2
commit 895936a8ef
2 changed files with 16 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
components/ideintf/projectintf.pas
View File

@ -1019,7 +1019,7 @@ end;
procedure TProjectFileDescriptor.Release;
begin
//debugln('TProjectFileDescriptor.Release A ',Name,' ',dbgs(FReferenceCount));
if FReferenceCount=0 then
if FReferenceCount<=0 then
raise Exception.Create('');
dec(FReferenceCount);
if FReferenceCount=0 then Free;

16
ide/projectdefs.pas
View File

@ -902,9 +902,23 @@ end;
destructor TLazProjectFileDescriptors.Destroy;
var
i: Integer;
Name: String;
Desc: TProjectFileDescriptor;
begin
fDestroying:=true;
for i:=Count-1 downto 0 do Items[i].Release;
//for i:=Count-1 downto 0 do
// debugln(['TLazProjectFileDescriptors.Destroy ',Items[i].ClassName]);
for i:=Count-1 downto 0 do begin
Name:='Index '+IntToStr(i);
try
Desc:=Items[i];
Name:=Desc.Name+':'+Desc.ClassName;
Desc.Release;
except
on E: Exception do
debugln(['Error: (lazarus) [TLazProjectFileDescriptors.Destroy] ',Name]);
end;
end;
FItems.Free;
FItems:=nil;
ProjectFileDescriptors:=nil;