paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-11 03:27:32 +01:00
Code Issues Packages Projects Releases Wiki Activity

IDE: write component: give driver stack on error

Browse Source 
git-svn-id: trunk@21299 -
This commit is contained in:
mattias 2009-08-18 23:19:27 +00:00
parent 421b5f5a30
commit 1d33c7ea11
1 changed files with 7 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
ide/main.pp
View File

@ -4694,6 +4694,7 @@ var
APackage: TLazPackage;
i: Integer;
LRSFilename: String;
PropPath: String;
begin
Result:=mrCancel;
@ -4758,18 +4759,23 @@ begin
Ancestor:=nil;
if AncestorUnit<>nil then
Ancestor:=AncestorUnit.Component;
DebugLn(['TMainIDE.DoSaveUnitComponent Writer.WriteDescendent ARoor=',AnUnitInfo.Component,' Ancestor=',DbgSName(Ancestor)]);
//DebugLn(['TMainIDE.DoSaveUnitComponent Writer.WriteDescendent ARoot=',AnUnitInfo.Component,' Ancestor=',DbgSName(Ancestor)]);
Writer.WriteDescendent(AnUnitInfo.Component,Ancestor);
if DestroyDriver then Writer.Driver.Free;
FreeAndNil(Writer);
AnUnitInfo.ComponentLastBinStreamSize:=BinCompStream.Size;
except
on E: Exception do begin
PropPath:='';
if Writer.Driver is TLRSObjectWriter then
PropPath:=TLRSObjectWriter(Writer.Driver).GetStackPath(AnUnitInfo.Component);
DumpExceptionBackTrace;
ACaption:=lisStreamingError;
AText:=Format(lisUnableToStreamT, [AnUnitInfo.ComponentName,
AnUnitInfo.ComponentName])+#13
+E.Message;
if PropPath<>'' then
AText:=Atext+#13#13+'Path: '+PropPath;
Result:=MessageDlg(ACaption, AText, mtError,
[mbAbort, mbRetry, mbIgnore], 0);
if Result=mrAbort then exit;