paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2026-01-06 07:22:34 +01:00
Code Issues Packages Projects Releases Wiki Activity

debugger: exception handling improvement

Browse Source 
- add debugger exception notification dialog instead of simple message dialog. This allows to continue execution just after reading about exception and to add this exception to the "skip" list.
 - implement "Notify on Lazarus exception" option
 - fix inability to remove an exception from the "skip" list

git-svn-id: trunk@18916 -
This commit is contained in:
paul 2009-03-08 12:03:34 +00:00
parent d9d35d2eaf
commit 95b6a7b814
11 changed files with 343 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitattributes vendored
View File

@ -1636,6 +1636,9 @@ debugger/debugutils.pp svneol=native#text/pascal
debugger/evaluatedlg.lfm svneol=native#text/plain
debugger/evaluatedlg.lrs svneol=native#text/pascal
debugger/evaluatedlg.pp svneol=native#text/pascal
debugger/exceptiondlg.lfm svneol=native#text/plain
debugger/exceptiondlg.lrs svneol=native#text/pascal
debugger/exceptiondlg.pas svneol=native#text/pascal
debugger/fpdebug/dbgclasses.pp svneol=native#text/pascal
debugger/fpdebug/dbgdisasx86.pp svneol=native#text/plain
debugger/fpdebug/dbgdwarf.pas svneol=native#text/pascal

39
debugger/debugger.pp
View File

