paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-01 14:12:37 +02:00
Code Issues Packages Projects Releases Wiki Activity

Debugger: start refactor event-log handling / allow resource strings for common events to be stored in the IDE (rather than each debugger back end)

Browse Source 
git-svn-id: trunk@58433 -
This commit is contained in:
martin 2018-07-03 14:54:51 +00:00
parent 6bb3d9800a
commit be369c0a73
4 changed files with 233 additions and 82 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
components/debuggerintf/dbgintfdebuggerbase.pp
View File

@ -1727,6 +1727,27 @@ type
TDebuggerPropertiesClass= class of TDebuggerProperties;
{$INTERFACES CORBA} // no ref counting needed
{ TDebuggerEventLogInterface
Methods for the EventLogger that a debugger may call
}
//TODO: remove TDebuggerIntf.OnEvent
TDebuggerEventLogInterface = interface
procedure LogCustomEvent(const ACategory: TDBGEventCategory;
const AEventType: TDBGEventType; const AText: String);
procedure LogEventBreakPointHit(const ABreakpoint: TDBGBreakPoint; const ALocation: TDBGLocationRec);
procedure LogEventWatchPointTriggered(const ABreakpoint: TDBGBreakPoint;
const ALocation: TDBGLocationRec; const AOldWatchedVal, ANewWatchedVal: String);
procedure LogEventWatchPointScope(const ABreakpoint: TDBGBreakPoint;
const ALocation: TDBGLocationRec);
end;
//TDebuggerActionInterface = interface
// // prompt user
//end;
{ TDebuggerIntf }
TDebuggerIntf = class
@ -1757,6 +1778,7 @@ type
FCallStack: TCallStackSupplier;
FWatches: TWatchesSupplier;
FThreads: TThreadsSupplier;
FEventLogHandler: TDebuggerEventLogInterface;
FOnCurrent: TDBGCurrentLineEvent;
FOnException: TDBGExceptionEvent;
FOnOutput: TDBGOutputEvent;
@ -1793,6 +1815,7 @@ type
procedure DoCurrent(const ALocation: TDBGLocationRec);
procedure DoDbgOutput(const AText: String);
procedure DoDbgEvent(const ACategory: TDBGEventCategory; const AEventType: TDBGEventType; const AText: String);
deprecated 'swich to EventLogHandler';
procedure DoException(const AExceptionType: TDBGExceptionType;
const AExceptionClass: String;
const AExceptionLocation: TDBGLocationRec;
@ -1903,9 +1926,11 @@ type
//property UnitInfoProvider: TDebuggerUnitInfoProvider // Provided by DebugBoss, to map files to packages or project
// read GetUnitInfoProvider write FUnitInfoProvider;
// Events
property EventLogHandler: TDebuggerEventLogInterface read FEventLogHandler write FEventLogHandler;
property OnCurrent: TDBGCurrentLineEvent read FOnCurrent write FOnCurrent; // Passes info about the current line being debugged
property OnDbgOutput: TDBGOutputEvent read FOnDbgOutput write FOnDbgOutput; // Passes all debuggeroutput
property OnDbgEvent: TDBGEventNotify read FOnDbgEvent write FOnDbgEvent; // Passes recognized debugger events, like library load or unload
deprecated 'swich to EventLogHandler';
property OnException: TDBGExceptionEvent read FOnException write FOnException; // Fires when the debugger received an ecxeption
property OnOutput: TDBGOutputEvent read FOnOutput write FOnOutput; // Passes all output of the debugged target
property OnBeforeState: TDebuggerStateChangedEvent read FOnBeforeState write FOnBeforeState; // Fires when the current state of the debugger changes
@ -5745,7 +5770,7 @@ end;
procedure TDebuggerIntf.DoDbgEvent(const ACategory: TDBGEventCategory; const AEventType: TDBGEventType; const AText: String);
begin
DebugLnEnter(DBG_EVENTS, ['DebugEvent: Enter >> DoDbgEvent >> State=', dbgs(FState), ' Category=', dbgs(ACategory)]);
if Assigned(FOnDbgEvent) then FOnDbgEvent(Self, ACategory, AEventType, AText);
if Assigned(FEventLogHandler) then FEventLogHandler.LogCustomEvent(ACategory, AEventType, AText);
DebugLnExit(DBG_EVENTS, ['DebugEvent: Exit << DoDbgEvent <<']);
end;

52
components/lazdebuggergdbmi/gdbmidebugger.pp
View File

@ -902,7 +902,7 @@ type
procedure DoUnknownException(Sender: TObject; AnException: Exception);
procedure DoNotifyAsync(Line: String);
procedure DoDbgBreakpointEvent(ABreakpoint: TDBGBreakPoint; Location: TDBGLocationRec;
procedure DoDbgBreakpointEvent(ABreakpoint: TDBGBreakPoint; ALocation: TDBGLocationRec;
AReason: TGDBMIBreakpointReason;
AOldVal: String = ''; ANewVal: String = '');
procedure AddThreadGroup(const S: String);
@ -7911,51 +7911,17 @@ begin
end;
procedure TGDBMIDebugger.DoDbgBreakpointEvent(ABreakpoint: TDBGBreakPoint;
Location: TDBGLocationRec; AReason: TGDBMIBreakpointReason;
AOldVal: String = ''; ANewVal: String = '');
var
SrcName, Msg: String;
SrcLine: Integer;
ALocation: TDBGLocationRec; AReason: TGDBMIBreakpointReason; AOldVal: String;
ANewVal: String);
begin
SrcName := Location.SrcFullName;
if SrcName = '' then
SrcName := Location.SrcFile;
if (SrcName = '') and (ABreakPoint <> nil) and (ABreakPoint.Kind = bpkSource) then
SrcName := ABreakpoint.Source;
SrcLine := Location.SrcLine;
if (SrcLine < 1) and (ABreakPoint <> nil) and (ABreakPoint.Kind = bpkSource) then
SrcLine := ABreakpoint.Line;
if not Assigned(EventLogHandler) then exit;
if ABreakpoint = nil then begin
Msg := Format('Unknown %s', [GDBMIBreakPointReasonNames[AReason]]);
if AReason = gbrWatchTrigger then
Msg := Msg + Format(' changed from "%s" to "%s"', [AOldVal, ANewVal]);
end
else begin
case ABreakPoint.Kind of
bpkSource: Msg := 'Source Breakpoint';
bpkAddress: Msg := 'Address Breakpoint';
bpkData:
begin
if AReason = gbrWatchScope then
Msg := Format('Watchpoint for "%s" out of scope', [ABreakpoint.WatchData])
else
Msg := Format('Watchpoint for "%s" was triggered. Old value "%s", New Value "%s"', [ABreakpoint.WatchData, AOldVal, ANewVal]);
end;
end;
case AReason of
gbrBreak: EventLogHandler.LogEventBreakPointHit(ABreakpoint, ALocation);
gbrWatchTrigger: EventLogHandler.LogEventWatchPointTriggered(
ABreakpoint, ALocation, AOldVal, ANewVal);
gbrWatchScope: EventLogHandler.LogEventWatchPointScope(ABreakpoint, ALocation);
end;
if SrcName <> '' then begin
DoDbgEvent(ecBreakpoint, etBreakpointHit,
Format('%s at $%.' + IntToStr(TargetPtrSize * 2) + 'x: %s line %d',
[Msg, Location.Address, SrcName, SrcLine]));
end
else begin
DoDbgEvent(ecBreakpoint, etBreakpointHit,
Format('%s at $%.' + IntToStr(TargetPtrSize * 2) + 'x',
[Msg, Location.Address]));
end;
end;
function TGDBMIDebugger.ExecuteCommand(const ACommand: String;

220
ide/debugmanager.pas
View File

@ -61,6 +61,34 @@ uses
type
{ TDebugEventLogManager }
TDebugEventLogManager = class(TObject, TDebuggerEventLogInterface)
private
FEventDialog: TDbgEventsForm;
FHiddenDebugEventsLog: TStringList;
FTargetWidth: Integer;
procedure SetEventDialog(AValue: TDbgEventsForm);
function FormatBreakPointAddress(const ABreakpoint: TDBGBreakPoint;
const ALocation: TDBGLocationRec): String;
protected
procedure DebuggerEvent(Sender: TObject; const ACategory: TDBGEventCategory; const AEventType: TDBGEventType; const AText: String);
public
procedure LogCustomEvent(const ACategory: TDBGEventCategory;
const AEventType: TDBGEventType; const AText: String);
procedure LogEventBreakPointHit(const ABreakpoint: TDBGBreakPoint; const ALocation: TDBGLocationRec);
procedure LogEventWatchPointTriggered(const ABreakpoint: TDBGBreakPoint;
const ALocation: TDBGLocationRec; const AOldWatchedVal, ANewWatchedVal: String);
procedure LogEventWatchPointScope(const ABreakpoint: TDBGBreakPoint;
const ALocation: TDBGLocationRec);
public
destructor Destroy; override;
procedure ClearDebugEventsLog;
property EventDialog: TDbgEventsForm read FEventDialog write SetEventDialog;
property TargetWidth: Integer read FTargetWidth write FTargetWidth;
end;
{ TDebugManager }
TDebugManager = class(TBaseDebugManager)
@ -85,7 +113,6 @@ type
procedure DebuggerChangeState(ADebugger: TDebuggerIntf; OldState: TDBGState);
procedure DebuggerCurrentLine(Sender: TObject; const ALocation: TDBGLocationRec);
procedure DebuggerOutput(Sender: TObject; 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;
@ -100,6 +127,7 @@ type
procedure DebugDialogDestroy(Sender: TObject);
private
FDebugger: TDebuggerIntf;
FEventLogManager: TDebugEventLogManager;
FUnitInfoProvider: TDebuggerUnitInfoProvider;
FDialogs: array[TDebugDialogType] of TDebuggerDlg;
FInStateChange: Boolean;
@ -118,7 +146,6 @@ type
// when the debug output log is not open, store the debug log internally
FHiddenDebugOutputLog: TStringList;
FHiddenDebugEventsLog: TStringList;
FRunTimer: TTimer;
FAttachToID: String;
@ -328,6 +355,148 @@ type
procedure Update(Item: TCollectionItem); override;
end;
{ TDebugEventLogManager }
procedure TDebugEventLogManager.SetEventDialog(AValue: TDbgEventsForm);
begin
if FEventDialog = AValue then Exit;
If AValue = nil then begin
if FHiddenDebugEventsLog=nil then
FHiddenDebugEventsLog:=TStringList.Create;
FEventDialog.GetEvents(FHiddenDebugEventsLog);
end
else
if FHiddenDebugEventsLog <> nil then begin
AValue.SetEvents(FHiddenDebugEventsLog);
FreeAndNil(FHiddenDebugEventsLog);
end;
FEventDialog := AValue;
end;
function TDebugEventLogManager.FormatBreakPointAddress(
const ABreakpoint: TDBGBreakPoint; const ALocation: TDBGLocationRec): String;
var
SrcName: String;
begin
SrcName := ALocation.SrcFullName;
if SrcName = '' then
SrcName := ALocation.SrcFile;
if SrcName <> '' then
Result := Format(dbgEventBreakAtAddressSourceLine,
[IntToHex(ALocation.Address, FTargetWidth), SrcName, ALocation.SrcLine])
else
if (ABreakpoint <> nil) and (ABreakPoint.Kind = bpkSource) then
Result := Format(dbgEventBreakAtAddressOriginSourceOriginLine,
[IntToHex(ALocation.Address, FTargetWidth), ABreakpoint.Source, ABreakpoint.Line])
else
Result := Format(dbgEventBreakAtAddress, [IntToHex(ALocation.Address,
FTargetWidth)]);
end;
procedure TDebugEventLogManager.DebuggerEvent(Sender: TObject;
const ACategory: TDBGEventCategory; const AEventType: TDBGEventType;
const AText: String);
var
Rec: TDBGEventRec;
begin
if EventDialog <> nil
then begin
EventDialog.AddEvent(ACategory, AEventType, AText)
end
else begin
// store it internally, and copy it to the dialog, when the user opens it
if FHiddenDebugEventsLog=nil
then FHiddenDebugEventsLog := TStringList.Create;
if EnvironmentOptions.DebuggerEventLogCheckLineLimit
then begin
while FHiddenDebugEventsLog.Count >= EnvironmentOptions.DebuggerEventLogLineLimit do
FHiddenDebugEventsLog.Delete(0);
end;
Rec.Category := Ord(ACategory);
Rec.EventType := Ord(AEventType);
FHiddenDebugEventsLog.AddObject(AText, TObject(Rec.Ptr));
end;
end;
procedure TDebugEventLogManager.LogCustomEvent(
const ACategory: TDBGEventCategory; const AEventType: TDBGEventType;
const AText: String);
begin
DebuggerEvent(nil, ACategory, AEventType, AText);
end;
procedure TDebugEventLogManager.LogEventBreakPointHit(
const ABreakpoint: TDBGBreakPoint; const ALocation: TDBGLocationRec);
var
Msg: String;
begin
if ABreakpoint = nil then
Msg := dbgEventBreakUnknownBreakPoint
else
case ABreakPoint.Kind of
bpkSource: Msg := dbgEventBreakSourceBreakPoint;
bpkAddress: Msg := dbgEventBreakAddressBreakPoint;
bpkData: Msg := dbgEventBreakWatchPoint; // should not be here, use LogEventWatchPointTriggered();
end;
LogCustomEvent(ecBreakpoint, etBreakpointHit,
Format(Msg, [FormatBreakPointAddress(ABreakpoint, ALocation)]));
end;
procedure TDebugEventLogManager.LogEventWatchPointTriggered(
const ABreakpoint: TDBGBreakPoint; const ALocation: TDBGLocationRec;
const AOldWatchedVal, ANewWatchedVal: String);
var
Msg, Loc: String;
begin
Loc := FormatBreakPointAddress(ABreakpoint, ALocation);
if ABreakpoint = nil then
Msg := Format(dbgEventUnknownWatchPointTriggered, [Loc, AOldWatchedVal, ANewWatchedVal])
else
case ABreakPoint.Kind of
bpkSource: Msg := Format(dbgEventBreakSourceBreakPoint , [Loc]); // should not be here
bpkAddress: Msg := Format(dbgEventBreakAddressBreakPoint, [Loc]); // should not be here
bpkData: Msg := Format(dbgEventWatchTriggered, [Loc, ABreakpoint.WatchData,
AOldWatchedVal, ANewWatchedVal]);
end;
LogCustomEvent(ecBreakpoint, etBreakpointHit, Msg );
end;
procedure TDebugEventLogManager.LogEventWatchPointScope(
const ABreakpoint: TDBGBreakPoint; const ALocation: TDBGLocationRec);
var
Msg, Loc: String;
begin
Loc := FormatBreakPointAddress(ABreakpoint, ALocation);
if ABreakpoint = nil then
Msg := Format(dbgEventUnknownWatchPointScopeEnded, [Loc])
else
case ABreakPoint.Kind of
bpkSource: Msg := Format(dbgEventBreakSourceBreakPoint , [Loc]); // should not be here
bpkAddress: Msg := Format(dbgEventBreakAddressBreakPoint, [Loc]); // should not be here
bpkData: Format(dbgEventWatchScopeEnded, [ABreakpoint.WatchData, Loc])
end;
LogCustomEvent(ecBreakpoint, etBreakpointHit, Msg );
end;
destructor TDebugEventLogManager.Destroy;
begin
FreeAndNil(FHiddenDebugEventsLog);
inherited Destroy;
end;
procedure TDebugEventLogManager.ClearDebugEventsLog;
begin
if EventDialog <> nil then
EventDialog.Clear;
FreeAndNil(FHiddenDebugEventsLog);
end;
{ TProjectExceptions }
procedure TProjectExceptions.SetIgnoreAll(const AValue: Boolean);
@ -1066,30 +1235,6 @@ begin
end;
end;
procedure TDebugManager.DebuggerEvent(Sender: TObject; const ACategory: TDBGEventCategory; const AEventType: TDBGEventType; const AText: String);
var
Rec: TDBGEventRec;
begin
if Destroying then exit;
if FDialogs[ddtEvents] <> nil
then begin
TDbgEventsForm(FDialogs[ddtEvents]).AddEvent(ACategory, AEventType, AText)
end
else begin
// store it internally, and copy it to the dialog, when the user opens it
if FHiddenDebugEventsLog=nil
then FHiddenDebugEventsLog := TStringList.Create;
if EnvironmentOptions.DebuggerEventLogCheckLineLimit
then begin
while FHiddenDebugEventsLog.Count >= EnvironmentOptions.DebuggerEventLogLineLimit do
FHiddenDebugEventsLog.Delete(0);
end;
Rec.Category := Ord(ACategory);
Rec.EventType := Ord(AEventType);
FHiddenDebugEventsLog.AddObject(AText, TObject(Rec.Ptr));
end;
end;
procedure TDebugManager.DebuggerBeforeChangeState(ADebugger: TDebuggerIntf;
AOldState: TDBGState);
var
@ -1432,9 +1577,7 @@ begin
end;
ddtEvents:
begin
if FHiddenDebugEventsLog=nil then
FHiddenDebugEventsLog:=TStringList.Create;
TDbgEventsForm(FDialogs[ddtEvents]).GetEvents(FHiddenDebugEventsLog);
FEventLogManager.EventDialog := nil;
end;
end;
FDialogs[DlgType]:=nil;
@ -1546,9 +1689,7 @@ var
TheDialog: TDbgEventsForm;
begin
TheDialog := TDbgEventsForm(FDialogs[ddtEvents]);
TheDialog.SetEvents(FHiddenDebugEventsLog);
if FHiddenDebugEventsLog <> nil then
FreeAndNil(FHiddenDebugEventsLog);
FEventLogManager.EventDialog := TheDialog;
end;
procedure TDebugManager.InitBreakPointDlg;
@ -1720,6 +1861,8 @@ begin
RegisterValueFormatter(skFloat, 'TTime', @DBGDateTimeFormatter);
RegisterValueFormatter(skSimple, 'TDateTime', @DBGDateTimeFormatter);
RegisterValueFormatter(skFloat, 'TDateTime', @DBGDateTimeFormatter);
FEventLogManager := TDebugEventLogManager.Create;
end;
destructor TDebugManager.Destroy;
@ -1736,6 +1879,7 @@ begin
SetDebugger(nil);
FreeAndNil(FEventLogManager);
FreeAndNil(FSnapshots);
FreeAndNil(FWatches);
FreeAndNil(FThreads);
@ -1751,7 +1895,6 @@ begin
FreeAndNil(FUserSourceFiles);
FreeAndNil(FHiddenDebugOutputLog);
FreeAndNil(FHiddenDebugEventsLog);
FreeAndNil(FUnitInfoProvider);
inherited Destroy;
@ -2113,10 +2256,7 @@ end;
procedure TDebugManager.ClearDebugEventsLog;
begin
if FDialogs[ddtEvents] <> nil then
TDbgEventsForm(FDialogs[ddtEvents]).Clear
else if FHiddenDebugEventsLog<>nil then
FHiddenDebugEventsLog.Clear;
FEventLogManager.ClearDebugEventsLog;
end;
//-----------------------------------------------------------------------------
@ -2302,11 +2442,14 @@ begin
FDebugger.OnState := @DebuggerChangeState;
FDebugger.OnCurrent := @DebuggerCurrentLine;
FDebugger.OnDbgOutput := @DebuggerOutput;
FDebugger.OnDbgEvent := @DebuggerEvent;
FDebugger.OnDbgEvent := @FEventLogManager.DebuggerEvent;
FDebugger.OnException := @DebuggerException;
FDebugger.OnConsoleOutput := @DebuggerConsoleOutput;
FDebugger.OnFeedback := @DebuggerFeedback;
FDebugger.OnIdle := @DebuggerIdle;
FDebugger.EventLogHandler := FEventLogManager;
FEventLogManager.TargetWidth := FDebugger.TargetWidth div 8;
if FDebugger.State = dsNone
then begin
@ -2993,6 +3136,7 @@ begin
FDebugger.OnFeedback := nil;
FDebugger.OnIdle := nil;
FDebugger.Exceptions := nil;
FDebugger.EventLogHandler := nil;
end;
FDebugger := ADebugger;

16
ide/lazarusidestrconsts.pas
View File

@ -6440,6 +6440,22 @@ resourcestring
lisDsgToggleShowingNonVisualComponents = 'Toggle showing nonvisual '
+'components';
lisDsgShowNonVisualComponents = 'Show nonvisual components';
// * Debug Event Log *
// Snippet for break location: .... at $04123456: unit1.pas line 15 ...
dbgEventBreakAtAddressSourceLine = 'at $%s: %s line %d';
dbgEventBreakAtAddressOriginSourceOriginLine = 'at $%s: from origin %s line %d'; // Source/Line from Breakpoint (origin)
dbgEventBreakAtAddress = 'at $%s'; // unknows source/line
// Breakpoint hit events (first param is location): "Source Breakpoint at $0x00000..."
dbgEventBreakSourceBreakPoint = 'Source Breakpoint %s';
dbgEventBreakAddressBreakPoint = 'Address Breakpoint %s';
dbgEventBreakUnknownBreakPoint = 'Unknown Breakpoint %s';
dbgEventBreakWatchPoint = 'Watchpoint %s';
dbgEventWatchTriggered = 'Watchpoint for "%s" was triggered %s. Old value "%s", New Value "%s"';
dbgEventUnknownWatchPointTriggered = 'Unknown Watchpoint triggered %s. Old value "%s", New Value "%s"';
dbgEventWatchScopeEnded = 'Watchpoint for "%s" out of scope %s';
dbgEventUnknownWatchPointScopeEnded = 'Unknown Watchpoint out of scope %s';
implementation
end.