mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-23 01:19:37 +02:00
debugger: add TDBGEventType enumeration, pass event type when some debugger event happens
git-svn-id: trunk@30487 -
This commit is contained in:
paul
parent
ec09bfef6c
commit
f52d287d2d
@ -53,7 +53,7 @@ type
|
||||
procedure SetEvents(const AEvents: TStrings);
|
||||
procedure GetEvents(const AResultEvents: TStrings);
|
||||
procedure Clear;
|
||||
procedure AddEvent(const ACategory: TDBGEventCategory; const AText: String);
|
||||
procedure AddEvent(const ACategory: TDBGEventCategory; const AEventType: TDBGEventType; const AText: String);
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -160,7 +160,7 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TDbgEventsForm.AddEvent(const ACategory: TDBGEventCategory; const AText: String);
|
||||
procedure TDbgEventsForm.AddEvent(const ACategory: TDBGEventCategory; const AEventType: TDBGEventType; const AText: String);
|
||||
var
|
||||
Item: TListItem;
|
||||
begin
|
||||
|
||||
@ -1626,7 +1626,7 @@ type
|
||||
|
||||
TDBGEventCategory = (
|
||||
ecBreakpoint, // Breakpoint hit
|
||||
ecProcess,
|
||||
ecProcess, // Process start, process stop
|
||||
ecThread, // Thread creation, destruction, start, etc.
|
||||
ecModule, // Library load and unload
|
||||
ecOutput, // DebugOutput calls
|
||||
@ -1634,11 +1634,37 @@ type
|
||||
ecDebugger); // debugger errors and warnings
|
||||
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);
|
||||
TDBGFeedbackResult = (frOk, frStop);
|
||||
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;
|
||||
|
||||
TDebuggerStateChangedEvent = procedure(ADebugger: TDebugger;
|
||||
@ -1724,7 +1750,7 @@ type
|
||||
function CreateExceptions: TDBGExceptions; virtual;
|
||||
procedure DoCurrent(const ALocation: TDBGLocationRec);
|
||||
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 DoOutput(const AText: String);
|
||||
procedure DoBreakpointHit(const ABreakPoint: TBaseBreakPoint; var ACanContinue: Boolean);
|
||||
@ -2450,9 +2476,9 @@ begin
|
||||
if Assigned(FOnDbgOutput) then FOnDbgOutput(Self, AText);
|
||||
end;
|
||||
|
||||
procedure TDebugger.DoDbgEvent(const ACategory: TDBGEventCategory; const AText: String);
|
||||
procedure TDebugger.DoDbgEvent(const ACategory: TDBGEventCategory; const AEventType: TDBGEventType; const AText: String);
|
||||
begin
|
||||
if Assigned(FOnDbgEvent) then FOnDbgEvent(Self, ACategory, AText);
|
||||
if Assigned(FOnDbgEvent) then FOnDbgEvent(Self, ACategory, AEventType, AText);
|
||||
end;
|
||||
|
||||
procedure TDebugger.DoException(const AExceptionType: TDBGExceptionType; const AExceptionClass: String;
|
||||
|
||||
@ -244,7 +244,7 @@ type
|
||||
function CheckHasType(TypeName: String; TypeFlag: TGDBMITargetFlag): TGDBMIExecResult;
|
||||
function PointerTypeCast: 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 LastExecResult: TGDBMIExecResult read FLastExecResult;
|
||||
property DefaultTimeOut: Integer read FDefaultTimeOut write FDefaultTimeOut;
|
||||
@ -3590,10 +3590,13 @@ var
|
||||
S: String;
|
||||
begin
|
||||
S := GetPart(['='], [','], Line, False, False);
|
||||
case StringCase(S, ['shlibs-added', 'shlibs-updated',
|
||||
'library-loaded', 'library-unloaded'], False, False)
|
||||
of
|
||||
0..3: DoDbgEvent(ecModule, Line);
|
||||
case StringCase(S, [
|
||||
'shlibs-added', 'library-loaded',
|
||||
'library-unloaded',
|
||||
'shlibs-updated'], False, False) of
|
||||
0..1: DoDbgEvent(ecModule, etModuleLoad, Line);
|
||||
2: DoDbgEvent(ecModule, etModuleUnload, Line);
|
||||
3: DoDbgEvent(ecModule, etDefault, Line);
|
||||
else
|
||||
DebugLn('[Debugger] Notify output: ', Line);
|
||||
end;
|
||||
@ -8486,7 +8489,7 @@ function TGDBMIDebuggerCommand.ProcessResult(var AResult: TGDBMIExecResult;ATime
|
||||
if Pos('no debugging symbols', Line) > 0
|
||||
then begin
|
||||
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
|
||||
else begin
|
||||
// Strip surrounding ~" "
|
||||
@ -8530,7 +8533,7 @@ function TGDBMIDebuggerCommand.ProcessResult(var AResult: TGDBMIExecResult;ATime
|
||||
EventText := GetPart(['*'], [','], Line, False, False);
|
||||
if EventText = 'running'
|
||||
then
|
||||
DoDbgEvent(ecProcess, Line)
|
||||
DoDbgEvent(ecProcess, etProcessStart, Line)
|
||||
else
|
||||
DebugLn('[WARNING] Debugger: Unexpected async-record: ', Line);
|
||||
end;
|
||||
@ -8550,8 +8553,10 @@ function TGDBMIDebuggerCommand.ProcessResult(var AResult: TGDBMIExecResult;ATime
|
||||
'thread-created', 'thread-group-created',
|
||||
'thread-exited', 'thread-group-exited'], False, False)
|
||||
of
|
||||
0..1: DoDbgEvent(ecModule, Line);
|
||||
2..5: DoDbgEvent(ecThread, Line);
|
||||
0: DoDbgEvent(ecModule, etModuleLoad, Line);
|
||||
1: DoDbgEvent(ecModule, etModuleUnload, Line);
|
||||
2..3: DoDbgEvent(ecThread, etThreadStart, Line);
|
||||
4..5: DoDbgEvent(ecThread, etThreadExit, Line);
|
||||
else
|
||||
DebugLn('[WARNING] Debugger: Unexpected async-record: ', Line);
|
||||
end;
|
||||
@ -9067,9 +9072,9 @@ begin
|
||||
end;
|
||||
|
||||
procedure TGDBMIDebuggerCommand.DoDbgEvent(const ACategory: TDBGEventCategory;
|
||||
const AText: String);
|
||||
const AEventType: TDBGEventType; const AText: String);
|
||||
begin
|
||||
FTheDebugger.DoDbgEvent(ACategory, AText);
|
||||
FTheDebugger.DoDbgEvent(ACategory, AEventType, AText);
|
||||
end;
|
||||
|
||||
constructor TGDBMIDebuggerCommand.Create(AOwner: TGDBMIDebugger);
|
||||
|
||||
@ -78,7 +78,7 @@ type
|
||||
procedure DebuggerChangeState(ADebugger: TDebugger; OldState: TDBGState);
|
||||
procedure DebuggerCurrentLine(Sender: TObject; const ALocation: TDBGLocationRec);
|
||||
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);
|
||||
function DebuggerFeedback(Sender: TObject; const AText, AInfo: String;
|
||||
AType: TDBGFeedbackType; AButtons: TDBGFeedbackResults): TDBGFeedbackResult;
|
||||
@ -1662,12 +1662,12 @@ begin
|
||||
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
|
||||
if Destroying then exit;
|
||||
if FDialogs[ddtEvents] <> nil
|
||||
then begin
|
||||
TDbgEventsForm(FDialogs[ddtEvents]).AddEvent(ACategory, AText)
|
||||
TDbgEventsForm(FDialogs[ddtEvents]).AddEvent(ACategory, AEventType, AText)
|
||||
end
|
||||
else begin
|
||||
// store it internally, and copy it to the dialog, when the user opens it
|
||||
|
||||
Loading…
Reference in New Issue
Block a user