@ -79,6 +79,12 @@ type
dsError
);
TDBGExceptionType = (
deInternal,
deExternal,
deRunError
);
{
Debugger states
--------------------------------------------------------------------------
@ -981,14 +987,18 @@ type
{ TBaseExceptions }
TBaseExceptions = class(TCollection)
private
FIgnoreAll: Boolean;
function Add(const AName: String): TBaseException;
function Find(const AName: String): TBaseException;
procedure SetIgnoreAll(const AValue: Boolean);
protected
procedure AssignTo(Dest: TPersistent); override;
procedure ClearExceptions; virtual;
public
constructor Create(const AItemClass: TBaseExceptionClass);
destructor Destroy; override;
procedure Reset; virtual;
property IgnoreAll: Boolean read FIgnoreAll write SetIgnoreAll;
end;
{ TDBGExceptions }
@ -1046,8 +1056,8 @@ type
TDBGOutputEvent = procedure(Sender: TObject; const AText: String) of object;
TDBGCurrentLineEvent = procedure(Sender: TObject;
const ALocation: TDBGLocationRec) of object;
TDBGExceptionEvent = procedure(Sender: TObject; const AExceptionClass: String;
const AExceptionText: String) of object;
TDBGExceptionEvent = procedure(Sender: TObject; const AExceptionType: TDBGExceptionType;
const AExceptionClass: String; const AExceptionText: String) of object;
TDebuggerProperties = class(TPersistent)
private
@ -1099,7 +1109,7 @@ type
function CreateExceptions: TDBGExceptions; virtual;
procedure DoCurrent(const ALocation: TDBGLocationRec);
procedure DoDbgOutput(const AText: String);
procedure DoException(const AExceptionClass: String; const AExceptionText: String);
procedure DoException(const AExceptionType: TDBGExceptionType; const AExceptionClass: String; const AExceptionText: String);
procedure DoOutput(const AText: String);
procedure DoBreakpointHit(const ABreakPoint: TBaseBreakPoint; var ACanContinue: Boolean);
procedure DoState(const OldState: TDBGState); virtual;
@ -1444,11 +1454,11 @@ begin
if Assigned(FOnDbgOutput) then FOnDbgOutput(Self, AText);
end;
procedure TDebugger.DoException(const AExceptionClass: String;
procedure TDebugger.DoException(const AExceptionType: TDBGExceptionType; const AExceptionClass: String;
const AExceptionText: String);
begin
if Assigned(FOnException) then
FOnException(Self, AExceptionClass, AExceptionText);
FOnException(Self, AExceptionType, AExceptionClass, AExceptionText);
end;
procedure TDebugger.DoOutput(const AText: String);
@ -3914,6 +3924,7 @@ end;
constructor TBaseExceptions.Create(const AItemClass: TBaseExceptionClass);
begin
inherited Create(AItemClass);
FIgnoreAll := False;
end;
destructor TBaseExceptions.Destroy;
@ -3948,6 +3959,22 @@ begin
TBaseException(GetItem(Count-1)).Free;
end;
procedure TBaseExceptions.SetIgnoreAll(const AValue: Boolean);
begin
if FIgnoreAll = AValue then exit;
FIgnoreAll := AValue;
Changed;
end;
procedure TBaseExceptions.AssignTo(Dest: TPersistent);
begin
if Dest is TBaseExceptions
then begin
TBaseExceptions(Dest).IgnoreAll := IgnoreAll;
end
else inherited AssignTo(Dest);
end;
{ =========================================================================== }
{ TDBGExceptions }
{ =========================================================================== }
@ -4006,6 +4033,7 @@ var
begin
Clear;
NewCount := AXMLConfig.GetValue(APath + 'Count', 0);
FIgnoreAll := AXMLConfig.GetValue(APath + 'IgnoreAll', False);
for i := 0 to NewCount-1 do
begin
IDEException := TIDEException(inherited Add(''));
@ -4023,6 +4051,7 @@ var
begin
Cnt := Count;
AXMLConfig.SetDeleteValue(APath + 'Count', Cnt, 0);
AXMLConfig.SetDeleteValue(APath + 'IgnoreAll', IgnoreAll, False);
for i := 0 to Cnt - 1 do
begin
IDEException := Items[i];

79
debugger/exceptiondlg.lfm Normal file
View File

@ -0,0 +1,79 @@
object ExceptionDialog: TExceptionDialog
Left = 479
Height = 113
Top = 376
Width = 612
AutoSize = True
BorderIcons = [biSystemMenu]
BorderStyle = bsDialog
Caption = 'ExceptionDialog'
ClientHeight = 113
ClientWidth = 612
Position = poScreenCenter
LCLVersion = '0.9.27'
object lblMessage: TLabel
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner
Left = 6
Height = 70
Top = 6
Width = 600
BorderSpacing.Around = 6
Caption = 'lblMessage'
Constraints.MinHeight = 70
Constraints.MinWidth = 600
ParentColor = False
WordWrap = True
end
object btnContinue: TBitBtn
AnchorSideTop.Control = lblMessage
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 531
Height = 25
Top = 82
Width = 75
Anchors = [akTop, akRight]
BorderSpacing.Around = 6
Cancel = True
Caption = 'btnContinue'
Constraints.MinHeight = 25
Constraints.MinWidth = 75
ModalResult = 2
TabOrder = 1
end
object btnBreak: TBitBtn
AnchorSideTop.Control = lblMessage
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = btnContinue
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 450
Height = 25
Top = 82
Width = 75
Anchors = [akTop, akRight]
BorderSpacing.Around = 6
Caption = 'btnBreak'
Constraints.MinHeight = 25
Constraints.MinWidth = 75
Default = True
ModalResult = 1
TabOrder = 0
end
object cbIgnoreExceptionType: TCheckBox
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = btnBreak
AnchorSideTop.Side = asrCenter
Left = 6
Height = 17
Top = 86
Width = 131
BorderSpacing.Around = 6
Caption = 'cbIgnoreExceptionType'
TabOrder = 2
end
end

30
debugger/exceptiondlg.lrs Normal file
View File

@ -0,0 +1,30 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TExceptionDialog','FORMDATA',[
'TPF0'#16'TExceptionDialog'#15'ExceptionDialog'#4'Left'#3#223#1#6'Height'#2'q'
+#3'Top'#3'x'#1#5'Width'#3'd'#2#8'AutoSize'#9#11'BorderIcons'#11#12'biSystemM'
+'enu'#0#11'BorderStyle'#7#8'bsDialog'#7'Caption'#6#15'ExceptionDialog'#12'Cl'
+'ientHeight'#2'q'#11'ClientWidth'#3'd'#2#8'Position'#7#14'poScreenCenter'#10
+'LCLVersion'#6#6'0.9.27'#0#6'TLabel'#10'lblMessage'#22'AnchorSideLeft.Contro'
+'l'#7#5'Owner'#21'AnchorSideTop.Control'#7#5'Owner'#4'Left'#2#6#6'Height'#2
+'F'#3'Top'#2#6#5'Width'#3'X'#2#20'BorderSpacing.Around'#2#6#7'Caption'#6#10
+'lblMessage'#21'Constraints.MinHeight'#2'F'#20'Constraints.MinWidth'#3'X'#2
+#11'ParentColor'#8#8'WordWrap'#9#0#0#7'TBitBtn'#11'btnContinue'#21'AnchorSid'
+'eTop.Control'#7#10'lblMessage'#18'AnchorSideTop.Side'#7#9'asrBottom'#23'Anc'
+'horSideRight.Control'#7#5'Owner'#20'AnchorSideRight.Side'#7#9'asrBottom'#24
+'AnchorSideBottom.Control'#7#5'Owner'#21'AnchorSideBottom.Side'#7#9'asrBotto'
+'m'#4'Left'#3#19#2#6'Height'#2#25#3'Top'#2'R'#5'Width'#2'K'#7'Anchors'#11#5
+'akTop'#7'akRight'#0#20'BorderSpacing.Around'#2#6#6'Cancel'#9#7'Caption'#6#11
+'btnContinue'#21'Constraints.MinHeight'#2#25#20'Constraints.MinWidth'#2'K'#11
+'ModalResult'#2#2#8'TabOrder'#2#1#0#0#7'TBitBtn'#8'btnBreak'#21'AnchorSideTo'
+'p.Control'#7#10'lblMessage'#18'AnchorSideTop.Side'#7#9'asrBottom'#23'Anchor'
+'SideRight.Control'#7#11'btnContinue'#24'AnchorSideBottom.Control'#7#5'Owner'
+#21'AnchorSideBottom.Side'#7#9'asrBottom'#4'Left'#3#194#1#6'Height'#2#25#3'T'
+'op'#2'R'#5'Width'#2'K'#7'Anchors'#11#5'akTop'#7'akRight'#0#20'BorderSpacing'
+'.Around'#2#6#7'Caption'#6#8'btnBreak'#21'Constraints.MinHeight'#2#25#20'Con'
+'straints.MinWidth'#2'K'#7'Default'#9#11'ModalResult'#2#1#8'TabOrder'#2#0#0#0
+#9'TCheckBox'#21'cbIgnoreExceptionType'#22'AnchorSideLeft.Control'#7#5'Owner'
+#21'AnchorSideTop.Control'#7#8'btnBreak'#18'AnchorSideTop.Side'#7#9'asrCente'
+'r'#4'Left'#2#6#6'Height'#2#17#3'Top'#2'V'#5'Width'#3#131#0#20'BorderSpacing'
+'.Around'#2#6#7'Caption'#6#21'cbIgnoreExceptionType'#8'TabOrder'#2#2#0#0#0
]);

