paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-14 13:19:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

debugger: add TDBGEventType enumeration, pass event type when some debugger event happens

Browse Source 
git-svn-id: trunk@30487 -
This commit is contained in:
paul 2011-04-27 06:58:44 +00:00
parent ec09bfef6c
commit f52d287d2d
4 changed files with 52 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
debugger/debugeventsform.pp
View File

@ -53,7 +53,7 @@ type
procedure SetEvents(const AEvents: TStrings); procedure SetEvents(const AEvents: TStrings);
procedure GetEvents(const AResultEvents: TStrings); procedure GetEvents(const AResultEvents: TStrings);
procedure Clear; procedure Clear;
procedure AddEvent(const ACategory: TDBGEventCategory; const AText: String); procedure AddEvent(const ACategory: TDBGEventCategory; const AEventType: TDBGEventType; const AText: String);
end; end;
implementation implementation
@ -160,7 +160,7 @@ begin
inherited Destroy; inherited Destroy;
end; end;
procedure TDbgEventsForm.AddEvent(const ACategory: TDBGEventCategory; const AText: String); procedure TDbgEventsForm.AddEvent(const ACategory: TDBGEventCategory; const AEventType: TDBGEventType; const AText: String);
var var
Item: TListItem; Item: TListItem;
begin begin

36
debugger/debugger.pp
View File

