paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-22 11:19:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

debugger: don't pause a project when exception must be skiped

Browse Source 
git-svn-id: trunk@17671 -
This commit is contained in:
paul 2008-12-03 10:46:31 +00:00
parent be0dc642f6
commit 3e23380837
1 changed files with 29 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
debugger/gdbmidebugger.pp
View File

@ -381,6 +381,11 @@ type
Tag: Integer;
end;
TGDBMIExceptionInfo = record
ObjAddr: String;
Name: String;
end;
{ TGDBMINameValueList }
constructor TGDBMINameValueList.Create(const AResultValues: String);
@ -2007,39 +2012,33 @@ function TGDBMIDebugger.ProcessStopped(const AParams: String; const AIgnoreSigIn
end;
end;
procedure ProcessException;
var
ObjAddr, ExceptionName, ExceptionMessage: String;
function GetExceptionInfo: TGDBMIExceptionInfo;
begin
if tfRTLUsesRegCall in FTargetFlags
then ObjAddr := FTargetRegisters[0]
then Result.ObjAddr := FTargetRegisters[0]
else begin
if dfImplicidTypes in FDebuggerFlags
then ObjAddr := Format('^pointer($fp+%d)^', [FTargetPtrSize * 2])
else Str(GetData('$fp+%d', [FTargetPtrSize * 2]), ObjAddr);
end;
ExceptionName := GetInstanceClassName(ObjAddr, []);
if ExceptionName = ''
then ExceptionName := 'Unknown';
// check if we should ignore this exception
if Exceptions.Find(ExceptionName) <> nil
then begin
ExecuteCommand('-exec-continue', []);
Exit;
then Result.ObjAddr := Format('^pointer($fp+%d)^', [FTargetPtrSize * 2])
else Str(GetData('$fp+%d', [FTargetPtrSize * 2]), Result.ObjAddr);
end;
Result.Name := GetInstanceClassName(Result.ObjAddr, []);
if Result.Name = ''
then Result.Name := 'Unknown';
end;
procedure ProcessException(AInfo: TGDBMIExceptionInfo);
var
ExceptionMessage: String;
begin
if dfImplicidTypes in FDebuggerFlags
then begin
ExceptionMessage := GetText('^Exception(%s)^.FMessage', [ObjAddr]);
ExceptionMessage := GetText('^Exception(%s)^.FMessage', [AInfo.ObjAddr]);
//ExceptionMessage := GetText('^^Exception($fp+8)^^.FMessage', []);
ExceptionMessage := DeleteEscapeChars(ExceptionMessage);
end
else ExceptionMessage := '### Not supported on GDB < 5.3 ###';
DoException(ExceptionName, ExceptionMessage);
DoException(AInfo.Name, ExceptionMessage);
DoCurrent(GetLocation);
end;
@ -2100,6 +2099,7 @@ var
BreakID: Integer;
BreakPoint: TGDBMIBreakPoint;
CanContinue: Boolean;
ExceptionInfo: TGDBMIExceptionInfo;
begin
Result := True;
FCurrentStackFrame := 0;
@ -2160,8 +2160,15 @@ begin
if BreakID = FExceptionBreakID
then begin
SetState(dsPause);
ProcessException;
ExceptionInfo := GetExceptionInfo;
// check if we should ignore this exception
if Exceptions.Find(ExceptionInfo.Name) <> nil
then ExecuteCommand('-exec-continue', [])
else begin
SetState(dsPause);
ProcessException(ExceptionInfo);
end;
Exit;
end;