91
debugger/exceptiondlg.pas Normal file
View File

@ -0,0 +1,91 @@
{ ----------------------------------------------
exceptiondlg.pas - Exception Dialog
----------------------------------------------
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
}
unit ExceptionDlg;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
ButtonPanel, StdCtrls, Buttons, LazarusIDEStrConsts;
type
{ TExceptionDialog }
TExceptionDialog = class(TForm)
btnBreak: TBitBtn;
btnContinue: TBitBtn;
cbIgnoreExceptionType: TCheckBox;
lblMessage: TLabel;
private
{ private declarations }
public
constructor Create(AOwner: TComponent); override;
function Execute(AMessage: String; out IgnoreException: Boolean): TModalResult;
end;
function ExecuteExceptionDialog(AMessage: String; out IgnoreException: Boolean): TModalResult;
implementation
function ExecuteExceptionDialog(AMessage: String; out IgnoreException: Boolean): TModalResult;
var
ADialog: TExceptionDialog;
begin
ADialog := TExceptionDialog.Create(Application);
try
Result := ADialog.Execute(AMessage, IgnoreException);
finally
ADialog.Free;
end;
end;
{ TExceptionDialog }
constructor TExceptionDialog.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Caption := lisExceptionDialog;
btnBreak.Caption := lisBtnBreak;
btnContinue.Caption := lisBtnContinue;
cbIgnoreExceptionType.Caption := lisIgnoreExceptionType;
btnBreak.LoadGlyphFromLazarusResource('menu_pause');
btnContinue.LoadGlyphFromLazarusResource('menu_run');
end;
function TExceptionDialog.Execute(AMessage: String; out IgnoreException: Boolean): TModalResult;
begin
lblMessage.Caption := AMessage;
Result := ShowModal;
IgnoreException := cbIgnoreExceptionType.Checked;
end;
initialization
{$I exceptiondlg.lrs}
end.

43
debugger/frames/debugger_language_exceptions_options.lfm
View File

