From c15be9e2e1f03467403a3617b6a6aaa15015573f Mon Sep 17 00:00:00 2001 From: sekelsenmat Date: Wed, 25 Nov 2009 17:53:24 +0000 Subject: [PATCH] New fix for bug #15075 git-svn-id: trunk@22775 - --- designer/jitforms.pp | 2 -- ide/customformeditor.pp | 12 ------------ ide/exttooldialog.lfm | 2 +- ide/exttooldialog.lrs | 2 +- ide/exttooldialog.pas | 2 -- ide/main.pp | 8 -------- lcl/forms.pp | 15 +++++---------- lcl/include/application.inc | 4 ---- lcl/lclproc.pas | 8 +++++--- lcl/translations.pas | 2 -- 10 files changed, 12 insertions(+), 45 deletions(-) diff --git a/designer/jitforms.pp b/designer/jitforms.pp index 300d74e399..13d92472c6 100644 --- a/designer/jitforms.pp +++ b/designer/jitforms.pp @@ -1171,9 +1171,7 @@ begin // first write error to debug DebugLn(Context+' Error: '+FCurReadErrorMsg); // then try to give a backtrace -{$IFDEF DEBUG_ALLOW_DUMPBACKTRACE} DumpExceptionBackTrace; -{$ENDIF} if Assigned(OnException) then OnException(Self,E,Action) else begin diff --git a/ide/customformeditor.pp b/ide/customformeditor.pp index 28ad2bf6ba..1df737a962 100644 --- a/ide/customformeditor.pp +++ b/ide/customformeditor.pp @@ -424,9 +424,7 @@ Begin on E: Exception do begin DebugLn('TryFreeComponent ERROR:', ' "'+OldName+':'+OldClassName+'" ',E.Message); - {$IFDEF DEBUG_ALLOW_DUMPBACKTRACE} DumpExceptionBackTrace; - {$ENDIF} MessageDlg('Error', 'An exception occured during deletion of'#13 +'"'+OldName+':'+OldClassName+'"'#13 @@ -1465,9 +1463,7 @@ begin except on E: Exception do begin DebugLn(['TCustomFormEditor.SaveUnitComponentToBinStream ',E.Message]); - {$IFDEF DEBUG_ALLOW_DUMPBACKTRACE} DumpExceptionBackTrace; - {$ENDIF} Result:=MessageDlg(lisStreamingError, Format(lisUnableToStreamT, [AnUnitInfo.ComponentName, AnUnitInfo.ComponentName])+#13 @@ -1650,9 +1646,7 @@ begin NewComponent.Create(OwnerComponent); except on e: Exception do begin - {$IFDEF DEBUG_ALLOW_DUMPBACKTRACE} DumpExceptionBackTrace; - {$ENDIF} MessageDlg('Error creating component', 'Error creating component: '+TypeClass.ClassName+#13+E.Message, mtError,[mbCancel],0); @@ -1822,9 +1816,7 @@ begin except on e: Exception do begin DebugLn(e.Message); - {$IFDEF DEBUG_ALLOW_DUMPBACKTRACE} DumpExceptionBackTrace; - {$ENDIF} MessageDlg(lisErrorMovingComponent, Format(lisErrorMovingComponent2, [NewComponent.Name, NewComponent.ClassName]), @@ -1854,9 +1846,7 @@ begin +' of unit '+AUnitName+':'#13 +E.Message; DebugLn(['TCustomFormEditor.CreateComponent ',s]); - {$IFDEF DEBUG_ALLOW_DUMPBACKTRACE} DumpExceptionBackTrace; - {$ENDIF} MessageDlg('Error destroying mediator',s,mtError,[mbCancel],0); end; end; @@ -1873,9 +1863,7 @@ begin +' of unit '+AUnitName+':'#13 +E.Message; DebugLn(['TCustomFormEditor.CreateComponent ',s]); - {$IFDEF DEBUG_ALLOW_DUMPBACKTRACE} DumpExceptionBackTrace; - {$ENDIF} MessageDlg('Error destroying component',s,mtError,[mbCancel],0); end; end; diff --git a/ide/exttooldialog.lfm b/ide/exttooldialog.lfm index 1f217b9157..e00acb1d4f 100644 --- a/ide/exttooldialog.lfm +++ b/ide/exttooldialog.lfm @@ -9,7 +9,7 @@ object ExternalToolDialog: TExternalToolDialog ClientHeight = 347 ClientWidth = 410 Position = poScreenCenter - LCLVersion = '0.9.27' + LCLVersion = '0.9.29' object ToolBar: TToolBar Left = 0 Height = 48 diff --git a/ide/exttooldialog.lrs b/ide/exttooldialog.lrs index 8f4aa15e7e..d201c36c92 100644 --- a/ide/exttooldialog.lrs +++ b/ide/exttooldialog.lrs @@ -5,7 +5,7 @@ LazarusResources.Add('TExternalToolDialog','FORMDATA',[ +#3'['#1#3'Top'#3#226#0#5'Width'#3#154#1#13'ActiveControl'#7#7'ListBox'#11'Bo' +'rderStyle'#7#13'bsSizeToolWin'#7'Caption'#6#18'ExternalToolDialog'#12'Clien' +'tHeight'#3'['#1#11'ClientWidth'#3#154#1#8'Position'#7#14'poScreenCenter'#10 - +'LCLVersion'#6#6'0.9.27'#0#8'TToolBar'#7'ToolBar'#4'Left'#2#0#6'Height'#2'0' + +'LCLVersion'#6#6'0.9.29'#0#8'TToolBar'#7'ToolBar'#4'Left'#2#0#6'Height'#2'0' +#3'Top'#2#0#5'Width'#3#154#1#8'AutoSize'#9#12'ButtonHeight'#2'.'#11'ButtonWi' +'dth'#2'/'#7'Caption'#6#7'ToolBar'#14'ParentShowHint'#8#12'ShowCaptions'#9#8 +'ShowHint'#9#8'TabOrder'#2#0#0#11'TToolButton'#14'MoveDownButton'#4'Left'#3 diff --git a/ide/exttooldialog.pas b/ide/exttooldialog.pas index 6b9cd03c14..e603f6383f 100644 --- a/ide/exttooldialog.pas +++ b/ide/exttooldialog.pas @@ -408,9 +408,7 @@ begin except on e: Exception do begin DebugLn('TExternalToolList.Run ',lisExtToolFailedToRunTool, ' ', E.Message); - {$IFDEF DEBUG_ALLOW_DUMPBACKTRACE} DumpExceptionBackTrace; - {$ENDIF} DebugLn(['TExternalToolList.Run AAA1']); Result:=MessageDlg(lisExtToolFailedToRunTool, Format(lisExtToolUnableToRunTheTool, ['"', Title, '"', #13, e.Message] diff --git a/ide/main.pp b/ide/main.pp index fb06fd48ca..0de099e048 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -4849,9 +4849,7 @@ begin PropPath:=''; if Writer.Driver is TLRSObjectWriter then PropPath:=TLRSObjectWriter(Writer.Driver).GetStackPath(AnUnitInfo.Component); - {$IFDEF DEBUG_ALLOW_DUMPBACKTRACE} DumpExceptionBackTrace; - {$ENDIF} ACaption:=lisStreamingError; AText:=Format(lisUnableToStreamT, [AnUnitInfo.ComponentName, AnUnitInfo.ComponentName]) + LineEnding @@ -4977,9 +4975,7 @@ begin on E: Exception do begin // added to get more feedback on issue 7009 Debugln('TMainIDE.SaveFileResources E3: ', E.Message); - {$IFDEF DEBUG_ALLOW_DUMPBACKTRACE} DumpExceptionBackTrace; - {$ENDIF} ACaption:=lisStreamingError; AText:=Format( lisUnableToTransformBinaryComponentStreamOfTIntoText, [ @@ -5756,9 +5752,7 @@ begin Result:=mrOk; except on E: Exception do begin - {$IFDEF DEBUG_ALLOW_DUMPBACKTRACE} DumpExceptionBackTrace; - {$ENDIF} ACaption:=lisFormatError; AText:=Format(lisUnableToConvertTextFormDataOfFileIntoBinaryStream, [#13, '"', LFMBuf.Filename, '"', #13, E.Message]); @@ -6138,9 +6132,7 @@ begin except on E: Exception do begin DebugLn(['TMainIDE.DoFixupComponentReferences GlobalFixupReferences ',E.Message]); - {$IFDEF DEBUG_ALLOW_DUMPBACKTRACE} DumpExceptionBackTrace; - {$ENDIF} end; end; diff --git a/lcl/forms.pp b/lcl/forms.pp index 0d6805f232..2cf6743bad 100644 --- a/lcl/forms.pp +++ b/lcl/forms.pp @@ -1578,27 +1578,22 @@ end; //------------------------------------------------------------------------------ procedure ExceptionOccurred(Sender: TObject; Addr:Pointer; FrameCount: Longint; Frames: PPointer); -{$ifdef DEBUG_ALLOW_DUMPBACKTRACE} var FrameNumber: integer; -{$endif} Begin DebugLn('[FORMS.PP] ExceptionOccurred '); if HaltingProgram or HandlingException then Halt; HandlingException:=true; - {$ifdef DEBUG_ALLOW_DUMPBACKTRACE} - if Sender<>nil then begin + if Sender<>nil then + begin DebugLn(' Sender=',Sender.ClassName); - if Sender is Exception then begin + if Sender is Exception then + begin DebugLn(' Exception=',Exception(Sender).Message); - DebugLn(' Stack trace:'); - DebugLn(BackTraceStrFunc(ExceptAddr)); - for FrameNumber := 0 to FrameCount-1 do - DebugLn(BackTraceStrFunc(Frames[FrameNumber])); + DumpExceptionBackTrace(); end; end else DebugLn(' Sender=nil'); - {$endif} if Application<>nil then Application.HandleException(Sender); HandlingException:=false; diff --git a/lcl/include/application.inc b/lcl/include/application.inc index 14ec5540fc..91ed0fc89d 100644 --- a/lcl/include/application.inc +++ b/lcl/include/application.inc @@ -1073,9 +1073,7 @@ begin DebugLn('TApplication.HandleException: ', 'there was another exception during showing the first exception'); HaltingProgram:=true; - {$ifdef DEBUG_ALLOW_DUMPBACKTRACE} DumpExceptionBackTrace; - {$endif} Halt; end; Include(FFlags,AppHandlingException); @@ -1085,7 +1083,6 @@ begin Skip := ExceptObject is EAbort; - {$ifdef DEBUG_ALLOW_DUMPBACKTRACE} if not (AppNoExceptionMessages in FFlags) then begin // before we do anything, write it down @@ -1102,7 +1099,6 @@ begin DumpExceptionBackTrace; end; end; - {$endif} // release capture and hide all forms with stay on top, so that // a message can be shown if GetCapture <> 0 then SendMessage(GetCapture, LM_CANCELMODE, 0, 0); diff --git a/lcl/lclproc.pas b/lcl/lclproc.pas index bf785ff6fa..175cc96431 100644 --- a/lcl/lclproc.pas +++ b/lcl/lclproc.pas @@ -183,9 +183,7 @@ function StrToDouble(const s: string): double; // debugging procedure RaiseGDBException(const Msg: string); -{$ifdef DEBUG_ALLOW_DUMPBACKTRACE} procedure DumpExceptionBackTrace; -{$endif} procedure DumpStack; function GetStackTrace(UseCache: boolean): string; procedure GetStackTracePointers(var AStack: TStackTracePointers); @@ -1506,8 +1504,12 @@ begin if (length(Msg) div (length(Msg) div 10000))=0 then ; end; -{$ifdef DEBUG_ALLOW_DUMPBACKTRACE} procedure DumpExceptionBackTrace; +// Remove ifdef when bug 14330 is fixed +{$ifdef WinCE} +begin +end; +{$else} var FrameCount: integer; Frames: PPointer; diff --git a/lcl/translations.pas b/lcl/translations.pas index e0cbe93054..d10d0cecba 100644 --- a/lcl/translations.pas +++ b/lcl/translations.pas @@ -404,13 +404,11 @@ begin {$endif ver2_0} Result:=true; except - {$ifdef DEBUG_ALLOW_DUMPBACKTRACE} on e: Exception do begin DebugLn('Exception while translating ', ResUnitName); DebugLn(e.Message); DumpExceptionBackTrace; end; - {$endif} end; end;