mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-19 12:29:30 +02:00
LazDebuggerIntf: change event signature, include data / add template
This commit is contained in:
parent
196981e0a7
commit
20bf681e0f
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -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);
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
Loading…
Reference in New Issue
Block a user