LazDebuggerIntf: change event signature, include data / add template

This commit is contained in:
Martin 2023-03-01 23:21:42 +01:00
parent 196981e0a7
commit 20bf681e0f
5 changed files with 186 additions and 84 deletions

View File

@ -136,7 +136,7 @@ type
TFpThreadWorkerWatchValueEvalUpdate = class(TFpThreadWorkerWatchValueEval)
private
procedure DoWachCanceled(Sender: TObject);
procedure DoWachCanceled(Sender: TDbgDataRequestIntf; Data: TDbgDataRequestEventData);
protected
procedure UpdateWatch_DecRef(Data: PtrInt = 0); override;
procedure DoRemovedFromLinkedList; override; // _DecRef
@ -1055,7 +1055,8 @@ end;
{ TFpThreadWorkerWatchValueEvalUpdate }
procedure TFpThreadWorkerWatchValueEvalUpdate.DoWachCanceled(Sender: TObject);
procedure TFpThreadWorkerWatchValueEvalUpdate.DoWachCanceled(
Sender: TDbgDataRequestIntf; Data: TDbgDataRequestEventData);
begin
assert(system.ThreadID = classes.MainThreadID, 'TFpThreadWorkerWatchValueEvalUpdate.DoWachCanceled: system.ThreadID = classes.MainThreadID');
RequestStop;

View File

@ -50,9 +50,50 @@ type
ddsError // Error, but got some Value to display (e.g. error msg)
);
TDbgDataRequestIntf = interface;
TDbgDataRequestEventType = (
weeCancel
);
TDbgDataRequestEventData = record
case TDbgDataRequestEventType of
weeCancel: ();
end;
TDbgDataRequestEvent = procedure(Sender: TDbgDataRequestIntf; Data: TDbgDataRequestEventData) of object;
TDbgDataRequestIntf = interface
procedure AddFreeNotification(ANotification: TNotifyEvent);
procedure RemoveFreeNotification(ANotification: TNotifyEvent);
procedure AddNotification(AnEventType: TDbgDataRequestEventType; AnEvent: TDbgDataRequestEvent);
procedure RemoveNotification(AnEventType: TDbgDataRequestEventType; AnEvent: TDbgDataRequestEvent);
(* Begin/EndUdate
- shall indicate that the newly set values are now valid. Ready for display.
(Indicated by EndUpdate)
- shall protect the object from destruction.
A debugger backend may access the object during this time, without further checks.
- shall ensure changes outside the backend, will not affect calls by the
backend to any method setting/adding/modifing requested data.
~ I.e. if the backend adds values to an array or structure, further calls
by the backend to add more data must be accepted without failure.
~ However, further data may be discarded internally, if possible without
causing later failures (e.g. if the requested data is no longer needed)
(!) - does NOT affect, if read-only properties/functions can change their value.
E.g., if the requested value is no longer needed, then "Expression" and
other "passed in/provided values" may change (reset to default/empty)
* When used in the IDE (Begin/EndUpdate themself shall only be valid in the main thread),
shall
- allow the backend to read "passed in/provided values" from another thread
- allow the backend to set new values from another thread
(I.e., if the IDE (or any non-backend code) makes changes, they must
consider thread safety)
// Any "frontend" outside the IDE (commandline / dbg-server) doens not
need to consider thread safety, as long as it knows that this in not
required by any of the backends it uses.
*)
procedure BeginUpdate;
procedure EndUpdate;
end;
@ -89,10 +130,6 @@ type
);
TWatcheEvaluateFlags = set of TWatcheEvaluateFlag;
TWatcheEvaluateEvent = (
weeCancel
);
TDBGTypeBase = class(TObject)
end;
@ -201,35 +238,6 @@ type
{ TWatchValueIntf }
TWatchValueIntf = interface(TDbgDataRequestIntf)
(* Begin/EndUdate
- shall indicate that the newly set values are now valid. Ready for display.
(Indicated by EndUpdate)
- shall protect the object from destruction.
A debugger backend may access the object during this time, without further checks.
- shall ensure changes outside the backend, will not affect calls by the
backend to any method setting/adding/modifing requested data.
~ I.e. if the backend adds values to an array or structure, further calls
by the backend to add more data must be accepted without failure.
~ However, further data may be discarded internally, if possible without
causing later failures (e.g. if the requested data is no longer needed)
(!) - does NOT affect, if read-only properties/functions can change their value.
E.g., if the requested value is no longer needed, then "Expression" and
other "passed in/provided values" may change (reset to default/empty)
* When used in the IDE (Begin/EndUpdate themself shall only be valid in the main thread),
shall
- allow the backend to read "passed in/provided values" from another thread
- allow the backend to set new values from another thread
(I.e., if the IDE (or any non-backend code) makes changes, they must
consider thread safety)
// Any "frontend" outside the IDE (commandline / dbg-server) doens not
need to consider thread safety, as long as it knows that this in not
required by any of the backends it uses.
*)
procedure BeginUpdate;
procedure EndUpdate;
procedure AddNotification(AnEventType: TWatcheEvaluateEvent; AnEvent: TNotifyEvent);
procedure RemoveNotification(AnEventType: TWatcheEvaluateEvent; AnEvent: TNotifyEvent);
function ResData: TLzDbgWatchDataIntf;
(* ***** Methods for the front-end to provide the request ***** *)
@ -248,7 +256,7 @@ type
procedure SetValidity(AValue: TDebuggerDataState);
procedure SetValue(AValue: String);
property DisplayFormat: TWatchDisplayFormat read GetDisplayFormat;
property DisplayFormat: TWatchDisplayFormat read GetDisplayFormat; // deprecated
property EvaluateFlags: TWatcheEvaluateFlags read GetEvaluateFlags;
property FirstIndexOffs: Int64 read GetFirstIndexOffs;
property RepeatCount: Integer read GetRepeatCount;

