paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 01:02:41 +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; procedure TProjectFileDescriptor.Release;
begin begin
//debugln('TProjectFileDescriptor.Release A ',Name,' ',dbgs(FReferenceCount)); //debugln('TProjectFileDescriptor.Release A ',Name,' ',dbgs(FReferenceCount));
if FReferenceCount=0 then if FReferenceCount<=0 then
raise Exception.Create(''); raise Exception.Create('');
dec(FReferenceCount); dec(FReferenceCount);
if FReferenceCount=0 then Free; if FReferenceCount=0 then Free;

16
ide/projectdefs.pas
View File

@ -902,9 +902,23 @@ end;
destructor TLazProjectFileDescriptors.Destroy; destructor TLazProjectFileDescriptors.Destroy;
var var
i: Integer; i: Integer;
Name: String;
Desc: TProjectFileDescriptor;
begin begin
fDestroying:=true; 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.Free;
FItems:=nil; FItems:=nil;
ProjectFileDescriptors:=nil; ProjectFileDescriptors:=nil;