mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-20 17:08:40 +02:00
850 lines
22 KiB
ObjectPascal
850 lines
22 KiB
ObjectPascal
unit IdeDebuggerBase;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, LazClasses, LazLoggerBase, IdeDebuggerWatchResult,
|
|
IdeDebuggerFpDbgValueConv, IdeDebuggerWatchResultJSon, DbgIntfDebuggerBase,
|
|
DbgIntfMiscClasses, LazDebuggerIntf, LazDebuggerTemplate,
|
|
LazDebuggerIntfBaseTypes, LazDebuggerValueConverter, FpDebugConvDebugForJson;
|
|
|
|
type
|
|
|
|
TWatch = class;
|
|
|
|
{ TWatchValue }
|
|
|
|
TWatchValue = class(TRefCountedObject)
|
|
private
|
|
protected
|
|
FWatch: TWatch;
|
|
FTypeInfo: TDBGType;
|
|
FValidity: TDebuggerDataState;
|
|
FResultData: TWatchResultData;
|
|
FResultDataSpecialised: TWatchResultData;
|
|
FResultDataContent: (rdcNotAnalysed, rdcNotSpecial, rdcJSon);
|
|
|
|
procedure SetWatch(AValue: TWatch); virtual;
|
|
function GetDisplayFormat: TWatchDisplayFormat;
|
|
function GetEvaluateFlags: TWatcheEvaluateFlags;
|
|
function GetFirstIndexOffs: Int64;
|
|
function GetRepeatCount: Integer;
|
|
function GetStackFrame: Integer;
|
|
function GetThreadId: Integer;
|
|
function GetValidity: TDebuggerDataState; virtual;
|
|
procedure SetValidity(AValue: TDebuggerDataState); virtual;
|
|
procedure SetValue(AValue: String); virtual;
|
|
procedure SetTypeInfo(AValue: TDBGType);
|
|
procedure SetTypeInfo(AValue: TDBGTypeBase);
|
|
|
|
function GetResultData: TWatchResultData; virtual;
|
|
procedure SetResultData(AResultData: TWatchResultData);
|
|
protected
|
|
FDisplayFormat: TWatchDisplayFormat;
|
|
FEvaluateFlags: TWatcheEvaluateFlags;
|
|
FRepeatCount: Integer;
|
|
FFirstIndexOffs: Int64;
|
|
FStackFrame: Integer;
|
|
FThreadId: Integer;
|
|
procedure DoDataValidityChanged({%H-}AnOldValidity: TDebuggerDataState); virtual;
|
|
|
|
function GetExpression: String; virtual;
|
|
function GetBackendExpression: String;
|
|
function GetFrontendExpressionSuffix: String;
|
|
function GetTypeInfo: TDBGType; virtual;
|
|
function GetValue: String; virtual;
|
|
public
|
|
constructor Create(AOwnerWatch: TWatch); virtual;
|
|
destructor Destroy; override;
|
|
procedure Assign(AnOther: TWatchValue); virtual;
|
|
procedure ClearDisplayData; // keep only what's needed for the snapshot
|
|
property DisplayFormat: TWatchDisplayFormat read GetDisplayFormat;
|
|
property EvaluateFlags: TWatcheEvaluateFlags read GetEvaluateFlags;
|
|
property FirstIndexOffs: Int64 read GetFirstIndexOffs;
|
|
property RepeatCount: Integer read GetRepeatCount;
|
|
property ThreadId: Integer read GetThreadId;
|
|
property StackFrame: Integer read GetStackFrame;
|
|
property Expression: String read GetExpression;
|
|
public
|
|
property Watch: TWatch read FWatch write SetWatch;
|
|
property Validity: TDebuggerDataState read GetValidity write SetValidity;
|
|
property Value: String read GetValue write SetValue;
|
|
property TypeInfo: TDBGType read GetTypeInfo write SetTypeInfo;
|
|
property ResultData: TWatchResultData read GetResultData;
|
|
end;
|
|
TWatchValueClass = class of TWatchValue;
|
|
|
|
{ TWatchValueList }
|
|
|
|
TWatchValueList = class
|
|
private
|
|
FList: TList;
|
|
FWatch: TWatch;
|
|
function GetEntry(const AThreadId: Integer; const AStackFrame: Integer): TWatchValue;
|
|
function GetEntryByIdx(AnIndex: integer): TWatchValue;
|
|
function GetExistingEntry(const AThreadId: Integer;
|
|
const AStackFrame: Integer): TWatchValue;
|
|
protected
|
|
function CreateEntry(const {%H-}AThreadId: Integer; const {%H-}AStackFrame: Integer): TWatchValue; virtual;
|
|
function CopyEntry(AnEntry: TWatchValue): TWatchValue;
|
|
public
|
|
procedure Assign(AnOther: TWatchValueList);
|
|
constructor Create(AOwnerWatch: TWatch);
|
|
destructor Destroy; override;
|
|
procedure Add(AnEntry: TWatchValue);
|
|
function GetEntriesForRange(const AThreadId: Integer; const AStackFrame: Integer;
|
|
const AFirstIndexOffs: Int64; const ARepeatCount: Integer): TWatchValue;
|
|
procedure ClearRangeEntries(AKeepMostRecentCount: integer = 0);
|
|
procedure Clear; virtual;
|
|
procedure ClearDisplayData; // keep only what's needed for the snapshot
|
|
function Count: Integer;
|
|
property EntriesByIdx[AnIndex: integer]: TWatchValue read GetEntryByIdx;
|
|
property Entries[const AThreadId: Integer; const AStackFrame: Integer]: TWatchValue
|
|
read GetEntry; default;
|
|
property ExistingEntries[const AThreadId: Integer; const AStackFrame: Integer]: TWatchValue
|
|
read GetExistingEntry;
|
|
property Watch: TWatch read FWatch;
|
|
end;
|
|
|
|
{ TWatch }
|
|
|
|
TWatch = class(TDelayedUdateItem)
|
|
private
|
|
FFirstIndexOffs: Int64;
|
|
FFpDbgConverter: TIdeDbgValueConvertSelector;
|
|
|
|
procedure FFpDbgConverterFreed(Sender: TObject);
|
|
procedure SetDisplayFormat(AValue: TWatchDisplayFormat);
|
|
procedure SetEnabled(AValue: Boolean);
|
|
procedure SetEvaluateFlags(AValue: TWatcheEvaluateFlags);
|
|
procedure SetExpression(AValue: String);
|
|
procedure SetFirstIndexOffs(AValue: Int64);
|
|
procedure SetFpDbgConverter(AValue: TIdeDbgValueConvertSelector);
|
|
procedure SetRepeatCount(AValue: Integer);
|
|
function GetValue(const AThreadId: Integer; const AStackFrame: Integer): TWatchValue;
|
|
protected
|
|
FEnabled: Boolean;
|
|
FEvaluateFlags: TWatcheEvaluateFlags;
|
|
FExpression: String;
|
|
FDisplayFormat: TWatchDisplayFormat;
|
|
FRepeatCount: Integer;
|
|
FValueList: TWatchValueList;
|
|
|
|
procedure DoModified; virtual; // user-storable data: expression, enabled, display-format
|
|
procedure DoEnableChange; virtual;
|
|
procedure DoExpressionChange; virtual;
|
|
procedure DoDisplayFormatChanged; virtual;
|
|
procedure AssignTo(Dest: TPersistent); override;
|
|
function CreateValueList: TWatchValueList; virtual;
|
|
|
|
function GetBackendExpression: String;
|
|
function GetFrontendExpressionSuffix: String;
|
|
public
|
|
constructor Create(ACollection: TCollection); override;
|
|
destructor Destroy; override;
|
|
procedure ClearValues; virtual;
|
|
procedure ClearDisplayData; // keep only what's needed for the snapshot
|
|
public
|
|
property Enabled: Boolean read FEnabled write SetEnabled;
|
|
property Expression: String read FExpression write SetExpression;
|
|
property DisplayFormat: TWatchDisplayFormat read FDisplayFormat write SetDisplayFormat;
|
|
property EvaluateFlags: TWatcheEvaluateFlags read FEvaluateFlags write SetEvaluateFlags;
|
|
property FirstIndexOffs: Int64 read FFirstIndexOffs write SetFirstIndexOffs;
|
|
property RepeatCount: Integer read FRepeatCount write SetRepeatCount;
|
|
property FpDbgConverter: TIdeDbgValueConvertSelector read FFpDbgConverter write SetFpDbgConverter;
|
|
property Values[const AThreadId: Integer; const AStackFrame: Integer]: TWatchValue
|
|
read GetValue;
|
|
property ValueList: TWatchValueList read FValueList;
|
|
end;
|
|
TWatchClass = class of TWatch;
|
|
|
|
{ TWatches }
|
|
|
|
TWatches = class(TCollection)
|
|
protected
|
|
function GetItemBase(const AnIndex: Integer): TWatch;
|
|
procedure SetItemBase(const AnIndex: Integer; const AValue: TWatch);
|
|
function WatchClass: TWatchClass; virtual;
|
|
public
|
|
constructor Create;
|
|
procedure ClearValues;
|
|
function Find(const AExpression: String): TWatch;
|
|
property Items[const AnIndex: Integer]: TWatch read GetItemBase write SetItemBase; default;
|
|
end;
|
|
|
|
{ TWatchesMonitor }
|
|
|
|
TWatchesMonitor = class(specialize TWatchesMonitorClassTemplate<TDebuggerDataHandler>, TWatchesMonitorIntf)
|
|
protected
|
|
procedure DoStateChange(const AOldState, ANewState: TDBGState); reintroduce;
|
|
|
|
// from TDebuggerDataMonitor
|
|
procedure DoModified; virtual; // user-modified / xml-storable data modified
|
|
public
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
implementation
|
|
|
|
var
|
|
DBG_DATA_MONITORS: PLazLoggerLogGroup;
|
|
|
|
{ TWatchValue }
|
|
|
|
procedure TWatchValue.SetValidity(AValue: TDebuggerDataState);
|
|
var
|
|
OldValidity: TDebuggerDataState;
|
|
begin
|
|
if FValidity = AValue then exit;
|
|
//DebugLn(DBG_DATA_MONITORS, ['DebugDataMonitor: TWatchValue.SetValidity: FThreadId=', FThreadId, ' FStackFrame=',FStackFrame, ' Expr=', Expression, ' AValidity=',dbgs(AValue)]);
|
|
DebugLn(DBG_DATA_MONITORS, ['DebugDataMonitor: TWatchValue.SetValidity: Expr=', Expression, ' AValidity=',dbgs(AValue)]);
|
|
OldValidity := FValidity;
|
|
FValidity := AValue;
|
|
DoDataValidityChanged(OldValidity);
|
|
end;
|
|
|
|
function TWatchValue.GetValidity: TDebuggerDataState;
|
|
begin
|
|
Result := FValidity;
|
|
end;
|
|
|
|
function TWatchValue.GetStackFrame: Integer;
|
|
begin
|
|
Result := FStackFrame;
|
|
end;
|
|
|
|
function TWatchValue.GetEvaluateFlags: TWatcheEvaluateFlags;
|
|
begin
|
|
Result := FEvaluateFlags;
|
|
end;
|
|
|
|
function TWatchValue.GetResultData: TWatchResultData;
|
|
function IsMaybeJson(const s: String): boolean;
|
|
var
|
|
l: SizeInt;
|
|
i: Integer;
|
|
begin
|
|
Result := False;
|
|
l := Length(s);
|
|
if l = 0 then
|
|
exit;
|
|
|
|
while (l > 1) and (s[l] in [' ', #9, #10, #13]) do
|
|
dec(l);
|
|
if not(s[l] in [']', '}']) then
|
|
exit;
|
|
|
|
i := 1;
|
|
while (i < l) and (s[i] in [' ', #9, #10, #13]) do
|
|
inc(i);
|
|
if not(s[i] in ['[', '{']) then
|
|
exit;
|
|
|
|
Result := True;
|
|
end;
|
|
|
|
var
|
|
UsedConv: TLazDbgValueConverterIntf;
|
|
SrcData: TWatchResultData;
|
|
|
|
function CreateJson: TWatchResultDataJSon;
|
|
begin
|
|
Result := TWatchResultDataJSon.Create(SrcData.AsString);
|
|
Result.SetTypeName(SrcData.TypeName);
|
|
if SrcData.HasDataAddress then
|
|
Result.SetDataAddress(SrcData.DataAddress);
|
|
if (Result.Count > 0) or (Result.FieldCount > 0) then
|
|
FResultDataContent := rdcJSon;
|
|
if (UsedConv <> nil) and (UsedConv.GetObject is TFpDbgValueConverterJsonForDebug)
|
|
then begin
|
|
Result.JsonAddressKey := TFpDbgValueConverterJsonForDebug(UsedConv.GetObject).JsonAddressKey;
|
|
Result.JsonTypenameKey := TFpDbgValueConverterJsonForDebug(UsedConv.GetObject).JsonTypenameKey;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if FResultDataSpecialised <> nil then begin
|
|
Result := FResultDataSpecialised;
|
|
exit;
|
|
end;
|
|
|
|
Result := FResultData;
|
|
if (FResultDataContent = rdcNotSpecial) or (Result = nil) then
|
|
exit;
|
|
|
|
SrcData := FResultData;
|
|
UsedConv := nil;
|
|
if (SrcData.ValueKind = rdkConvertRes) and (SrcData.FieldCount > 0) and
|
|
(SrcData.Fields[0].Field <> nil) and
|
|
(SrcData.Fields[0].Field.ValueKind <> rdkError)
|
|
then begin
|
|
SrcData := SrcData.Fields[0].Field;
|
|
UsedConv := FResultData.BackendValueHandler;
|
|
end;
|
|
|
|
case FResultDataContent of
|
|
rdcJSon: begin
|
|
FResultDataSpecialised := CreateJson;
|
|
end;
|
|
|
|
else begin
|
|
FResultDataContent := rdcNotSpecial;
|
|
|
|
if (SrcData.ValueKind in [rdkString, rdkPrePrinted]) and (IsMaybeJson(SrcData.AsString)) then begin
|
|
FResultDataSpecialised := CreateJson;
|
|
end;
|
|
|
|
if FResultDataContent = rdcNotSpecial then
|
|
FResultDataSpecialised := nil;
|
|
end;
|
|
end;
|
|
|
|
Result := FResultData;
|
|
if FResultDataSpecialised <> nil then
|
|
Result := FResultDataSpecialised;
|
|
|
|
Result := Result.HandleExpressionSuffix(GetFrontendExpressionSuffix);
|
|
if (Result <> FResultDataSpecialised) and (Result <> FResultData) then begin
|
|
FResultDataSpecialised.Free;
|
|
FResultDataSpecialised := Result;
|
|
end;
|
|
end;
|
|
|
|
procedure TWatchValue.SetResultData(AResultData: TWatchResultData);
|
|
begin
|
|
assert(FResultData=nil, 'TWatchValue.SetResultData: FResultData=nil');
|
|
FResultData := AResultData;
|
|
end;
|
|
|
|
function TWatchValue.GetFirstIndexOffs: Int64;
|
|
begin
|
|
Result := FFirstIndexOffs;
|
|
end;
|
|
|
|
procedure TWatchValue.SetWatch(AValue: TWatch);
|
|
begin
|
|
if FWatch = AValue then Exit;
|
|
FWatch := AValue;
|
|
end;
|
|
|
|
function TWatchValue.GetDisplayFormat: TWatchDisplayFormat;
|
|
begin
|
|
if (FWatch <> nil) and
|
|
(FWatch.FDisplayFormat <> wdfMemDump) and
|
|
(FDisplayFormat <> wdfMemDump) and
|
|
(FResultData <> nil) and
|
|
(FResultData.ValueKind <> rdkPrePrinted)
|
|
then
|
|
Result := FWatch.DisplayFormat
|
|
else
|
|
Result := FDisplayFormat;
|
|
end;
|
|
|
|
function TWatchValue.GetRepeatCount: Integer;
|
|
begin
|
|
Result := FRepeatCount;
|
|
end;
|
|
|
|
function TWatchValue.GetThreadId: Integer;
|
|
begin
|
|
Result := FThreadId;
|
|
end;
|
|
|
|
procedure TWatchValue.SetValue(AValue: String);
|
|
begin
|
|
assert(False, 'TWatchValue.SetValue: False');
|
|
end;
|
|
|
|
procedure TWatchValue.SetTypeInfo(AValue: TDBGType);
|
|
begin
|
|
//assert(Self is TCurrentWatchValue, 'TWatchValue.SetTypeInfo');
|
|
FreeAndNil(FTypeInfo);
|
|
FTypeInfo := AValue;
|
|
end;
|
|
|
|
procedure TWatchValue.SetTypeInfo(AValue: TDBGTypeBase);
|
|
begin
|
|
SetTypeInfo(TDBGType(AValue));
|
|
end;
|
|
|
|
procedure TWatchValue.DoDataValidityChanged(AnOldValidity: TDebuggerDataState);
|
|
begin
|
|
//
|
|
end;
|
|
|
|
function TWatchValue.GetExpression: String;
|
|
begin
|
|
Result := '';
|
|
if FWatch <> nil then
|
|
Result := FWatch.Expression;
|
|
end;
|
|
|
|
function TWatchValue.GetBackendExpression: String;
|
|
begin
|
|
Result := '';
|
|
if FWatch <> nil then
|
|
Result := FWatch.GetBackendExpression;
|
|
end;
|
|
|
|
function TWatchValue.GetFrontendExpressionSuffix: String;
|
|
begin
|
|
Result := '';
|
|
if FWatch <> nil then
|
|
Result := FWatch.GetFrontendExpressionSuffix;
|
|
end;
|
|
|
|
function TWatchValue.GetTypeInfo: TDBGType;
|
|
begin
|
|
Result := FTypeInfo;
|
|
end;
|
|
|
|
function TWatchValue.GetValue: String;
|
|
var
|
|
rd: TWatchResultData;
|
|
begin
|
|
rd := ResultData;
|
|
if rd <> nil then
|
|
Result := rd.AsString
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
constructor TWatchValue.Create(AOwnerWatch: TWatch);
|
|
begin
|
|
FWatch := AOwnerWatch;
|
|
inherited Create;
|
|
AddReference;
|
|
end;
|
|
|
|
destructor TWatchValue.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
FreeAndNil(FTypeInfo);
|
|
FreeAndNil(FResultData);
|
|
FreeAndNil(FResultDataSpecialised);
|
|
end;
|
|
|
|
procedure TWatchValue.Assign(AnOther: TWatchValue);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
FreeAndNil(FTypeInfo);
|
|
if AnOther.FTypeInfo <> nil then begin
|
|
// partial assign
|
|
FTypeInfo := TDBGType.Create(AnOther.FTypeInfo.Kind, AnOther.FTypeInfo.TypeName);
|
|
for i := 0 to AnOther.FTypeInfo.Fields.Count - 1 do
|
|
FTypeInfo.Fields.Add(AnOther.FTypeInfo.Fields.Items[i]);
|
|
end;
|
|
FValidity := AnOther.FValidity;
|
|
FResultData.Free;
|
|
FResultData := AnOther.FResultData.CreateCopy;
|
|
end;
|
|
|
|
procedure TWatchValue.ClearDisplayData;
|
|
begin
|
|
FreeAndNil(FResultDataSpecialised);
|
|
end;
|
|
|
|
{ TWatch }
|
|
|
|
procedure TWatch.SetDisplayFormat(AValue: TWatchDisplayFormat);
|
|
begin
|
|
if AValue = FDisplayFormat then exit;
|
|
FDisplayFormat := AValue;
|
|
DoDisplayFormatChanged;
|
|
end;
|
|
|
|
procedure TWatch.FFpDbgConverterFreed(Sender: TObject);
|
|
begin
|
|
FFpDbgConverter := nil;
|
|
|
|
Changed;
|
|
DoModified;
|
|
end;
|
|
|
|
procedure TWatch.SetEnabled(AValue: Boolean);
|
|
begin
|
|
if FEnabled <> AValue
|
|
then begin
|
|
FEnabled := AValue;
|
|
DoEnableChange;
|
|
end;
|
|
end;
|
|
|
|
procedure TWatch.SetEvaluateFlags(AValue: TWatcheEvaluateFlags);
|
|
begin
|
|
if FEvaluateFlags = AValue then Exit;
|
|
FEvaluateFlags := AValue;
|
|
Changed;
|
|
DoModified;
|
|
end;
|
|
|
|
procedure TWatch.SetExpression(AValue: String);
|
|
begin
|
|
if AValue <> FExpression
|
|
then begin
|
|
FExpression := AValue;
|
|
FValueList.Clear;
|
|
DoExpressionChange;
|
|
end;
|
|
end;
|
|
|
|
procedure TWatch.SetFirstIndexOffs(AValue: Int64);
|
|
begin
|
|
if FFirstIndexOffs = AValue then Exit;
|
|
FFirstIndexOffs := AValue;
|
|
//FValueList.Clear;
|
|
Changed;
|
|
DoModified;
|
|
end;
|
|
|
|
procedure TWatch.SetFpDbgConverter(AValue: TIdeDbgValueConvertSelector);
|
|
begin
|
|
if FFpDbgConverter = AValue then Exit;
|
|
FValueList.Clear;
|
|
|
|
if FFpDbgConverter <> nil then
|
|
FFpDbgConverter.RemoveFreeNotification(@FFpDbgConverterFreed);
|
|
|
|
FFpDbgConverter := AValue;
|
|
|
|
if FFpDbgConverter <> nil then
|
|
FFpDbgConverter.AddFreeNotification(@FFpDbgConverterFreed);
|
|
|
|
Changed;
|
|
DoModified;
|
|
end;
|
|
|
|
procedure TWatch.SetRepeatCount(AValue: Integer);
|
|
begin
|
|
if FRepeatCount = AValue then Exit;
|
|
FRepeatCount := AValue;
|
|
|
|
Changed;
|
|
DoModified;
|
|
end;
|
|
|
|
function TWatch.GetValue(const AThreadId: Integer;
|
|
const AStackFrame: Integer): TWatchValue;
|
|
begin
|
|
Result := FValueList[AThreadId, AStackFrame];
|
|
end;
|
|
|
|
procedure TWatch.DoModified;
|
|
begin
|
|
//
|
|
end;
|
|
|
|
procedure TWatch.DoEnableChange;
|
|
begin
|
|
//
|
|
end;
|
|
|
|
procedure TWatch.DoExpressionChange;
|
|
begin
|
|
//
|
|
end;
|
|
|
|
procedure TWatch.DoDisplayFormatChanged;
|
|
begin
|
|
//
|
|
end;
|
|
|
|
procedure TWatch.AssignTo(Dest: TPersistent);
|
|
begin
|
|
if Dest is TWatch
|
|
then begin
|
|
TWatch(Dest).FExpression := FExpression;
|
|
TWatch(Dest).FEnabled := FEnabled;
|
|
TWatch(Dest).FDisplayFormat := FDisplayFormat;
|
|
TWatch(Dest).FFirstIndexOffs := FFirstIndexOffs;
|
|
TWatch(Dest).FRepeatCount := FRepeatCount;
|
|
TWatch(Dest).FEvaluateFlags := FEvaluateFlags;
|
|
TWatch(Dest).FpDbgConverter := FpDbgConverter;
|
|
TWatch(Dest).FValueList.Assign(FValueList);
|
|
end
|
|
else inherited;
|
|
end;
|
|
|
|
function TWatch.CreateValueList: TWatchValueList;
|
|
begin
|
|
Result := TWatchValueList.Create(Self);
|
|
end;
|
|
|
|
function TWatch.GetBackendExpression: String;
|
|
var
|
|
i, l: Integer;
|
|
InQuote: Boolean;
|
|
begin
|
|
Result := Expression;
|
|
l := Length(Result);
|
|
if l = 0 then
|
|
exit;
|
|
|
|
while (l > 0) and (Result[l] in [' ', #9])
|
|
do dec(l);
|
|
|
|
if Result[l] <> '}' then
|
|
exit;
|
|
|
|
i := 1;
|
|
InQuote := False;
|
|
while i < l do begin
|
|
if Result[i] = '''' then
|
|
InQuote := not InQuote;
|
|
if (not InQuote) and (Result[i] = '{') then
|
|
exit(copy(Result, 1 , i-1));
|
|
inc(i);
|
|
end;
|
|
end;
|
|
|
|
function TWatch.GetFrontendExpressionSuffix: String;
|
|
var
|
|
l: SizeInt;
|
|
begin
|
|
Result := Expression;
|
|
l := Length(GetBackendExpression);
|
|
Result := copy(Result, 1 + l, Length(Result));
|
|
end;
|
|
|
|
constructor TWatch.Create(ACollection: TCollection);
|
|
begin
|
|
FEnabled := False;
|
|
FValueList := CreateValueList;
|
|
inherited Create(ACollection);
|
|
end;
|
|
|
|
destructor TWatch.Destroy;
|
|
begin
|
|
if FFpDbgConverter <> nil then
|
|
FFpDbgConverter.RemoveFreeNotification(@FFpDbgConverterFreed);
|
|
|
|
FValueList.Clear;
|
|
inherited Destroy;
|
|
FreeAndNil(FValueList);
|
|
end;
|
|
|
|
procedure TWatch.ClearValues;
|
|
begin
|
|
FValueList.Clear;
|
|
end;
|
|
|
|
procedure TWatch.ClearDisplayData;
|
|
begin
|
|
FValueList.ClearDisplayData;
|
|
end;
|
|
|
|
{ TWatches }
|
|
|
|
function TWatches.GetItemBase(const AnIndex: Integer): TWatch;
|
|
begin
|
|
Result := TWatch(inherited Items[AnIndex]);
|
|
end;
|
|
|
|
procedure TWatches.SetItemBase(const AnIndex: Integer; const AValue: TWatch);
|
|
begin
|
|
inherited Items[AnIndex] := AValue;
|
|
end;
|
|
|
|
function TWatches.WatchClass: TWatchClass;
|
|
begin
|
|
Result := TWatch;
|
|
end;
|
|
|
|
constructor TWatches.Create;
|
|
begin
|
|
inherited Create(WatchClass);
|
|
end;
|
|
|
|
procedure TWatches.ClearValues;
|
|
var
|
|
n: Integer;
|
|
begin
|
|
for n := 0 to Count - 1 do
|
|
Items[n].ClearValues;
|
|
end;
|
|
|
|
function TWatches.Find(const AExpression: String): TWatch;
|
|
var
|
|
n: Integer;
|
|
begin
|
|
for n := 0 to Count - 1 do
|
|
begin
|
|
Result := TWatch(GetItem(n));
|
|
if CompareText(Result.Expression, AExpression) = 0 then Exit;
|
|
end;
|
|
Result := nil;
|
|
end;
|
|
|
|
{ TWatchValueList }
|
|
|
|
function TWatchValueList.GetEntry(const AThreadId: Integer;
|
|
const AStackFrame: Integer): TWatchValue;
|
|
begin
|
|
Result := GetExistingEntry(AThreadId, AStackFrame);
|
|
if Result = nil then
|
|
Result := CreateEntry(AThreadId, AStackFrame);
|
|
end;
|
|
|
|
function TWatchValueList.GetEntriesForRange(const AThreadId: Integer;
|
|
const AStackFrame: Integer; const AFirstIndexOffs: Int64;
|
|
const ARepeatCount: Integer): TWatchValue;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
i := FList.Count - 1;
|
|
while i >= 0 do begin
|
|
Result := TWatchValue(FList[i]);
|
|
if (Result.ThreadId = AThreadId) and (Result.StackFrame = AStackFrame) and
|
|
(Result.DisplayFormat = FWatch.DisplayFormat) and
|
|
(Result.EvaluateFlags = FWatch.EvaluateFlags) and
|
|
(Result.FFirstIndexOffs <= AFirstIndexOffs) and
|
|
(Result.FFirstIndexOffs + Result.FRepeatCount > AFirstIndexOffs) and
|
|
(Result.FRepeatCount >= ARepeatCount + (AFirstIndexOffs - Result.FFirstIndexOffs))
|
|
then
|
|
exit;
|
|
dec(i);
|
|
end;
|
|
Result := CreateEntry(AThreadId, AStackFrame); // XXXXXXXXXXXXX No Snapshot
|
|
Result.FFirstIndexOffs := AFirstIndexOffs;
|
|
Result.FRepeatCount := ARepeatCount;
|
|
end;
|
|
|
|
procedure TWatchValueList.ClearRangeEntries(AKeepMostRecentCount: integer);
|
|
var
|
|
Val: TWatchValue;
|
|
i, FirstIdx, RCnt: Integer;
|
|
begin
|
|
i := FList.Count - 1;
|
|
FirstIdx := Watch.FirstIndexOffs;
|
|
RCnt := Watch.RepeatCount;
|
|
while i >= 0 do begin
|
|
Val := TWatchValue(FList[i]);
|
|
if (Val.FFirstIndexOffs <> FirstIdx) or (Val.FRepeatCount <> RCnt) then begin
|
|
if AKeepMostRecentCount > 0 then
|
|
dec(AKeepMostRecentCount)
|
|
else
|
|
FList.Delete(i);
|
|
end;
|
|
dec(i);
|
|
end;
|
|
end;
|
|
|
|
function TWatchValueList.GetEntryByIdx(AnIndex: integer): TWatchValue;
|
|
begin
|
|
Result := TWatchValue(FList[AnIndex]);
|
|
end;
|
|
|
|
function TWatchValueList.GetExistingEntry(const AThreadId: Integer;
|
|
const AStackFrame: Integer): TWatchValue;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
i := FList.Count - 1;
|
|
while i >= 0 do begin
|
|
Result := TWatchValue(FList[i]);
|
|
if (Result.ThreadId = AThreadId) and (Result.StackFrame = AStackFrame) and
|
|
(Result.DisplayFormat = FWatch.DisplayFormat) and
|
|
(Result.RepeatCount = FWatch.RepeatCount) and
|
|
(Result.FirstIndexOffs = FWatch.FirstIndexOffs) and
|
|
(Result.EvaluateFlags = FWatch.EvaluateFlags)
|
|
then
|
|
exit;
|
|
dec(i);
|
|
end;
|
|
Result := nil;
|
|
end;
|
|
|
|
function TWatchValueList.CreateEntry(const AThreadId: Integer;
|
|
const AStackFrame: Integer): TWatchValue;
|
|
begin
|
|
Result := nil;
|
|
end;
|
|
|
|
function TWatchValueList.CopyEntry(AnEntry: TWatchValue): TWatchValue;
|
|
begin
|
|
Result := TWatchValueClass(AnEntry.ClassType).Create(FWatch);
|
|
Result.Assign(AnEntry);
|
|
end;
|
|
|
|
procedure TWatchValueList.Assign(AnOther: TWatchValueList);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Clear;
|
|
for i := 0 to AnOther.FList.Count - 1 do begin
|
|
FList.Add(CopyEntry(TWatchValue(AnOther.FList[i])));
|
|
end;
|
|
end;
|
|
|
|
constructor TWatchValueList.Create(AOwnerWatch: TWatch);
|
|
begin
|
|
assert(AOwnerWatch <> nil, 'TWatchValueList.Create without owner');
|
|
FList := TList.Create;
|
|
FWatch := AOwnerWatch;
|
|
inherited Create;
|
|
end;
|
|
|
|
destructor TWatchValueList.Destroy;
|
|
begin
|
|
Clear;
|
|
inherited Destroy;
|
|
FreeAndNil(FList);
|
|
end;
|
|
|
|
procedure TWatchValueList.Add(AnEntry: TWatchValue);
|
|
begin
|
|
Flist.Add(AnEntry);
|
|
end;
|
|
|
|
procedure TWatchValueList.Clear;
|
|
begin
|
|
while FList.Count > 0 do begin
|
|
TWatchValue(FList[0]).Watch := nil;
|
|
TWatchValue(FList[0]).ReleaseReference;
|
|
FList.Delete(0);
|
|
end;
|
|
end;
|
|
|
|
procedure TWatchValueList.ClearDisplayData;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
i := FList.Count - 1;
|
|
while i >= 0 do begin
|
|
TWatchValue(FList[i]).ClearDisplayData;
|
|
dec(i);
|
|
end;
|
|
end;
|
|
|
|
function TWatchValueList.Count: Integer;
|
|
begin
|
|
Result := FList.Count;
|
|
end;
|
|
|
|
{ TWatchesMonitor }
|
|
|
|
procedure TWatchesMonitor.DoStateChange(const AOldState, ANewState: TDBGState);
|
|
begin
|
|
DoStateChangeEx(AOldState, ANewState);
|
|
end;
|
|
|
|
procedure TWatchesMonitor.DoModified;
|
|
begin
|
|
//
|
|
end;
|
|
|
|
destructor TWatchesMonitor.Destroy;
|
|
begin
|
|
DoDestroy;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
initialization
|
|
DBG_DATA_MONITORS := DebugLogger.FindOrRegisterLogGroup('DBG_DATA_MONITORS' {$IFDEF DBG_DATA_MONITORS} , True {$ENDIF} );
|
|
|
|
end.
|
|
|