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

debugger: fix $eax cast to Exception class when dwarf debug info is used

Browse Source 
git-svn-id: trunk@22979 -
This commit is contained in:
paul 2009-12-05 20:23:35 +00:00
parent 43bfbedd1f
commit d80a143fad
1 changed files with 13 additions and 3 deletions

16
debugger/gdbmidebugger.pp
View File

@ -78,8 +78,9 @@ type
TGDBMIPauseWaitState = (pwsNone, pwsInternal, pwsExternal);
TGDBMITargetFlags = set of (
tfHasSymbols, // Debug symbols are present
tfRTLUsesRegCall // the RTL is compiled with RegCall calling convention
tfHasSymbols, // Debug symbols are present
tfRTLUsesRegCall, // the RTL is compiled with RegCall calling convention
tfClassIsPointer // with dwarf class names are pointer. with stabs they are not
);
TGDBMIDebuggerFlags = set of (
@ -3293,7 +3294,9 @@ function TGDBMIDebugger.ProcessStopped(const AParams: String; const AIgnoreSigIn
begin
if dfImplicidTypes in FDebuggerFlags
then begin
ExceptionMessage := GetText('^Exception(%s)^.FMessage', [AInfo.ObjAddr]);
if tfClassIsPointer in FTargetFlags
then ExceptionMessage := GetText('Exception(%s).FMessage', [AInfo.ObjAddr])
else ExceptionMessage := GetText('^Exception(%s)^.FMessage', [AInfo.ObjAddr]);
//ExceptionMessage := GetText('^^Exception($fp+8)^^.FMessage', []);
end
else ExceptionMessage := '### Not supported on GDB < 5.3 ###';
@ -3771,6 +3774,13 @@ begin
TempInstalled := False;
end;
// check whether we need class cast dereference
if ExecuteCommand('ptype TObject', [cfIgnoreError], R)
then begin
if (LeftStr(R.Values, 15) = 'type = ^TOBJECT')
then include(FTargetFlags, tfClassIsPointer);
end;
// try Insert Break breakpoint
// we might have rtl symbols
if FExceptionBreakID = -1