mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-10 04:48:36 +02:00
Debugger: refactor
git-svn-id: trunk@44477 -
This commit is contained in:
martin
parent
eeef6684f7
commit
04e4af4d3a
@ -571,22 +571,22 @@ type
|
||||
wdfMemDump
|
||||
);
|
||||
|
||||
TWatchBase = class;
|
||||
TWatch = class;
|
||||
TWatchesMonitor = class;
|
||||
|
||||
{ TWatchValueBase }
|
||||
{ TWatchValue }
|
||||
|
||||
TWatchValue = class(TFreeNotifyingObject)
|
||||
private
|
||||
FTypeInfo: TDBGType;
|
||||
FValue: String;
|
||||
FValidity: TDebuggerDataState;
|
||||
FWatch: TWatchBase;
|
||||
FWatch: TWatch;
|
||||
|
||||
procedure SetValidity(AValue: TDebuggerDataState); virtual;
|
||||
procedure SetValue(AValue: String);
|
||||
procedure SetTypeInfo(AValue: TDBGType);
|
||||
function GetWatch: TWatchBase;
|
||||
function GetWatch: TWatch;
|
||||
protected
|
||||
FDisplayFormat: TWatchDisplayFormat;
|
||||
FEvaluateFlags: TDBGEvaluateFlags;
|
||||
@ -599,7 +599,7 @@ type
|
||||
function GetTypeInfo: TDBGType; virtual;
|
||||
function GetValue: String; virtual;
|
||||
public
|
||||
constructor Create(AOwnerWatch: TWatchBase);
|
||||
constructor Create(AOwnerWatch: TWatch);
|
||||
destructor Destroy; override;
|
||||
procedure Assign(AnOther: TWatchValue); virtual;
|
||||
property DisplayFormat: TWatchDisplayFormat read FDisplayFormat;
|
||||
@ -608,7 +608,7 @@ type
|
||||
property ThreadId: Integer read FThreadId;
|
||||
property StackFrame: Integer read FStackFrame;
|
||||
property Expression: String read GetExpression;
|
||||
property Watch: TWatchBase read GetWatch;
|
||||
property Watch: TWatch read GetWatch;
|
||||
public
|
||||
property Validity: TDebuggerDataState read FValidity write SetValidity;
|
||||
property Value: String read GetValue write SetValue;
|
||||
@ -620,7 +620,7 @@ type
|
||||
TWatchValueList = class
|
||||
private
|
||||
FList: TList;
|
||||
FWatch: TWatchBase;
|
||||
FWatch: TWatch;
|
||||
function GetEntry(const AThreadId: Integer; const AStackFrame: Integer): TWatchValue;
|
||||
function GetEntryByIdx(AnIndex: integer): TWatchValue;
|
||||
protected
|
||||
@ -628,7 +628,7 @@ type
|
||||
function CopyEntry(AnEntry: TWatchValue): TWatchValue; virtual;
|
||||
public
|
||||
procedure Assign(AnOther: TWatchValueList);
|
||||
constructor Create(AOwnerWatch: TWatchBase);
|
||||
constructor Create(AOwnerWatch: TWatch);
|
||||
destructor Destroy; override;
|
||||
procedure Add(AnEntry: TWatchValue);
|
||||
procedure Clear;
|
||||
@ -636,12 +636,12 @@ type
|
||||
property EntriesByIdx[AnIndex: integer]: TWatchValue read GetEntryByIdx;
|
||||
property Entries[const AThreadId: Integer; const AStackFrame: Integer]: TWatchValue
|
||||
read GetEntry; default;
|
||||
property Watch: TWatchBase read FWatch;
|
||||
property Watch: TWatch read FWatch;
|
||||
end;
|
||||
|
||||
{ TWatchBase }
|
||||
{ TWatch }
|
||||
|
||||
TWatchBase = class(TDelayedUdateItem)
|
||||
TWatch = class(TDelayedUdateItem)
|
||||
private
|
||||
|
||||
procedure SetDisplayFormat(AValue: TWatchDisplayFormat);
|
||||
@ -677,20 +677,20 @@ type
|
||||
property Values[const AThreadId: Integer; const AStackFrame: Integer]: TWatchValue
|
||||
read GetValue;
|
||||
end;
|
||||
TBaseWatchClass = class of TWatchBase;
|
||||
TWatchClass = class of TWatch;
|
||||
|
||||
{ TWatches }
|
||||
|
||||
TWatches = class(TCollection)
|
||||
protected
|
||||
function GetItemBase(const AnIndex: Integer): TWatchBase;
|
||||
procedure SetItemBase(const AnIndex: Integer; const AValue: TWatchBase);
|
||||
function WatchClass: TBaseWatchClass; virtual;
|
||||
function GetItemBase(const AnIndex: Integer): TWatch;
|
||||
procedure SetItemBase(const AnIndex: Integer; const AValue: TWatch);
|
||||
function WatchClass: TWatchClass; virtual;
|
||||
public
|
||||
constructor Create;
|
||||
procedure ClearValues; virtual; abstract;
|
||||
function Find(const AExpression: String): TWatchBase; virtual; abstract;
|
||||
property Items[const AnIndex: Integer]: TWatchBase read GetItemBase write SetItemBase; default;
|
||||
procedure ClearValues;
|
||||
function Find(const AExpression: String): TWatch;
|
||||
property Items[const AnIndex: Integer]: TWatch read GetItemBase write SetItemBase; default;
|
||||
end;
|
||||
|
||||
{ TWatchesSupplier }
|
||||
@ -752,7 +752,7 @@ type
|
||||
property Value: String read FValue;
|
||||
end;
|
||||
|
||||
{ TLocalsBase }
|
||||
{ TLocals }
|
||||
|
||||
TLocals = class(TDbgEntityValuesList)
|
||||
private
|
||||
@ -771,7 +771,7 @@ type
|
||||
property Values[const AnIndex: Integer]: String read GetValue;
|
||||
end;
|
||||
|
||||
{ TLocalsListBase }
|
||||
{ TLocalsList }
|
||||
|
||||
TLocalsList = class(TDbgEntitiesThreadStackList)
|
||||
private
|
||||
@ -2313,13 +2313,13 @@ begin
|
||||
Result := FValue;
|
||||
end;
|
||||
|
||||
constructor TWatchValue.Create(AOwnerWatch: TWatchBase);
|
||||
constructor TWatchValue.Create(AOwnerWatch: TWatch);
|
||||
begin
|
||||
FWatch := AOwnerWatch;
|
||||
inherited Create;
|
||||
end;
|
||||
|
||||
function TWatchValue.GetWatch: TWatchBase;
|
||||
function TWatchValue.GetWatch: TWatch;
|
||||
begin
|
||||
Result := FWatch;
|
||||
end;
|
||||
@ -2338,16 +2338,16 @@ begin
|
||||
FValidity := AnOther.FValidity;
|
||||
end;
|
||||
|
||||
{ TWatchBase }
|
||||
{ TWatch }
|
||||
|
||||
procedure TWatchBase.SetDisplayFormat(AValue: TWatchDisplayFormat);
|
||||
procedure TWatch.SetDisplayFormat(AValue: TWatchDisplayFormat);
|
||||
begin
|
||||
if AValue = FDisplayFormat then exit;
|
||||
FDisplayFormat := AValue;
|
||||
DoDisplayFormatChanged;
|
||||
end;
|
||||
|
||||
procedure TWatchBase.SetEnabled(AValue: Boolean);
|
||||
procedure TWatch.SetEnabled(AValue: Boolean);
|
||||
begin
|
||||
if FEnabled <> AValue
|
||||
then begin
|
||||
@ -2356,7 +2356,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TWatchBase.SetEvaluateFlags(AValue: TDBGEvaluateFlags);
|
||||
procedure TWatch.SetEvaluateFlags(AValue: TDBGEvaluateFlags);
|
||||
begin
|
||||
if FEvaluateFlags = AValue then Exit;
|
||||
FEvaluateFlags := AValue;
|
||||
@ -2364,7 +2364,7 @@ begin
|
||||
DoModified;
|
||||
end;
|
||||
|
||||
procedure TWatchBase.SetExpression(AValue: String);
|
||||
procedure TWatch.SetExpression(AValue: String);
|
||||
begin
|
||||
if AValue <> FExpression
|
||||
then begin
|
||||
@ -2374,7 +2374,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TWatchBase.SetRepeatCount(AValue: Integer);
|
||||
procedure TWatch.SetRepeatCount(AValue: Integer);
|
||||
begin
|
||||
if FRepeatCount = AValue then Exit;
|
||||
FRepeatCount := AValue;
|
||||
@ -2382,66 +2382,66 @@ begin
|
||||
DoModified;
|
||||
end;
|
||||
|
||||
function TWatchBase.GetValue(const AThreadId: Integer;
|
||||
function TWatch.GetValue(const AThreadId: Integer;
|
||||
const AStackFrame: Integer): TWatchValue;
|
||||
begin
|
||||
Result := FValueList[AThreadId, AStackFrame];
|
||||
end;
|
||||
|
||||
procedure TWatchBase.DoModified;
|
||||
procedure TWatch.DoModified;
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
procedure TWatchBase.DoEnableChange;
|
||||
procedure TWatch.DoEnableChange;
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
procedure TWatchBase.DoExpressionChange;
|
||||
procedure TWatch.DoExpressionChange;
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
procedure TWatchBase.DoDisplayFormatChanged;
|
||||
procedure TWatch.DoDisplayFormatChanged;
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
procedure TWatchBase.AssignTo(Dest: TPersistent);
|
||||
procedure TWatch.AssignTo(Dest: TPersistent);
|
||||
begin
|
||||
if Dest is TWatchBase
|
||||
if Dest is TWatch
|
||||
then begin
|
||||
TWatchBase(Dest).FExpression := FExpression;
|
||||
TWatchBase(Dest).FEnabled := FEnabled;
|
||||
TWatchBase(Dest).FDisplayFormat := FDisplayFormat;
|
||||
TWatchBase(Dest).FRepeatCount := FRepeatCount;
|
||||
TWatchBase(Dest).FEvaluateFlags := FEvaluateFlags;
|
||||
TWatchBase(Dest).FValueList.Assign(FValueList);
|
||||
TWatch(Dest).FExpression := FExpression;
|
||||
TWatch(Dest).FEnabled := FEnabled;
|
||||
TWatch(Dest).FDisplayFormat := FDisplayFormat;
|
||||
TWatch(Dest).FRepeatCount := FRepeatCount;
|
||||
TWatch(Dest).FEvaluateFlags := FEvaluateFlags;
|
||||
TWatch(Dest).FValueList.Assign(FValueList);
|
||||
end
|
||||
else inherited;
|
||||
end;
|
||||
|
||||
function TWatchBase.CreateValueList: TWatchValueList;
|
||||
function TWatch.CreateValueList: TWatchValueList;
|
||||
begin
|
||||
Result := TWatchValueList.Create(Self);
|
||||
end;
|
||||
|
||||
constructor TWatchBase.Create(ACollection: TCollection);
|
||||
constructor TWatch.Create(ACollection: TCollection);
|
||||
begin
|
||||
FEnabled := False;
|
||||
FValueList := CreateValueList;
|
||||
inherited Create(ACollection);
|
||||
end;
|
||||
|
||||
destructor TWatchBase.Destroy;
|
||||
destructor TWatch.Destroy;
|
||||
begin
|
||||
FValueList.Clear;
|
||||
inherited Destroy;
|
||||
FreeAndNil(FValueList);
|
||||
end;
|
||||
|
||||
procedure TWatchBase.ClearValues;
|
||||
procedure TWatch.ClearValues;
|
||||
begin
|
||||
FValueList.Clear;
|
||||
end;
|
||||
@ -2494,7 +2494,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TWatchValueList.Create(AOwnerWatch: TWatchBase);
|
||||
constructor TWatchValueList.Create(AOwnerWatch: TWatch);
|
||||
begin
|
||||
assert(AOwnerWatch <> nil, 'TWatchValueList.Create without owner');
|
||||
FList := TList.Create;
|
||||
@ -2883,19 +2883,19 @@ end;
|
||||
|
||||
{ TWatchesBase }
|
||||
|
||||
function TWatches.GetItemBase(const AnIndex: Integer): TWatchBase;
|
||||
function TWatches.GetItemBase(const AnIndex: Integer): TWatch;
|
||||
begin
|
||||
Result := TWatchBase(inherited Items[AnIndex]);
|
||||
Result := TWatch(inherited Items[AnIndex]);
|
||||
end;
|
||||
|
||||
procedure TWatches.SetItemBase(const AnIndex: Integer; const AValue: TWatchBase);
|
||||
procedure TWatches.SetItemBase(const AnIndex: Integer; const AValue: TWatch);
|
||||
begin
|
||||
inherited Items[AnIndex] := AValue;
|
||||
end;
|
||||
|
||||
function TWatches.WatchClass: TBaseWatchClass;
|
||||
function TWatches.WatchClass: TWatchClass;
|
||||
begin
|
||||
Result := TWatchBase;
|
||||
Result := TWatch;
|
||||
end;
|
||||
|
||||
constructor TWatches.Create;
|
||||
@ -2903,6 +2903,29 @@ 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;
|
||||
S: String;
|
||||
begin
|
||||
S := UpperCase(AExpression);
|
||||
for n := 0 to Count - 1 do
|
||||
begin
|
||||
Result := TWatch(GetItem(n));
|
||||
if UpperCase(Result.Expression) = S
|
||||
then Exit;
|
||||
end;
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
{ TCallStackBase }
|
||||
|
||||
function TCallStackBase.GetNewCurrentIndex: Integer;
|
||||
|
||||
@ -574,7 +574,6 @@ type
|
||||
private
|
||||
function GetWatch: TIdeWatch;
|
||||
protected
|
||||
function GetExpression: String; override;
|
||||
function GetTypeInfo: TDBGType; override;
|
||||
function GetValue: String; override;
|
||||
|
||||
@ -617,7 +616,7 @@ type
|
||||
|
||||
{ TIdeWatch }
|
||||
|
||||
TIdeWatch = class(TWatchBase)
|
||||
TIdeWatch = class(TWatch)
|
||||
private
|
||||
function GetValue(const AThreadId: Integer; const AStackFrame: Integer): TIdeWatchValue;
|
||||
protected
|
||||
@ -645,16 +644,15 @@ type
|
||||
function GetItem(const AnIndex: Integer): TIdeWatch;
|
||||
procedure SetItem(const AnIndex: Integer; const AValue: TIdeWatch);
|
||||
protected
|
||||
function WatchClass: TBaseWatchClass; override;
|
||||
function WatchClass: TWatchClass; override;
|
||||
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig;
|
||||
APath: string);
|
||||
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig;
|
||||
APath: string);
|
||||
public
|
||||
function Add(const AExpression: String): TIdeWatch;
|
||||
function Find(const AExpression: String): TIdeWatch; override;
|
||||
function Find(const AExpression: String): TIdeWatch; reintroduce;
|
||||
property Items[const AnIndex: Integer]: TIdeWatch read GetItem write SetItem; default;
|
||||
procedure ClearValues; override;
|
||||
end;
|
||||
|
||||
{ TCurrentWatchValue }
|
||||
@ -688,13 +686,12 @@ type
|
||||
FSnapShot: TIdeWatch;
|
||||
procedure SetSnapShot(const AValue: TIdeWatch);
|
||||
protected
|
||||
function CreateValueList: TIdeWatchValueList; override;
|
||||
function CreateValueList: TWatchValueList; override;
|
||||
procedure DoChanged; override;
|
||||
procedure DoModified; override;
|
||||
procedure RequestData(AWatchValue: TCurrentWatchValue);
|
||||
property SnapShot: TIdeWatch read FSnapShot write SetSnapShot;
|
||||
public
|
||||
constructor Create(ACollection: TCollection); override;
|
||||
destructor Destroy; override;
|
||||
procedure LoadFromXMLConfig(const AConfig: TXMLConfig;
|
||||
const APath: string); virtual;
|
||||
@ -716,7 +713,7 @@ type
|
||||
function GetItem(const AnIndex: Integer): TCurrentWatch;
|
||||
procedure SetItem(const AnIndex: Integer; const AValue: TCurrentWatch);
|
||||
protected
|
||||
function WatchClass: TBaseWatchClass; override;
|
||||
function WatchClass: TWatchClass; override;
|
||||
procedure NotifyAdd(const AWatch: TCurrentWatch); virtual; // called when a watch is added
|
||||
procedure NotifyRemove(const AWatch: TCurrentWatch); virtual; // called by watch when destructed
|
||||
procedure DoModified;
|
||||
@ -728,7 +725,7 @@ type
|
||||
destructor Destroy; override;
|
||||
// Watch
|
||||
function Add(const AExpression: String): TCurrentWatch;
|
||||
function Find(const AExpression: String): TCurrentWatch; override;
|
||||
function Find(const AExpression: String): TCurrentWatch; reintroduce;
|
||||
// IDE
|
||||
procedure LoadFromXMLConfig(const AConfig: TXMLConfig; const APath: string);
|
||||
procedure SaveToXMLConfig(const AConfig: TXMLConfig; const APath: string);
|
||||
@ -3333,11 +3330,6 @@ begin
|
||||
Result := TIdeWatch(inherited Watch);
|
||||
end;
|
||||
|
||||
function TIdeWatchValue.GetExpression: String;
|
||||
begin
|
||||
Result := inherited GetExpression;
|
||||
end;
|
||||
|
||||
function TIdeWatchValue.GetTypeInfo: TDBGType;
|
||||
var
|
||||
i: Integer;
|
||||
@ -5440,7 +5432,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCurrentWatch.CreateValueList: TIdeWatchValueList;
|
||||
function TCurrentWatch.CreateValueList: TWatchValueList;
|
||||
begin
|
||||
Result := TCurrentWatchValueList.Create(Self);
|
||||
end;
|
||||
@ -5465,11 +5457,6 @@ begin
|
||||
else AWatchValue.Validity := ddsInvalid;
|
||||
end;
|
||||
|
||||
constructor TCurrentWatch.Create(ACollection: TCollection);
|
||||
begin
|
||||
inherited Create(ACollection);
|
||||
end;
|
||||
|
||||
destructor TCurrentWatch.Destroy;
|
||||
begin
|
||||
if (TCurrentWatches(Collection) <> nil)
|
||||
@ -5530,7 +5517,7 @@ begin
|
||||
inherited Items[AnIndex] := AValue;
|
||||
end;
|
||||
|
||||
function TIdeWatches.WatchClass: TBaseWatchClass;
|
||||
function TIdeWatches.WatchClass: TWatchClass;
|
||||
begin
|
||||
Result := TIdeWatch;
|
||||
end;
|
||||
@ -5557,26 +5544,8 @@ begin
|
||||
end;
|
||||
|
||||
function TIdeWatches.Find(const AExpression: String): TIdeWatch;
|
||||
var
|
||||
n: Integer;
|
||||
S: String;
|
||||
begin
|
||||
S := UpperCase(AExpression);
|
||||
for n := 0 to Count - 1 do
|
||||
begin
|
||||
Result := TIdeWatch(GetItem(n));
|
||||
if UpperCase(Result.Expression) = S
|
||||
then Exit;
|
||||
end;
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
procedure TIdeWatches.ClearValues;
|
||||
var
|
||||
n: Integer;
|
||||
begin
|
||||
for n := 0 to Count - 1 do
|
||||
TIdeWatch(GetItem(n)).ClearValues;
|
||||
Result := TIdeWatch(inherited Find(AExpression));
|
||||
end;
|
||||
|
||||
{ =========================================================================== }
|
||||
@ -5709,7 +5678,7 @@ begin
|
||||
inherited SetItem(AnIndex, AValue);
|
||||
end;
|
||||
|
||||
function TCurrentWatches.WatchClass: TBaseWatchClass;
|
||||
function TCurrentWatches.WatchClass: TWatchClass;
|
||||
begin
|
||||
Result := TCurrentWatch;
|
||||
end;
|
||||
|
||||
@ -7,7 +7,7 @@ interface
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, fpcunit, testutils, testregistry, EnvironmentOpts,
|
||||
TransferMacros, LCLProc, LazLogger, DbgIntfDebuggerBase, CompileHelpers, Dialogs,
|
||||
ExtToolDialog, Debugger, GDBMIDebugger, FpGdbmiDebugger;
|
||||
ExtToolDialog, GDBMIDebugger, FpGdbmiDebugger;
|
||||
|
||||
(*
|
||||
fpclist.txt contains lines of format:
|
||||
@ -36,6 +36,15 @@ const
|
||||
stDwarfAll = [stDwarf, stDwarfSet, stDwarf3];
|
||||
stSymAll = [stStabs, stDwarf, stDwarfSet, stDwarf3];
|
||||
|
||||
TWatchDisplayFormatNames: array [TWatchDisplayFormat] of string =
|
||||
('wdfDefault',
|
||||
'wdfStructure',
|
||||
'wdfChar', 'wdfString',
|
||||
'wdfDecimal', 'wdfUnsigned', 'wdfFloat', 'wdfHex',
|
||||
'wdfPointer',
|
||||
'wdfMemDump'
|
||||
);
|
||||
|
||||
type
|
||||
|
||||
TGDBMIDebuggerClass = class of TGDBMIDebugger;
|
||||
@ -75,6 +84,58 @@ type
|
||||
function CreateCallStackList: TCallStackList; override;
|
||||
end;
|
||||
|
||||
{ TTestWatchValue }
|
||||
|
||||
TTestWatchValue = class(TWatchValue)
|
||||
protected
|
||||
procedure RequestData;
|
||||
function GetTypeInfo: TDBGType; override;
|
||||
function GetValue: String; override;
|
||||
public
|
||||
constructor Create(AOwnerWatch: TWatch;
|
||||
const AThreadId: Integer;
|
||||
const AStackFrame: Integer
|
||||
);
|
||||
constructor Create(AOwnerWatch: TWatch);
|
||||
end;
|
||||
|
||||
{ TTestWatchValueList }
|
||||
|
||||
TTestWatchValueList = class(TWatchValueList)
|
||||
protected
|
||||
function CopyEntry(AnEntry: TWatchValue): TWatchValue; override;
|
||||
function CreateEntry(const {%H-}AThreadId: Integer; const {%H-}AStackFrame: Integer): TWatchValue; override;
|
||||
end;
|
||||
|
||||
{ TTestWatch }
|
||||
|
||||
TTestWatch = class(TWatch)
|
||||
function CreateValueList: TWatchValueList; override;
|
||||
procedure RequestData(AWatchValue: TTestWatchValue);
|
||||
public
|
||||
end;
|
||||
|
||||
TTestWatchesMonitor = class;
|
||||
{ TTestWatches }
|
||||
|
||||
TTestWatches = class(TWatches)
|
||||
protected
|
||||
FMonitor: TTestWatchesMonitor;
|
||||
function WatchClass: TWatchClass; override;
|
||||
procedure RequestData(AWatchValue: TWatchValue);
|
||||
end;
|
||||
|
||||
{ TIdeWatchesMonitor }
|
||||
|
||||
{ TTestWatchesMonitor }
|
||||
|
||||
TTestWatchesMonitor = class(TWatchesMonitor)
|
||||
protected
|
||||
procedure DoStateChangeEx(const AOldState, ANewState: TDBGState); override;
|
||||
procedure RequestData(AWatchValue: TWatchValue);
|
||||
function CreateWatches: TWatches; override;
|
||||
end;
|
||||
|
||||
{ TBaseList }
|
||||
|
||||
TBaseList = class
|
||||
@ -222,7 +283,7 @@ type
|
||||
//FBreakPointGroups: TIDEBreakPointGroups;
|
||||
FLocals: TLocalsMonitor;
|
||||
FLineInfo: TBaseLineInfo;
|
||||
FWatches: TIdeWatchesMonitor;
|
||||
FWatches: TTestWatchesMonitor;
|
||||
FThreads: TThreadsMonitor;
|
||||
FRegisters: TRegistersMonitor;
|
||||
private
|
||||
@ -299,7 +360,7 @@ type
|
||||
property LineInfo: TBaseLineInfo read FLineInfo;
|
||||
property Registers: TRegistersMonitor read FRegisters;
|
||||
//property Signals: TBaseSignals read FSignals; // A list of actions for signals we know of
|
||||
property Watches: TIdeWatchesMonitor read FWatches;
|
||||
property Watches: TTestWatchesMonitor read FWatches;
|
||||
property Threads: TThreadsMonitor read FThreads;
|
||||
end;
|
||||
|
||||
@ -384,6 +445,142 @@ begin
|
||||
Debuggers := Result;
|
||||
end;
|
||||
|
||||
{ TTestWatches }
|
||||
|
||||
function TTestWatches.WatchClass: TWatchClass;
|
||||
begin
|
||||
Result := TTestWatch;
|
||||
end;
|
||||
|
||||
procedure TTestWatches.RequestData(AWatchValue: TWatchValue);
|
||||
begin
|
||||
TTestWatchesMonitor(FMonitor).RequestData(AWatchValue);
|
||||
end;
|
||||
|
||||
{ TTestWatchesMonitor }
|
||||
|
||||
procedure TTestWatchesMonitor.DoStateChangeEx(const AOldState, ANewState: TDBGState);
|
||||
begin
|
||||
inherited DoStateChangeEx(AOldState, ANewState);
|
||||
Watches.ClearValues;
|
||||
end;
|
||||
|
||||
procedure TTestWatchesMonitor.RequestData(AWatchValue: TWatchValue);
|
||||
begin
|
||||
if Supplier <> nil
|
||||
then Supplier.RequestData(AWatchValue)
|
||||
else AWatchValue.Validity := ddsInvalid;
|
||||
end;
|
||||
|
||||
function TTestWatchesMonitor.CreateWatches: TWatches;
|
||||
begin
|
||||
Result := TTestWatches.Create;
|
||||
TTestWatches(Result).FMonitor := Self;
|
||||
end;
|
||||
|
||||
{ TTestWatchValue }
|
||||
|
||||
procedure TTestWatchValue.RequestData;
|
||||
begin
|
||||
TTestWatch(Watch).RequestData(self);
|
||||
end;
|
||||
|
||||
function TTestWatchValue.GetTypeInfo: TDBGType;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Result := nil;
|
||||
if not Watch.Enabled then
|
||||
exit;
|
||||
i := DbgStateChangeCounter; // workaround for state changes during TWatchValue.GetValue
|
||||
if Validity = ddsUnknown then begin
|
||||
Validity := ddsRequested;
|
||||
RequestData;
|
||||
if i <> DbgStateChangeCounter then exit;
|
||||
end;
|
||||
case Validity of
|
||||
ddsRequested,
|
||||
ddsEvaluating: Result := nil;
|
||||
ddsValid: Result := inherited GetTypeInfo;
|
||||
ddsInvalid,
|
||||
ddsError: Result := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TTestWatchValue.GetValue: String;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
if not Watch.Enabled then begin
|
||||
Result := '<disabled>';
|
||||
exit;
|
||||
end;
|
||||
i := DbgStateChangeCounter; // workaround for state changes during TWatchValue.GetValue
|
||||
if Validity = ddsUnknown then begin
|
||||
Result := '<evaluating>';
|
||||
Validity := ddsRequested;
|
||||
RequestData;
|
||||
if i <> DbgStateChangeCounter then exit; // in case the debugger did run.
|
||||
// TODO: The watch can also be deleted by the user
|
||||
end;
|
||||
case Validity of
|
||||
ddsRequested, ddsEvaluating: Result := '<evaluating>';
|
||||
ddsValid: Result := inherited GetValue;
|
||||
ddsInvalid: Result := '<invalid>';
|
||||
ddsError: Result := '<Error: '+ (inherited GetValue) +'>';
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TTestWatchValue.Create(AOwnerWatch: TWatch; const AThreadId: Integer;
|
||||
const AStackFrame: Integer);
|
||||
begin
|
||||
inherited Create(AOwnerWatch);
|
||||
Validity := ddsUnknown;
|
||||
FDisplayFormat := Watch.DisplayFormat;
|
||||
FEvaluateFlags := Watch.EvaluateFlags;
|
||||
FRepeatCount := Watch.RepeatCount;
|
||||
FThreadId := AThreadId;
|
||||
FStackFrame := AStackFrame;
|
||||
end;
|
||||
|
||||
constructor TTestWatchValue.Create(AOwnerWatch: TWatch);
|
||||
begin
|
||||
inherited Create(AOwnerWatch);
|
||||
Validity := ddsUnknown;
|
||||
FDisplayFormat := Watch.DisplayFormat;
|
||||
FEvaluateFlags := Watch.EvaluateFlags;
|
||||
FRepeatCount := Watch.RepeatCount;
|
||||
end;
|
||||
|
||||
{ TTestWatchValueList }
|
||||
|
||||
function TTestWatchValueList.CopyEntry(AnEntry: TWatchValue): TWatchValue;
|
||||
begin
|
||||
Result := TTestWatchValue.Create(Watch);
|
||||
Result.Assign(AnEntry);
|
||||
end;
|
||||
|
||||
function TTestWatchValueList.CreateEntry(const AThreadId: Integer;
|
||||
const AStackFrame: Integer): TWatchValue;
|
||||
begin
|
||||
Result := TTestWatchValue.Create(Watch, AThreadId, AStackFrame);
|
||||
Add(Result);
|
||||
end;
|
||||
|
||||
{ TTestWatch }
|
||||
|
||||
function TTestWatch.CreateValueList: TWatchValueList;
|
||||
begin
|
||||
Result := TTestWatchValueList.Create(Self);
|
||||
end;
|
||||
|
||||
procedure TTestWatch.RequestData(AWatchValue: TTestWatchValue);
|
||||
begin
|
||||
if Collection <> nil
|
||||
then TTestWatches(Collection).RequestData(AWatchValue)
|
||||
else AWatchValue.Validity := ddsInvalid;
|
||||
end;
|
||||
|
||||
{ TTestCallStackMonitor }
|
||||
|
||||
function TTestCallStackMonitor.CreateCallStackList: TCallStackList;
|
||||
@ -554,7 +751,7 @@ function TGDBTestCase.StartGDB(AppDir, TestExeName: String): TGDBMIDebugger;
|
||||
begin
|
||||
//FBreakPoints := TManagedBreakPoints.Create(Self);
|
||||
//FBreakPointGroups := TIDEBreakPointGroups.Create;
|
||||
FWatches := TIdeWatchesMonitor.Create;
|
||||
FWatches := TTestWatchesMonitor.Create;
|
||||
FThreads := TThreadsMonitor.Create;
|
||||
FExceptions := TBaseExceptions.Create(TBaseException);
|
||||
//FSignals := TBaseSignals.Create(TBaseSignal);
|
||||
|
||||
@ -49,7 +49,7 @@ type
|
||||
//FBreakPointGroups: TIDEBreakPointGroups;
|
||||
FLocals: TLocalsMonitor;
|
||||
FLineInfo: TBaseLineInfo;
|
||||
FWatches: TIdeWatchesMonitor;
|
||||
FWatches: TTestWatchesMonitor;
|
||||
FThreads: TThreadsMonitor;
|
||||
FRegisters: TRegistersMonitor;
|
||||
published
|
||||
@ -336,7 +336,7 @@ var
|
||||
//IdeDisAss.Master := Gdb.Disassembler;
|
||||
IdeDisAss := Gdb.Disassembler;
|
||||
|
||||
FWatches := TIdeWatchesMonitor.Create;
|
||||
FWatches := TTestWatchesMonitor.Create;
|
||||
FThreads := TThreadsMonitor.Create;
|
||||
FExceptions := TBaseExceptions.Create(TBaseException);
|
||||
//FSignals := TBaseSignals.Create(TBaseSignal);
|
||||
|
||||
@ -6,8 +6,7 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpcunit, testutils, testregistry, TestGDBMIControl, DbgIntfBaseTypes,
|
||||
DbgIntfDebuggerBase, TestBase, Debugger, GDBMIDebugger, LCLProc, SynRegExpr, Forms, StdCtrls,
|
||||
Controls;
|
||||
DbgIntfDebuggerBase, TestBase, GDBMIDebugger, LCLProc, SynRegExpr;
|
||||
|
||||
const
|
||||
BREAK_LINE_FOOFUNC_NEST = 206;
|
||||
@ -138,7 +137,7 @@ type
|
||||
|
||||
TTestWatches = class(TGDBTestCase)
|
||||
private
|
||||
FWatches: TcurrentWatches;
|
||||
FWatches: TWatches;
|
||||
Frx: TRegExpr;
|
||||
|
||||
|
||||
@ -2022,12 +2021,12 @@ var
|
||||
then Result := False;
|
||||
end;
|
||||
|
||||
procedure TestWatch(Name: String; AWatch: TCurrentWatch; Data: TWatchExpectation; WatchValue: String = '');
|
||||
procedure TestWatch(Name: String; AWatch: TTestWatch; Data: TWatchExpectation; WatchValue: String = '');
|
||||
var
|
||||
rx: TRegExpr;
|
||||
s, s2: String;
|
||||
flag, IsValid, HasTpInfo, f2: Boolean;
|
||||
WV: TIdeWatchValue;
|
||||
WV: TWatchValue;
|
||||
Stack: Integer;
|
||||
n: String;
|
||||
DataRes: TWatchExpectationResult;
|
||||
@ -2167,7 +2166,7 @@ var
|
||||
|
||||
var
|
||||
i: Integer;
|
||||
WList, WListSub, WListArray: Array of TCurrentWatch;
|
||||
WList, WListSub, WListArray: Array of TTestWatch;
|
||||
|
||||
begin
|
||||
TestBaseName := NamePreFix;
|
||||
@ -2195,7 +2194,7 @@ begin
|
||||
|
||||
try
|
||||
dbg := StartGDB(AppDir, TestExeName);
|
||||
FWatches := Watches.CurrentWatches;
|
||||
FWatches := Watches.Watches;
|
||||
|
||||
with dbg.BreakPoints.Add('WatchesPrg.pas', BREAK_LINE_FOOFUNC) do begin
|
||||
InitialEnabled := True;
|
||||
@ -2218,7 +2217,7 @@ begin
|
||||
for i := low(ExpectBreakFoo) to high(ExpectBreakFoo) do begin
|
||||
if not MatchOnly(ExpectBreakFoo[i], i) then continue;
|
||||
if not SkipTest(ExpectBreakFoo[i]) then begin
|
||||
WList[i] := TCurrentWatch.Create(FWatches);
|
||||
WList[i] := TTestWatch.Create(FWatches);
|
||||
WList[i].Expression := ExpectBreakFoo[i].Expression;
|
||||
WList[i].DisplayFormat := ExpectBreakFoo[i].DspFormat;
|
||||
WList[i].EvaluateFlags:= ExpectBreakFoo[i].EvaluateFlags;
|
||||
@ -2230,7 +2229,7 @@ begin
|
||||
for i := low(ExpectBreakSubFoo) to high(ExpectBreakSubFoo) do begin
|
||||
if not MatchOnly(ExpectBreakSubFoo[i], i) then continue;
|
||||
if not SkipTest(ExpectBreakSubFoo[i]) then begin
|
||||
WListSub[i] := TCurrentWatch.Create(FWatches);
|
||||
WListSub[i] := TTestWatch.Create(FWatches);
|
||||
WListSub[i].Expression := ExpectBreakSubFoo[i].Expression;
|
||||
WListSub[i].DisplayFormat := ExpectBreakSubFoo[i].DspFormat;
|
||||
WListSub[i].EvaluateFlags:= ExpectBreakSubFoo[i].EvaluateFlags;
|
||||
@ -2242,7 +2241,7 @@ begin
|
||||
for i := low(ExpectBreakFooArray) to high(ExpectBreakFooArray) do begin
|
||||
if not MatchOnly(ExpectBreakFooArray[i], i) then continue;
|
||||
if not SkipTest(ExpectBreakFooArray[i]) then begin
|
||||
WListArray[i] := TCurrentWatch.Create(FWatches);
|
||||
WListArray[i] := TTestWatch.Create(FWatches);
|
||||
WListArray[i].Expression := ExpectBreakFooArray[i].Expression;
|
||||
WListArray[i].DisplayFormat := ExpectBreakFooArray[i].DspFormat;
|
||||
WListArray[i].EvaluateFlags:= ExpectBreakFooArray[i].EvaluateFlags;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user