@ -1,34 +1,27 @@
object DebuggerLanguageExceptionsOptions: TDebuggerLanguageExceptionsOptions
Left = 0
inherited DebuggerLanguageExceptionsOptions: TDebuggerLanguageExceptionsOptions
Height = 421
Top = 0
Width = 448
HelpContext = 0
ClientHeight = 421
ClientWidth = 448
Ctl3D = False
TabOrder = 0
Visible = False
DesignLeft = 342
DesignTop = 203
object bgIgnoreExceptions: TGroupBox
DesignLeft = 132
DesignTop = 174
object bgIgnoreExceptions: TGroupBox[0]
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = chkBreakOnException
AnchorSideBottom.Control = chkNotifyOnException
Left = 0
Height = 396
Height = 398
Top = 0
Width = 448
HelpContext = 0
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Bottom = 6
Caption = 'Ignore these exceptions'
ClientHeight = 378
ClientHeight = 380
ClientWidth = 444
Ctl3D = False
ParentCtl3D = False
TabOrder = 0
object clbExceptions: TCheckListBox
AnchorSideLeft.Control = bgIgnoreExceptions
@ -37,15 +30,14 @@ object DebuggerLanguageExceptionsOptions: TDebuggerLanguageExceptionsOptions
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = cmdExceptionAdd
Left = 6
Height = 337
Height = 339
Top = 6
Width = 432
HelpContext = 0
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Around = 6
ItemHeight = 0
OnClick = clbExceptionsClick
TabOrder = 0
TopIndex = 0
end
object cmdExceptionAdd: TBitBtn
AnchorSideRight.Control = cmdExceptionRemove
@ -53,9 +45,8 @@ object DebuggerLanguageExceptionsOptions: TDebuggerLanguageExceptionsOptions
AnchorSideBottom.Side = asrBottom
Left = 282
Height = 23
Top = 349
Top = 351
Width = 75
HelpContext = 0
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Around = 6
@ -72,9 +63,8 @@ object DebuggerLanguageExceptionsOptions: TDebuggerLanguageExceptionsOptions
AnchorSideBottom.Side = asrBottom
Left = 363
Height = 23
Top = 349
Top = 351
Width = 75
HelpContext = 0
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Around = 6
@ -86,19 +76,16 @@ object DebuggerLanguageExceptionsOptions: TDebuggerLanguageExceptionsOptions
TabOrder = 2
end
end
object chkBreakOnException: TCheckBox
object chkNotifyOnException: TCheckBox[1]
AnchorSideLeft.Control = Owner
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 0
Height = 19
Top = 402
Width = 163
HelpContext = 0
AllowGrayed = True
Height = 17
Top = 404
Width = 156
Anchors = [akLeft, akBottom]
Caption = 'Break on Lazarus Exceptions'
TabOrder = 1
UseOnChange = False
end
end

72
debugger/frames/debugger_language_exceptions_options.lrs
View File

