paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-06 23:20:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

debugger: fix some problems after pressing "Continue" button in the debugger notification dialog

Browse Source 
git-svn-id: trunk@18921 -
This commit is contained in:
paul 2009-03-08 17:28:33 +00:00
parent 0cfb17b294
commit 4261d1dfdf
3 changed files with 43 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
debugger/debugger.pp
View File

@ -1057,7 +1057,9 @@ type
TDBGCurrentLineEvent = procedure(Sender: TObject;
const ALocation: TDBGLocationRec) of object;
TDBGExceptionEvent = procedure(Sender: TObject; const AExceptionType: TDBGExceptionType;
const AExceptionClass: String; const AExceptionText: String) of object;
const AExceptionClass: String;
const AExceptionText: String;
out AContinue: Boolean) of object;
TDebuggerProperties = class(TPersistent)
private
@ -1109,7 +1111,7 @@ type
function CreateExceptions: TDBGExceptions; virtual;
procedure DoCurrent(const ALocation: TDBGLocationRec);
procedure DoDbgOutput(const AText: String);
procedure DoException(const AExceptionType: TDBGExceptionType; const AExceptionClass: String; const AExceptionText: String);
procedure DoException(const AExceptionType: TDBGExceptionType; const AExceptionClass: String; const AExceptionText: String; out AContinue: Boolean);
procedure DoOutput(const AText: String);
procedure DoBreakpointHit(const ABreakPoint: TBaseBreakPoint; var ACanContinue: Boolean);
procedure DoState(const OldState: TDBGState); virtual;
@ -1455,10 +1457,12 @@ begin
end;
procedure TDebugger.DoException(const AExceptionType: TDBGExceptionType; const AExceptionClass: String;
const AExceptionText: String);
const AExceptionText: String; out AContinue: Boolean);
begin
if Assigned(FOnException) then
FOnException(Self, AExceptionType, AExceptionClass, AExceptionText);
FOnException(Self, AExceptionType, AExceptionClass, AExceptionText, AContinue)
else
AContinue := True;
end;
procedure TDebugger.DoOutput(const AText: String);

27
debugger/gdbmidebugger.pp
View File

@ -2276,6 +2276,7 @@ function TGDBMIDebugger.ProcessStopped(const AParams: String; const AIgnoreSigIn
procedure ProcessException(AInfo: TGDBMIExceptionInfo);
var
ExceptionMessage: String;
CanContinue: Boolean;
begin
if dfImplicidTypes in FDebuggerFlags
then begin
@ -2285,39 +2286,47 @@ function TGDBMIDebugger.ProcessStopped(const AParams: String; const AIgnoreSigIn
end
else ExceptionMessage := '### Not supported on GDB < 5.3 ###';
DoException(deInternal, AInfo.Name, ExceptionMessage);
DoCurrent(GetLocation);
DoException(deInternal, AInfo.Name, ExceptionMessage, CanContinue);
if CanContinue
then ExecuteCommand('-exec-continue', [])
else DoCurrent(GetLocation);
end;
procedure ProcessBreak;
var
ErrorNo: Integer;
CanContinue: Boolean;
begin
if tfRTLUsesRegCall in FTargetFlags
then ErrorNo := GetIntValue(FTargetRegisters[0], [])
else ErrorNo := Integer(GetData('$fp+%d', [FTargetPtrSize * 2]));
ErrorNo := ErrorNo and $FFFF;
DoException(deRunError, Format('RunError(%d)', [ErrorNo]), '');
DoCurrent(GetLocation);
DoException(deRunError, Format('RunError(%d)', [ErrorNo]), '', CanContinue);
if CanContinue
then ExecuteCommand('-exec-continue', [])
else DoCurrent(GetLocation);
end;
procedure ProcessRunError;
var
ErrorNo: Integer;
CanContinue: Boolean;
begin
if tfRTLUsesRegCall in FTargetFlags
then ErrorNo := GetIntValue(FTargetRegisters[0], [])
else ErrorNo := Integer(GetData('$fp+%d', [FTargetPtrSize * 2]));
ErrorNo := ErrorNo and $FFFF;
DoException(deRunError, Format('RunError(%d)', [ErrorNo]), '');
ProcessFrame(GetFrame(1));
DoException(deRunError, Format('RunError(%d)', [ErrorNo]), '', CanContinue);
if CanContinue
then ExecuteCommand('-exec-continue', [])
else ProcessFrame(GetFrame(1));
end;
procedure ProcessSignalReceived(const AList: TGDBMINameValueList);
var
SigInt: Boolean;
SigInt, CanContinue: Boolean;
S: String;
begin
// TODO: check to run (un)handled
@ -2333,7 +2342,7 @@ function TGDBMIDebugger.ProcessStopped(const AParams: String; const AIgnoreSigIn
then SetState(dsPause);
if not SigInt
then DoException(deExternal, 'External: ' + S, '');
then DoException(deExternal, 'External: ' + S, '', CanContinue);
if not AIgnoreSigIntState
or not SigInt
@ -2370,7 +2379,7 @@ begin
if Reason = 'exited-signalled'
then begin
SetState(dsStop);
DoException(deExternal, 'External: ' + List.Values['signal-name'], '');
DoException(deExternal, 'External: ' + List.Values['signal-name'], '', CanContinue);
// ProcessFrame(List.Values['frame']);
Exit;
end;

25
ide/debugmanager.pas
View File

@ -86,7 +86,10 @@ 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 AExceptionType: TDBGExceptionType; const AExceptionClass, AExceptionText: String);
procedure DebuggerException(Sender: TObject;
const AExceptionType: TDBGExceptionType;
const AExceptionClass, AExceptionText: String;
out AContinue: Boolean);
// Dialog events
procedure DebugDialogDestroy(Sender: TObject);
@ -1261,7 +1264,10 @@ end;
// Debugger events
//-----------------------------------------------------------------------------
procedure TDebugManager.DebuggerException(Sender: TObject; const AExceptionType: TDBGExceptionType; const AExceptionClass, AExceptionText: String);
procedure TDebugManager.DebuggerException(Sender: TObject;
const AExceptionType: TDBGExceptionType;
const AExceptionClass, AExceptionText: String;
out AContinue: Boolean);
function GetTitle: String;
begin
@ -1274,9 +1280,14 @@ var
ExceptMsg: string;
msg: String;
Ignore: Boolean;
Res: TModalResult;
begin
if Destroying then exit;
if Destroying then
begin
AContinue := True;
Exit;
end
else
AContinue := False;
if AExceptionText = ''
then
@ -1293,14 +1304,12 @@ begin
end;
if AExceptionType <> deInternal then
MessageDlg('Error', msg, mtError,[mbOk],0)
MessageDlg('Error', msg, mtError, [mbOk], 0)
else
begin
Res := ExecuteExceptionDialog(msg, Ignore);
AContinue := ExecuteExceptionDialog(msg, Ignore) = mrCancel;
if Ignore then
TManagedExceptions(Exceptions).AddIfNeeded(AExceptionClass);
if Res = mrCancel then
FDebugger.Run;
end;
end;