@ -1626,7 +1626,7 @@ type
TDBGEventCategory = ( TDBGEventCategory = (
ecBreakpoint, // Breakpoint hit ecBreakpoint, // Breakpoint hit
ecProcess, ecProcess, // Process start, process stop
ecThread, // Thread creation, destruction, start, etc. ecThread, // Thread creation, destruction, start, etc.
ecModule, // Library load and unload ecModule, // Library load and unload
ecOutput, // DebugOutput calls ecOutput, // DebugOutput calls
@ -1634,11 +1634,37 @@ type
ecDebugger); // debugger errors and warnings ecDebugger); // debugger errors and warnings
TDBGEventCategories = set of TDBGEventCategory; TDBGEventCategories = set of TDBGEventCategory;
TDBGEventType = (
etDefault,
// ecBreakpoint category
etBreakpointEvaluation,
etBreakpointHit,
etBreakpointMessage,
etBreakpointStackDump,
etExceptionRaised,
// ecModule category
etModuleLoad,
etModuleUnload,
// ecOutput category
etOutputDebugString,
// ecProcess category
etProcessExit,
etProcessStart,
// ecThread category
etThreadExit,
etThreadStart,
// ecWindows category
etWindowsMessagePosted,
etWindowsMessageSent
);
TDBGFeedbackType = (ftWarning, ftError); TDBGFeedbackType = (ftWarning, ftError);
TDBGFeedbackResult = (frOk, frStop); TDBGFeedbackResult = (frOk, frStop);
TDBGFeedbackResults = set of TDBGFeedbackResult; TDBGFeedbackResults = set of TDBGFeedbackResult;
TDBGEventNotify = procedure(Sender: TObject; const ACategory: TDBGEventCategory; TDBGEventNotify = procedure(Sender: TObject;
const ACategory: TDBGEventCategory;
const AEventType: TDBGEventType;
const AText: String) of object; const AText: String) of object;
TDebuggerStateChangedEvent = procedure(ADebugger: TDebugger; TDebuggerStateChangedEvent = procedure(ADebugger: TDebugger;
@ -1724,7 +1750,7 @@ type
function CreateExceptions: TDBGExceptions; virtual; function CreateExceptions: TDBGExceptions; virtual;
procedure DoCurrent(const ALocation: TDBGLocationRec); procedure DoCurrent(const ALocation: TDBGLocationRec);
procedure DoDbgOutput(const AText: String); procedure DoDbgOutput(const AText: String);
procedure DoDbgEvent(const ACategory: TDBGEventCategory; const AText: String); procedure DoDbgEvent(const ACategory: TDBGEventCategory; const AEventType: TDBGEventType; const AText: String);
procedure DoException(const AExceptionType: TDBGExceptionType; const AExceptionClass: String; const AExceptionText: String; out AContinue: Boolean); procedure DoException(const AExceptionType: TDBGExceptionType; const AExceptionClass: String; const AExceptionText: String; out AContinue: Boolean);
procedure DoOutput(const AText: String); procedure DoOutput(const AText: String);
procedure DoBreakpointHit(const ABreakPoint: TBaseBreakPoint; var ACanContinue: Boolean); procedure DoBreakpointHit(const ABreakPoint: TBaseBreakPoint; var ACanContinue: Boolean);
@ -2450,9 +2476,9 @@ begin
if Assigned(FOnDbgOutput) then FOnDbgOutput(Self, AText); if Assigned(FOnDbgOutput) then FOnDbgOutput(Self, AText);
end; end;
procedure TDebugger.DoDbgEvent(const ACategory: TDBGEventCategory; const AText: String); procedure TDebugger.DoDbgEvent(const ACategory: TDBGEventCategory; const AEventType: TDBGEventType; const AText: String);
begin begin
if Assigned(FOnDbgEvent) then FOnDbgEvent(Self, ACategory, AText); if Assigned(FOnDbgEvent) then FOnDbgEvent(Self, ACategory, AEventType, AText);
end; end;
procedure TDebugger.DoException(const AExceptionType: TDBGExceptionType; const AExceptionClass: String; procedure TDebugger.DoException(const AExceptionType: TDBGExceptionType; const AExceptionClass: String;

27
debugger/gdbmidebugger.pp
View File

@ -244,7 +244,7 @@ type
function CheckHasType(TypeName: String; TypeFlag: TGDBMITargetFlag): TGDBMIExecResult; function CheckHasType(TypeName: String; TypeFlag: TGDBMITargetFlag): TGDBMIExecResult;
function PointerTypeCast: string; function PointerTypeCast: string;
procedure ProcessFrame(const AFrame: String = ''); procedure ProcessFrame(const AFrame: String = '');
procedure DoDbgEvent(const ACategory: TDBGEventCategory; const AText: String); procedure DoDbgEvent(const ACategory: TDBGEventCategory; const AEventType: TDBGEventType; const AText: String);
property TargetInfo: PGDBMITargetInfo read GetTargetInfo; property TargetInfo: PGDBMITargetInfo read GetTargetInfo;
property LastExecResult: TGDBMIExecResult read FLastExecResult; property LastExecResult: TGDBMIExecResult read FLastExecResult;
property DefaultTimeOut: Integer read FDefaultTimeOut write FDefaultTimeOut; property DefaultTimeOut: Integer read FDefaultTimeOut write FDefaultTimeOut;
@ -3590,10 +3590,13 @@ var
S: String; S: String;
begin begin
S := GetPart(['='], [','], Line, False, False); S := GetPart(['='], [','], Line, False, False);
case StringCase(S, ['shlibs-added', 'shlibs-updated', case StringCase(S, [
'library-loaded', 'library-unloaded'], False, False) 'shlibs-added', 'library-loaded',
of 'library-unloaded',
0..3: DoDbgEvent(ecModule, Line); 'shlibs-updated'], False, False) of
0..1: DoDbgEvent(ecModule, etModuleLoad, Line);
2: DoDbgEvent(ecModule, etModuleUnload, Line);
3: DoDbgEvent(ecModule, etDefault, Line);
else else
DebugLn('[Debugger] Notify output: ', Line); DebugLn('[Debugger] Notify output: ', Line);
end; end;
@ -8486,7 +8489,7 @@ function TGDBMIDebuggerCommand.ProcessResult(var AResult: TGDBMIExecResult;ATime
if Pos('no debugging symbols', Line) > 0 if Pos('no debugging symbols', Line) > 0
then begin then begin
TargetInfo^.TargetFlags := TargetInfo^.TargetFlags - [tfHasSymbols]; TargetInfo^.TargetFlags := TargetInfo^.TargetFlags - [tfHasSymbols];
DoDbgEvent(ecDebugger, Format('File ''%s'' has no debug symbols', [FTheDebugger.FileName])); DoDbgEvent(ecDebugger, etDefault, Format('File ''%s'' has no debug symbols', [FTheDebugger.FileName]));
end end
else begin else begin
// Strip surrounding ~" " // Strip surrounding ~" "
@ -8530,7 +8533,7 @@ function TGDBMIDebuggerCommand.ProcessResult(var AResult: TGDBMIExecResult;ATime
EventText := GetPart(['*'], [','], Line, False, False); EventText := GetPart(['*'], [','], Line, False, False);
if EventText = 'running' if EventText = 'running'
then then
DoDbgEvent(ecProcess, Line) DoDbgEvent(ecProcess, etProcessStart, Line)
else else
DebugLn('[WARNING] Debugger: Unexpected async-record: ', Line); DebugLn('[WARNING] Debugger: Unexpected async-record: ', Line);
end; end;
@ -8550,8 +8553,10 @@ function TGDBMIDebuggerCommand.ProcessResult(var AResult: TGDBMIExecResult;ATime
'thread-created', 'thread-group-created', 'thread-created', 'thread-group-created',
'thread-exited', 'thread-group-exited'], False, False) 'thread-exited', 'thread-group-exited'], False, False)
of of
0..1: DoDbgEvent(ecModule, Line); 0: DoDbgEvent(ecModule, etModuleLoad, Line);
2..5: DoDbgEvent(ecThread, Line); 1: DoDbgEvent(ecModule, etModuleUnload, Line);
2..3: DoDbgEvent(ecThread, etThreadStart, Line);
4..5: DoDbgEvent(ecThread, etThreadExit, Line);
else else
DebugLn('[WARNING] Debugger: Unexpected async-record: ', Line); DebugLn('[WARNING] Debugger: Unexpected async-record: ', Line);
end; end;
@ -9067,9 +9072,9 @@ begin
end; end;
procedure TGDBMIDebuggerCommand.DoDbgEvent(const ACategory: TDBGEventCategory; procedure TGDBMIDebuggerCommand.DoDbgEvent(const ACategory: TDBGEventCategory;
const AText: String); const AEventType: TDBGEventType; const AText: String);
begin begin
FTheDebugger.DoDbgEvent(ACategory, AText); FTheDebugger.DoDbgEvent(ACategory, AEventType, AText);
end; end;
constructor TGDBMIDebuggerCommand.Create(AOwner: TGDBMIDebugger); constructor TGDBMIDebuggerCommand.Create(AOwner: TGDBMIDebugger);

6
ide/debugmanager.pas
View File

@ -78,7 +78,7 @@ type
procedure DebuggerChangeState(ADebugger: TDebugger; OldState: TDBGState); procedure DebuggerChangeState(ADebugger: TDebugger; OldState: TDBGState);
procedure DebuggerCurrentLine(Sender: TObject; const ALocation: TDBGLocationRec); procedure DebuggerCurrentLine(Sender: TObject; const ALocation: TDBGLocationRec);
procedure DebuggerOutput(Sender: TObject; const AText: String); procedure DebuggerOutput(Sender: TObject; const AText: String);
procedure DebuggerEvent(Sender: TObject; const ACategory: TDBGEventCategory; const AText: String); procedure DebuggerEvent(Sender: TObject; const ACategory: TDBGEventCategory; const AEventType: TDBGEventType; const AText: String);
procedure DebuggerConsoleOutput(Sender: TObject; const AText: String); procedure DebuggerConsoleOutput(Sender: TObject; const AText: String);
function DebuggerFeedback(Sender: TObject; const AText, AInfo: String; function DebuggerFeedback(Sender: TObject; const AText, AInfo: String;
AType: TDBGFeedbackType; AButtons: TDBGFeedbackResults): TDBGFeedbackResult; AType: TDBGFeedbackType; AButtons: TDBGFeedbackResults): TDBGFeedbackResult;
@ -1662,12 +1662,12 @@ begin
end; end;
end; end;
procedure TDebugManager.DebuggerEvent(Sender: TObject; const ACategory: TDBGEventCategory; const AText: String); procedure TDebugManager.DebuggerEvent(Sender: TObject; const ACategory: TDBGEventCategory; const AEventType: TDBGEventType; const AText: String);
begin begin
if Destroying then exit; if Destroying then exit;
if FDialogs[ddtEvents] <> nil if FDialogs[ddtEvents] <> nil
then begin then begin
TDbgEventsForm(FDialogs[ddtEvents]).AddEvent(ACategory, AText) TDbgEventsForm(FDialogs[ddtEvents]).AddEvent(ACategory, AEventType, AText)
end end
else begin else begin
// store it internally, and copy it to the dialog, when the user opens it // store it internally, and copy it to the dialog, when the user opens it