New fix for bug #15075

git-svn-id: trunk@22775 -

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

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;

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

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

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]

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;
 

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;

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

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;

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;