@ -1,38 +1,38 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TDebuggerLanguageExceptionsOptions','FORMDATA',[
'TPF0"TDebuggerLanguageExceptionsOptions!DebuggerLanguageExceptionsOptions'#4
+'Left'#2#0#6'Height'#3#165#1#3'Top'#2#0#5'Width'#3#192#1#11'HelpContext'#2#0
+#12'ClientHeight'#3#165#1#11'ClientWidth'#3#192#1#5'Ctl3D'#8#8'TabOrder'#2#0
+#7'Visible'#8#10'DesignLeft'#3'V'#1#9'DesignTop'#3#203#0#0#9'TGroupBox'#18'b'
+'gIgnoreExceptions'#22'AnchorSideLeft.Control'#7#5'Owner'#21'AnchorSideTop.C'
+'ontrol'#7#5'Owner'#23'AnchorSideRight.Control'#7#5'Owner'#20'AnchorSideRigh'
+'t.Side'#7#9'asrBottom'#24'AnchorSideBottom.Control'#7#19'chkBreakOnExceptio'
+'n'#4'Left'#2#0#6'Height'#3#140#1#3'Top'#2#0#5'Width'#3#192#1#11'HelpContext'
+#2#0#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#20'BorderSpac'
+'ing.Bottom'#2#6#7'Caption'#6#23'Ignore these exceptions'#12'ClientHeight'#3
+'z'#1#11'ClientWidth'#3#188#1#5'Ctl3D'#8#11'ParentCtl3D'#8#8'TabOrder'#2#0#0
+#13'TCheckListBox'#13'clbExceptions'#22'AnchorSideLeft.Control'#7#18'bgIgnor'
+'eExceptions'#21'AnchorSideTop.Control'#7#18'bgIgnoreExceptions'#23'AnchorSi'
+'deRight.Control'#7#18'bgIgnoreExceptions'#20'AnchorSideRight.Side'#7#9'asrB'
+'ottom'#24'AnchorSideBottom.Control'#7#15'cmdExceptionAdd'#4'Left'#2#6#6'Hei'
+'ght'#3'Q'#1#3'Top'#2#6#5'Width'#3#176#1#11'HelpContext'#2#0#7'Anchors'#11#5
+'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#20'BorderSpacing.Around'#2#6#10'I'
+'temHeight'#2#0#8'TabOrder'#2#0#8'TopIndex'#2#0#0#0#7'TBitBtn'#15'cmdExcepti'
+'onAdd'#23'AnchorSideRight.Control'#7#18'cmdExceptionRemove'#24'AnchorSideBo'
+'ttom.Control'#7#18'bgIgnoreExceptions'#21'AnchorSideBottom.Side'#7#9'asrBot'
+'tom'#4'Left'#3#26#1#6'Height'#2#23#3'Top'#3']'#1#5'Width'#2'K'#11'HelpConte'
+'xt'#2#0#7'Anchors'#11#7'akRight'#8'akBottom'#0#8'AutoSize'#9#20'BorderSpaci'
+'ng.Around'#2#6#7'Caption'#6#3'Add'#20'Constraints.MinWidth'#2'K'#9'NumGlyph'
+'s'#2#0#7'OnClick'#7#20'cmdExceptionAddClick'#8'TabOrder'#2#1#0#0#7'TBitBtn'
+#18'cmdExceptionRemove'#23'AnchorSideRight.Control'#7#18'bgIgnoreExceptions'
+#20'AnchorSideRight.Side'#7#9'asrBottom'#24'AnchorSideBottom.Control'#7#18'b'
+'gIgnoreExceptions'#21'AnchorSideBottom.Side'#7#9'asrBottom'#4'Left'#3'k'#1#6
+'Height'#2#23#3'Top'#3']'#1#5'Width'#2'K'#11'HelpContext'#2#0#7'Anchors'#11#7
+'akRight'#8'akBottom'#0#8'AutoSize'#9#20'BorderSpacing.Around'#2#6#7'Caption'
+#6#6'Remove'#20'Constraints.MinWidth'#2'K'#7'Enabled'#8#9'NumGlyphs'#2#0#7'O'
+'nClick'#7#23'cmdExceptionRemoveClick'#8'TabOrder'#2#2#0#0#0#9'TCheckBox'#19
+'chkBreakOnException'#22'AnchorSideLeft.Control'#7#5'Owner'#24'AnchorSideBot'
+'tom.Control'#7#5'Owner'#21'AnchorSideBottom.Side'#7#9'asrBottom'#4'Left'#2#0
+#6'Height'#2#19#3'Top'#3#146#1#5'Width'#3#163#0#11'HelpContext'#2#0#11'Allow'
+'Grayed'#9#7'Anchors'#11#6'akLeft'#8'akBottom'#0#7'Caption'#6#27'Break on La'
+'zarus Exceptions'#8'TabOrder'#2#1#11'UseOnChange'#8#0#0#0
'TPF0'#241'"TDebuggerLanguageExceptionsOptions!DebuggerLanguageExceptionsOpti'
+'ons'#6'Height'#3#165#1#5'Width'#3#192#1#12'ClientHeight'#3#165#1#11'ClientW'
+'idth'#3#192#1#8'TabOrder'#2#0#7'Visible'#8#10'DesignLeft'#3#132#0#9'DesignT'
+'op'#3#174#0#0#242#2#0#9'TGroupBox'#18'bgIgnoreExceptions'#22'AnchorSideLeft'
+'.Control'#7#5'Owner'#21'AnchorSideTop.Control'#7#5'Owner'#23'AnchorSideRigh'
+'t.Control'#7#5'Owner'#20'AnchorSideRight.Side'#7#9'asrBottom'#24'AnchorSide'
+'Bottom.Control'#7#20'chkNotifyOnException'#4'Left'#2#0#6'Height'#3#142#1#3
+'Top'#2#0#5'Width'#3#192#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akB'
+'ottom'#0#20'BorderSpacing.Bottom'#2#6#7'Caption'#6#23'Ignore these exceptio'
+'ns'#12'ClientHeight'#3'|'#1#11'ClientWidth'#3#188#1#8'TabOrder'#2#0#0#13'TC'
+'heckListBox'#13'clbExceptions'#22'AnchorSideLeft.Control'#7#18'bgIgnoreExce'
+'ptions'#21'AnchorSideTop.Control'#7#18'bgIgnoreExceptions'#23'AnchorSideRig'
+'ht.Control'#7#18'bgIgnoreExceptions'#20'AnchorSideRight.Side'#7#9'asrBottom'
+#24'AnchorSideBottom.Control'#7#15'cmdExceptionAdd'#4'Left'#2#6#6'Height'#3
+'S'#1#3'Top'#2#6#5'Width'#3#176#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'
+#8'akBottom'#0#20'BorderSpacing.Around'#2#6#10'ItemHeight'#2#0#7'OnClick'#7
+#18'clbExceptionsClick'#8'TabOrder'#2#0#0#0#7'TBitBtn'#15'cmdExceptionAdd'#23
+'AnchorSideRight.Control'#7#18'cmdExceptionRemove'#24'AnchorSideBottom.Contr'
+'ol'#7#18'bgIgnoreExceptions'#21'AnchorSideBottom.Side'#7#9'asrBottom'#4'Lef'
+'t'#3#26#1#6'Height'#2#23#3'Top'#3'_'#1#5'Width'#2'K'#7'Anchors'#11#7'akRigh'
+'t'#8'akBottom'#0#8'AutoSize'#9#20'BorderSpacing.Around'#2#6#7'Caption'#6#3
+'Add'#20'Constraints.MinWidth'#2'K'#9'NumGlyphs'#2#0#7'OnClick'#7#20'cmdExce'
+'ptionAddClick'#8'TabOrder'#2#1#0#0#7'TBitBtn'#18'cmdExceptionRemove'#23'Anc'
+'horSideRight.Control'#7#18'bgIgnoreExceptions'#20'AnchorSideRight.Side'#7#9
+'asrBottom'#24'AnchorSideBottom.Control'#7#18'bgIgnoreExceptions'#21'AnchorS'
+'ideBottom.Side'#7#9'asrBottom'#4'Left'#3'k'#1#6'Height'#2#23#3'Top'#3'_'#1#5
+'Width'#2'K'#7'Anchors'#11#7'akRight'#8'akBottom'#0#8'AutoSize'#9#20'BorderS'
+'pacing.Around'#2#6#7'Caption'#6#6'Remove'#20'Constraints.MinWidth'#2'K'#7'E'
+'nabled'#8#9'NumGlyphs'#2#0#7'OnClick'#7#23'cmdExceptionRemoveClick'#8'TabOr'
+'der'#2#2#0#0#0#242#2#1#9'TCheckBox'#20'chkNotifyOnException'#22'AnchorSideL'
+'eft.Control'#7#5'Owner'#24'AnchorSideBottom.Control'#7#5'Owner'#21'AnchorSi'
+'deBottom.Side'#7#9'asrBottom'#4'Left'#2#0#6'Height'#2#17#3'Top'#3#148#1#5'W'
+'idth'#3#156#0#7'Anchors'#11#6'akLeft'#8'akBottom'#0#7'Caption'#6#27'Break o'
+'n Lazarus Exceptions'#8'TabOrder'#2#1#0#0#0
]);