View File

@ -25,6 +25,41 @@ uses
type
{ TDbgDataRequestTemplateBase }
generic TDbgDataRequestTemplateBase<_BASE: TObject; _SENDER_INTF: TDbgDataRequestIntf> = class(_BASE)
private type
TDbgDataRequestEventList = specialize TFPGList<TDbgDataRequestEvent>;
private
FEventLists: array [TDbgDataRequestEventType] of TDbgDataRequestEventList;
protected
procedure AddNotification(AnEventType: TDbgDataRequestEventType; AnEvent: TDbgDataRequestEvent);
procedure RemoveNotification(AnEventType: TDbgDataRequestEventType; AnEvent: TDbgDataRequestEvent);
procedure CallNotifications(AnEventType: TDbgDataRequestEventType; AnEventData: TDbgDataRequestEventData);
procedure BeginUpdate; virtual;
procedure EndUpdate; virtual;
procedure DoDestroy; // FPC can not compile "destructor Destroy; override;"
end;
{ TDbgDataRequestTemplate }
generic TDbgDataRequestTemplate<_BASE: TObject; _SENDER_INTF: TDbgDataRequestIntf>
= class(specialize TDbgDataRequestTemplateBase<_BASE, _SENDER_INTF>, TDbgDataRequestIntf)
private type
TNotifyEventList = specialize TFPGList<TNotifyEvent>;
private
FFreeNotifyList: TNotifyEventList;
protected
procedure AddFreeNotification(ANotification: TNotifyEvent);
procedure RemoveFreeNotification(ANotification: TNotifyEvent);
procedure CallFreeNotifications;
procedure DoDestroy; // FPC can not compile "destructor Destroy; override;"
end;
{ TInternalDbgMonitorBase }
generic TInternalDbgMonitorBase<
@ -94,6 +129,93 @@ type
implementation
{ TDbgDataRequestTemplateBase }
procedure TDbgDataRequestTemplateBase.AddNotification(
AnEventType: TDbgDataRequestEventType; AnEvent: TDbgDataRequestEvent);
begin
if FEventLists[AnEventType] = nil then
FEventLists[AnEventType] := TDbgDataRequestEventList.Create;
FEventLists[AnEventType].Add(AnEvent);
end;
procedure TDbgDataRequestTemplateBase.RemoveNotification(
AnEventType: TDbgDataRequestEventType; AnEvent: TDbgDataRequestEvent);
begin
if FEventLists[AnEventType] = nil then
exit;
FEventLists[AnEventType].Remove(AnEvent);
end;
procedure TDbgDataRequestTemplateBase.CallNotifications(
AnEventType: TDbgDataRequestEventType; AnEventData: TDbgDataRequestEventData);
var
i: integer;
begin
if FEventLists[AnEventType] = nil then
exit;
for i := FEventLists[AnEventType].Count - 1 downto 0 do
FEventLists[AnEventType][i](Self as _SENDER_INTF, AnEventData)
end;
procedure TDbgDataRequestTemplateBase.BeginUpdate;
begin
//
end;
procedure TDbgDataRequestTemplateBase.EndUpdate;
begin
//
end;
procedure TDbgDataRequestTemplateBase.DoDestroy;
var
i: TDbgDataRequestEventType;
begin
for i := low(TDbgDataRequestEventType) to high(TDbgDataRequestEventType) do
FEventLists[i].Free;
end;
{ TDbgDataRequestTemplate }
procedure TDbgDataRequestTemplate.AddFreeNotification(
ANotification: TNotifyEvent);
begin
if FFreeNotifyList = nil then
FFreeNotifyList := TNotifyEventList.Create;
FFreeNotifyList.Add(ANotification);
end;
procedure TDbgDataRequestTemplate.RemoveFreeNotification(
ANotification: TNotifyEvent);
begin
if FFreeNotifyList = nil then
exit;
FFreeNotifyList.Remove(ANotification);
end;
procedure TDbgDataRequestTemplate.CallFreeNotifications;
var
i: integer;
begin
if FFreeNotifyList = nil then
exit;
for i := FFreeNotifyList.Count - 1 downto 0 do
FFreeNotifyList[i](nil)
end;
procedure TDbgDataRequestTemplate.DoDestroy;
begin
FFreeNotifyList.Free;
inherited DoDestroy;
end;
{ TInternalDbgMonitorBase }
procedure TInternalDbgMonitorBase.SetSupplier(ASupplier: _SUPPLIER_INTF);

View File

@ -7,7 +7,7 @@ interface
uses
Classes, SysUtils, DbgIntfDebuggerBase, IdeDebuggerBase, Debugger,
IdeDebuggerWatchResult, LazDebuggerIntf, LazDebuggerIntfBaseTypes,
LazDebuggerValueConverter;
LazDebuggerValueConverter, LazDebuggerTemplate;
type
@ -78,18 +78,14 @@ type
{ TTestWatchValue }
TTestWatchValue = class(TWatchValue, TWatchValueIntf)
TTestWatchValue = class(specialize TDbgDataRequestTemplateBase<TWatchValue, TWatchValueIntf>, TWatchValueIntf)
private
FCurrentResData: TCurrentResData;
FUpdateCount: Integer;
protected
(* TWatchValueIntf *)
procedure BeginUpdate;
procedure EndUpdate;
procedure AddNotification(AnEventType: TWatcheEvaluateEvent;
AnEvent: TNotifyEvent);
procedure RemoveNotification(AnEventType: TWatcheEvaluateEvent;
AnEvent: TNotifyEvent);
procedure BeginUpdate; reintroduce;
procedure EndUpdate; reintroduce;
function ResData: TLzDbgWatchDataIntf;
function GetDbgValConverter: TLazDbgValueConvertSelectorIntf;
protected
@ -104,6 +100,7 @@ type
const AStackFrame: Integer
);
constructor Create(AOwnerWatch: TWatch); override;
destructor Destroy;
end;
{ TTestWatchValueList }
@ -410,18 +407,6 @@ begin
ReleaseReference; // Last statemnet, may call Destroy
end;
procedure TTestWatchValue.AddNotification(AnEventType: TWatcheEvaluateEvent;
AnEvent: TNotifyEvent);
begin
//
end;
procedure TTestWatchValue.RemoveNotification(AnEventType: TWatcheEvaluateEvent;
AnEvent: TNotifyEvent);
begin
//
end;
function TTestWatchValue.ResData: TLzDbgWatchDataIntf;
begin
if FCurrentResData = nil then
@ -521,6 +506,12 @@ begin
FRepeatCount := Watch.RepeatCount;
end;
destructor TTestWatchValue.Destroy;
begin
inherited Destroy;
DoDestroy;
end;
{ TTestWatchValueList }
function TTestWatchValueList.CreateEntry(const AThreadId: Integer;

View File

@ -44,8 +44,9 @@ uses
LazClasses, Maps, LazMethodList,
// DebuggerIntf
DbgIntfBaseTypes, DbgIntfMiscClasses, DbgIntfDebuggerBase, LazDebuggerIntf,
LazDebuggerIntfBaseTypes, LazDebuggerValueConverter, IdeDebuggerBase,
IdeDebuggerWatchResult, IdeDebuggerOpts, IdeDebuggerBackendValueConv;
LazDebuggerIntfBaseTypes, LazDebuggerValueConverter, LazDebuggerTemplate,
IdeDebuggerBase, IdeDebuggerWatchResult, IdeDebuggerOpts,
IdeDebuggerBackendValueConv;
const
XMLBreakPointsNode = 'BreakPoints';
@ -748,19 +749,16 @@ type
{ TCurrentWatchValue }
TCurrentWatchValue = class(TIdeWatchValue, TWatchValueIntf)
TCurrentWatchValue = class(specialize TDbgDataRequestTemplateBase<TIdeWatchValue, TWatchValueIntf>, TWatchValueIntf)
private
FCurrentResData: TCurrentResData;
FCurrentBackEndExpression: String;
FUpdateCount: Integer;
FEvents: array [TWatcheEvaluateEvent] of TMethodList;
FDbgBackendConverter: TIdeDbgValueConvertSelector;
(* TWatchValueIntf *)
procedure BeginUpdate;
procedure EndUpdate;
procedure AddNotification(AnEventType: TWatcheEvaluateEvent; AnEvent: TNotifyEvent);
procedure RemoveNotification(AnEventType: TWatcheEvaluateEvent; AnEvent: TNotifyEvent);
procedure BeginUpdate; reintroduce;
procedure EndUpdate; reintroduce;
function ResData: TLzDbgWatchDataIntf;
function GetDbgValConverter: TLazDbgValueConvertSelectorIntf;
private
@ -3978,22 +3976,6 @@ begin
ReleaseReference; // Last statemnet, may call Destroy
end;
procedure TCurrentWatchValue.AddNotification(AnEventType: TWatcheEvaluateEvent;
AnEvent: TNotifyEvent);
begin
if FEvents[AnEventType] = nil then
FEvents[AnEventType] := TMethodList.Create;
FEvents[AnEventType].Add(TMethod(AnEvent));
end;
procedure TCurrentWatchValue.RemoveNotification(
AnEventType: TWatcheEvaluateEvent; AnEvent: TNotifyEvent);
begin
if FEvents[AnEventType] = nil then
exit;
FEvents[AnEventType].Remove(TMethod(AnEvent));
end;
function TCurrentWatchValue.ResData: TLzDbgWatchDataIntf;
begin
assert(FUpdateCount > 0, 'TCurrentWatchValue.ResData: FUpdateCount > 0');
@ -4060,8 +4042,7 @@ end;
procedure TCurrentWatchValue.CancelRequestData;
begin
if FEvents[weeCancel] <> nil then
FEvents[weeCancel].CallNotifyEvents(Self);
CallNotifications(weeCancel, default(TDbgDataRequestEventData));
end;
procedure TCurrentWatchValue.DoDataValidityChanged(AnOldValidity: TDebuggerDataState);
@ -4087,8 +4068,7 @@ begin
if (FCurrentResData <> nil) and (FResultData = nil) then
FCurrentResData.FreeResultAndSubData;
FCurrentResData.Free;
for e in FEvents do
e.Free;
DoDestroy;
FDbgBackendConverter.Free;
inherited Destroy;
end;