12
debugger/frames/debugger_language_exceptions_options.pas
View File

@ -35,10 +35,11 @@ type
TDebuggerLanguageExceptionsOptions = class(TAbstractIDEOptionsEditor)
bgIgnoreExceptions: TGroupBox;
chkBreakOnException: TCheckBox;
chkNotifyOnException: TCheckBox;
clbExceptions: TCheckListBox;
cmdExceptionAdd: TBitBtn;
cmdExceptionRemove: TBitBtn;
procedure clbExceptionsClick(Sender: TObject);
procedure cmdExceptionAddClick(Sender: TObject);
procedure cmdExceptionRemoveClick(Sender: TObject);
private
@ -84,6 +85,11 @@ begin
end;
end;
procedure TDebuggerLanguageExceptionsOptions.clbExceptionsClick(Sender: TObject);
begin
cmdExceptionRemove.Enabled := clbExceptions.ItemIndex <> -1;
end;
procedure TDebuggerLanguageExceptionsOptions.cmdExceptionRemoveClick(
Sender: TObject);
var
@ -140,7 +146,7 @@ begin
cmdExceptionAdd.Caption := lisCodeTemplAdd;
cmdExceptionRemove.LoadGlyphFromLazarusResource('laz_delete');
cmdExceptionAdd.LoadGlyphFromLazarusResource('laz_add');
chkBreakOnException.Caption := lisDebugOptionsFrmBreakOnLazarusExceptions;
chkNotifyOnException.Caption := lisDebugOptionsFrmNotifyOnLazarusExceptions;
end;
procedure TDebuggerLanguageExceptionsOptions.ReadSettings(
@ -148,6 +154,7 @@ procedure TDebuggerLanguageExceptionsOptions.ReadSettings(
var
n: integer;
begin
chkNotifyOnException.Checked := not DebugBoss.Exceptions.IgnoreAll;
for n := 0 to DebugBoss.Exceptions.Count - 1 do
AddExceptionLine(DebugBoss.Exceptions[n], '');
end;
@ -179,6 +186,7 @@ begin
end;
end;
end;
DebugBoss.Exceptions.IgnoreAll := not chkNotifyOnException.Checked;
end;
class function TDebuggerLanguageExceptionsOptions.SupportedOptionsClass: TAbstractIDEOptionsClass;

12
debugger/gdbmidebugger.pp
View File

@ -2285,7 +2285,7 @@ function TGDBMIDebugger.ProcessStopped(const AParams: String; const AIgnoreSigIn
end
else ExceptionMessage := '### Not supported on GDB < 5.3 ###';
DoException(AInfo.Name, ExceptionMessage);
DoException(deInternal, AInfo.Name, ExceptionMessage);
DoCurrent(GetLocation);
end;
@ -2298,7 +2298,7 @@ function TGDBMIDebugger.ProcessStopped(const AParams: String; const AIgnoreSigIn
else ErrorNo := Integer(GetData('$fp+%d', [FTargetPtrSize * 2]));
ErrorNo := ErrorNo and $FFFF;
DoException(Format('RunError(%d)', [ErrorNo]), '');
DoException(deRunError, Format('RunError(%d)', [ErrorNo]), '');
DoCurrent(GetLocation);
end;
@ -2311,7 +2311,7 @@ function TGDBMIDebugger.ProcessStopped(const AParams: String; const AIgnoreSigIn
else ErrorNo := Integer(GetData('$fp+%d', [FTargetPtrSize * 2]));
ErrorNo := ErrorNo and $FFFF;
DoException(Format('RunError(%d)', [ErrorNo]), '');
DoException(deRunError, Format('RunError(%d)', [ErrorNo]), '');
ProcessFrame(GetFrame(1));
end;
@ -2333,7 +2333,7 @@ function TGDBMIDebugger.ProcessStopped(const AParams: String; const AIgnoreSigIn
then SetState(dsPause);
if not SigInt
then DoException('External: ' + S, '');
then DoException(deExternal, 'External: ' + S, '');
if not AIgnoreSigIntState
or not SigInt
@ -2370,7 +2370,7 @@ begin
if Reason = 'exited-signalled'
then begin
SetState(dsStop);
DoException('External: ' + List.Values['signal-name'], '');
DoException(deExternal, 'External: ' + List.Values['signal-name'], '');
// ProcessFrame(List.Values['frame']);
Exit;
end;
@ -2410,7 +2410,7 @@ begin
ExceptionInfo := GetExceptionInfo;
// check if we should ignore this exception
if Exceptions.Find(ExceptionInfo.Name) <> nil
if Exceptions.IgnoreAll or (Exceptions.Find(ExceptionInfo.Name) <> nil)
then ExecuteCommand('-exec-continue', [])
else begin
SetState(dsPause);

47
ide/debugmanager.pas
View File

@ -53,7 +53,7 @@ uses
MainBar, MainIntf, MainBase, BaseBuildManager,
SourceMarks,
DebuggerDlg, Watchesdlg, BreakPointsdlg, BreakPropertyDlg, LocalsDlg, WatchPropertyDlg,
CallStackDlg, EvaluateDlg, RegistersDlg, AssemblerDlg, DebugOutputForm,
CallStackDlg, EvaluateDlg, RegistersDlg, AssemblerDlg, DebugOutputForm, ExceptionDlg,
GDBMIDebugger, SSHGDBMIDebugger, ProcessDebugger,
BaseDebugManager;
@ -86,7 +86,7 @@ type
procedure DebuggerChangeState(ADebugger: TDebugger; OldState: TDBGState);
procedure DebuggerCurrentLine(Sender: TObject; const ALocation: TDBGLocationRec);
procedure DebuggerOutput(Sender: TObject; const AText: String);
procedure DebuggerException(Sender: TObject; const AExceptionClass, AExceptionText: String);
procedure DebuggerException(Sender: TObject; const AExceptionType: TDBGExceptionType; const AExceptionClass, AExceptionText: String);
// Dialog events
procedure DebugDialogDestroy(Sender: TObject);
@ -364,6 +364,7 @@ type
procedure AddDefault;
public
constructor Create(const AManager: TDebugManager);
procedure AddIfNeeded(AName: string);
procedure Reset; override;
property Master: TDBGExceptions read FMaster write SetMaster;
end;
@ -754,23 +755,23 @@ begin
if Item.Enabled and (FMaster.Find(Item.Name) = nil)
then FMaster.Add(Item.Name);
end;
FMaster.IgnoreAll := IgnoreAll;
end;
end;
procedure TManagedExceptions.AddDefault;
procedure AddIfNeeded(AName: string);
begin
if Find(AName) = nil then
Add(AName);
end;
begin
AddIfNeeded('EAbort');
AddIfNeeded('ECodetoolError');
AddIfNeeded('EFOpenError');
end;
procedure TManagedExceptions.AddIfNeeded(AName: string);
begin
if Find(AName) = nil then
Add(AName);
end;
{ TManagedSignal }
procedure TManagedSignal.AssignTo (Dest: TPersistent );
@ -1244,18 +1245,27 @@ end;
// Debugger events
//-----------------------------------------------------------------------------
procedure TDebugManager.DebuggerException(Sender: TObject; const AExceptionClass, AExceptionText: String);
procedure TDebugManager.DebuggerException(Sender: TObject; const AExceptionType: TDBGExceptionType; const AExceptionClass, AExceptionText: String);
function GetTitle: String;
begin
Result := Project1.Title;
if Result = '' then
Result := ExtractFileName(FDebugger.FileName);
end;
var
ExceptMsg: string;
msg: String;
Ignore: Boolean;
Res: TModalResult;
begin
if Destroying then exit;
if AExceptionText = ''
then
msg := Format('Project %s raised exception class ''%s''.',
[Project1.Title, AExceptionClass])
[GetTitle, AExceptionClass])
else begin
ExceptMsg := AExceptionText;
// if AExceptionText is not a valid UTF8 string,
@ -1263,10 +1273,19 @@ begin
if FindInvalidUTF8Character(pchar(ExceptMsg),length(ExceptMsg), False) > 0 then
ExceptMsg := AnsiToUtf8(ExceptMsg);
msg := Format('Project %s raised exception class ''%s'' with message:%s%s',
[Project1.Title, AExceptionClass, #13, ExceptMsg]);
[GetTitle, AExceptionClass, #13, ExceptMsg]);
end;
MessageDlg('Error', msg, mtError,[mbOk],0);
if AExceptionType <> deInternal then
MessageDlg('Error', msg, mtError,[mbOk],0)
else
begin
Res := ExecuteExceptionDialog(msg, Ignore);
if Ignore then
TManagedExceptions(Exceptions).AddIfNeeded(AExceptionClass);
if Res = mrCancel then
FDebugger.Run;
end;
end;
procedure TDebugManager.DebuggerOutput(Sender: TObject; const AText: String);

7
ide/lazarusidestrconsts.pas
View File

@ -3742,7 +3742,7 @@ resourcestring
lisDebugOptionsFrmInterface = 'Interface';
lisDebugOptionsFrmLanguageExceptions = 'Language Exceptions';
lisDebugOptionsFrmIgnoreTheseExceptions = 'Ignore these exceptions';
lisDebugOptionsFrmBreakOnLazarusExceptions = 'Break on Lazarus Exceptions';
lisDebugOptionsFrmNotifyOnLazarusExceptions = 'Notify on Lazarus Exceptions';
lisDebugOptionsFrmOSExceptions = 'OS Exceptions';
lisDebugOptionsFrmSignals = 'Signals';
lisDebugOptionsFrmName = 'Name';
@ -3914,6 +3914,11 @@ resourcestring
lisRegistersDlgName = 'Name';
lisRegistersDlgValue = 'Value';
// Exception Dialog
lisExceptionDialog = 'Debugger Exception Notification';
lisBtnBreak = 'Break';
lisBtnContinue = 'Continue';
lisIgnoreExceptionType = 'Ignore this exception type';
lisetEditCustomScanners = 'Edit custom scanners (%s)';