mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-19 14:49:29 +02:00
FpGdbmiDebugger: tests
git-svn-id: trunk@44497 -
This commit is contained in:
martin
parent
95834abad6
commit
a46b9d6e39
@ -946,6 +946,8 @@ begin
|
||||
if IsWatchValueAlive then debugln(['TFPGDBMIWatches.InternalRequestData FAILED ', WatchValue.Expression]);
|
||||
if IsWatchValueAlive then
|
||||
inherited InternalRequestData(WatchValue);
|
||||
if IsWatchValueAlive then
|
||||
WatchValue.Value := '{GDB:}'+WatchValue.Value;
|
||||
end;
|
||||
finally
|
||||
if IsWatchValueAlive then begin
|
||||
|
||||
@ -1,16 +1,118 @@
|
||||
unit TestWatchesUnitSimple;
|
||||
|
||||
interface
|
||||
uses sysutils, types;
|
||||
|
||||
procedure Test1;
|
||||
|
||||
// TODO types in another unit / yet brea in this unit
|
||||
// Nested procedure
|
||||
|
||||
implementation
|
||||
|
||||
procedure Test1;
|
||||
var i: integer;
|
||||
var
|
||||
SimpleGlob_Short1, SimpleGlob_Short2, SimpleGlob_Short3, SimpleGlob_Short4, SimpleGlob_Short5: ShortInt;
|
||||
SimpleGlob_Small1, SimpleGlob_Small2, SimpleGlob_Small3, SimpleGlob_Small4, SimpleGlob_Small5: Smallint;
|
||||
SimpleGlob_Int1, SimpleGlob_Int2, SimpleGlob_Int3, SimpleGlob_Int4, SimpleGlob_Int5: Integer;
|
||||
SimpleGlob_QInt1, SimpleGlob_QInt2, SimpleGlob_QInt3, SimpleGlob_QInt4, SimpleGlob_QInt5: Int64;
|
||||
|
||||
SimpleGlob_Byte1, SimpleGlob_Byte2, SimpleGlob_Byte3, SimpleGlob_Byte4, SimpleGlob_Byte5: Byte;
|
||||
SimpleGlob_Word1, SimpleGlob_Word2, SimpleGlob_Word3, SimpleGlob_Word4, SimpleGlob_Word5: Word;
|
||||
SimpleGlob_DWord1, SimpleGlob_DWord2, SimpleGlob_DWord3, SimpleGlob_DWord4, SimpleGlob_DWord5: DWord;
|
||||
SimpleGlob_QWord1, SimpleGlob_QWord2, SimpleGlob_QWord3, SimpleGlob_QWord4, SimpleGlob_QWord5: QWord;
|
||||
|
||||
SimpleGlob_Single1, SimpleGlob_Single2, SimpleGlob_Single3, SimpleGlob_Single4, SimpleGlob_Single5: Single;
|
||||
SimpleGlob_Double1, SimpleGlob_Double2, SimpleGlob_Double3, SimpleGlob_Double4, SimpleGlob_Double5: Double;
|
||||
SimpleGlob_Ext1, SimpleGlob_Ext2, SimpleGlob_Ext3, SimpleGlob_Ext4, SimpleGlob_Ext5: Extended;
|
||||
|
||||
|
||||
|
||||
procedure Test1Sub(
|
||||
SimpleArg_Short1: ShortInt;
|
||||
SimpleArg_Small1: Smallint;
|
||||
SimpleArg_Int1: Integer;
|
||||
SimpleArg_QInt1: Int64;
|
||||
|
||||
SimpleArg_Byte1: Byte;
|
||||
SimpleArg_Word1: Word;
|
||||
SimpleArg_DWord1: DWord;
|
||||
SimpleArg_QWord1: QWord;
|
||||
|
||||
SimpleArg_Single1: Single;
|
||||
SimpleArg_Double1: Double;
|
||||
SimpleArg_Ext1: Extended;
|
||||
|
||||
var SimpleVArg_Short1: ShortInt;
|
||||
var SimpleVArg_Small1: Smallint;
|
||||
var SimpleVArg_Int1 : Integer;
|
||||
var SimpleVArg_QInt1: Int64;
|
||||
|
||||
var SimpleVArg_Byte1: Byte;
|
||||
var SimpleVArg_Word1: Word;
|
||||
var SimpleVArg_DWord1: DWord;
|
||||
var SimpleVArg_QWord1: QWord;
|
||||
|
||||
var SimpleVArg_Single1: Single;
|
||||
var SimpleVArg_Double1: Double;
|
||||
var SimpleVArg_Ext1: Extended
|
||||
|
||||
);
|
||||
var
|
||||
SimpleLocal_Short1: ShortInt;
|
||||
SimpleLocal_Small1: Smallint;
|
||||
SimpleLocal_Int1 : Integer;
|
||||
SimpleLocal_QInt1: Int64;
|
||||
|
||||
SimpleLocal_Byte1: Byte;
|
||||
SimpleLocal_Word1: Word;
|
||||
SimpleLocal_DWord1: DWord;
|
||||
SimpleLocal_QWord1: QWord;
|
||||
|
||||
SimpleLocal_Single1: Single;
|
||||
SimpleLocal_Double1: Double;
|
||||
SimpleLocal_Ext1: Extended;
|
||||
begin
|
||||
i := 121;
|
||||
i := i+1;
|
||||
SimpleLocal_Int1 := 3901;
|
||||
SimpleGlob_Int1 := 2901;
|
||||
SimpleGlob_Int2 := 0;
|
||||
SimpleGlob_Int3 := -1;
|
||||
SimpleGlob_Int4 := high(Integer);
|
||||
SimpleGlob_Int5 := low(Integer);
|
||||
|
||||
inc(SimpleVArg_Int1); // BREAK Single 1
|
||||
end;
|
||||
|
||||
|
||||
procedure Test1;
|
||||
var
|
||||
i1: shortint;
|
||||
i2: smallint;
|
||||
i3: Integer;
|
||||
i4: Int64;
|
||||
u1: byte;
|
||||
u2: word;
|
||||
u3: dword;
|
||||
u4: qword;
|
||||
d1: Single;
|
||||
d2: double;
|
||||
d3: Extended;
|
||||
begin
|
||||
i1 := -91;
|
||||
i2 := -191;
|
||||
i3 := -1901;
|
||||
i4 := -190000000000001;
|
||||
u1 := 91;
|
||||
u2 := 191;
|
||||
u3 := 1901;
|
||||
u4 := 190000000000001;
|
||||
d1 := -1234;
|
||||
d2 := -2345;
|
||||
d3 := -3456;
|
||||
Test1Sub(
|
||||
-92, -192, -1902, -190000000000002, 92, 192, 1902, 190000000000002,
|
||||
1234, 2345, 3456,
|
||||
i1, i2, i3, i4, u1, u2, u3, u4, d1, d2, d3
|
||||
);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -3,11 +3,12 @@ program TestFpGdbmi;
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
Interfaces, Forms, GuiTestRunner, TestGDBMIControl, TestWatches;
|
||||
Interfaces, Forms, GuiTestRunner, TestGDBMIControl, TestWatches, FpGdbmiDebugger, TestBase;
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
TestBase.TestGdbClass := TFpGDBMIDebugger;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TGuiTestRunner, TestRunner);
|
||||
Application.CreateForm(TTestControlForm, TestControlForm);
|
||||
|
||||
@ -10,7 +10,7 @@ uses
|
||||
GDBMIDebugger;
|
||||
|
||||
const
|
||||
BREAK_LINE_TestWatchesUnitSimple = 13;
|
||||
BREAK_LINE_TestWatchesUnitSimple = 82;
|
||||
|
||||
type
|
||||
|
||||
@ -37,6 +37,7 @@ type
|
||||
function AddFmtDef (AnExpr, AMtch: string; AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags=[]): PWatchExpectation;
|
||||
function AddFmtDef (AnExpr: String; AEvalFlags: TDBGEvaluateFlags; AMtch: string; AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags=[]): PWatchExpectation;
|
||||
|
||||
function AddSimpleInt(AnExpr, AMtch: string; ATpNm: string): PWatchExpectation;
|
||||
|
||||
procedure AddExpectSimple;
|
||||
procedure RunTestWatches(NamePreFix: String;
|
||||
@ -142,11 +143,23 @@ begin
|
||||
Result := Add(AnExpr, wdfDefault, AEvalFlags, AMtch, AKind, ATpNm, AFlgs );
|
||||
end;
|
||||
|
||||
function TTestWatches.AddSimpleInt(AnExpr, AMtch: string; ATpNm: string): PWatchExpectation;
|
||||
begin
|
||||
AddFmtDef(AnExpr, AMtch, skSimple, ATpNm, [fTpMtch]);
|
||||
end;
|
||||
|
||||
procedure TTestWatches.AddExpectSimple;
|
||||
begin
|
||||
FCurrentExpArray := @ExpectBreakSimple1;
|
||||
//
|
||||
AddFmtDef('i', '121', skSimple, M_Int, [fTpMtch]);
|
||||
AddSimpleInt('SimpleArg_Int1', '^-1902', M_Int);
|
||||
AddSimpleInt('SimpleVArg_Int1', '^-1901', M_Int);
|
||||
AddSimpleInt('SimpleLocal_Int1', '^3901', M_Int);
|
||||
AddSimpleInt('SimpleGlob_Int1', '^2901', M_Int);
|
||||
AddSimpleInt('SimpleGlob_Int2', '^0', M_Int);
|
||||
AddSimpleInt('SimpleGlob_Int3', '^-1', M_Int);
|
||||
AddSimpleInt('SimpleGlob_Int4', '^2147483647', M_Int);
|
||||
AddSimpleInt('SimpleGlob_Int5', '^-2147483648', M_Int);
|
||||
end;
|
||||
|
||||
procedure TTestWatches.RunTestWatches(NamePreFix: String; TestExeName, ExtraOpts: String;
|
||||
|
||||
@ -85,6 +85,29 @@ type
|
||||
function CreateCallStackList: TCallStackList; override;
|
||||
end;
|
||||
|
||||
TTestThreadsMonitor = class;
|
||||
{ TTestThreads }
|
||||
|
||||
TTestThreads = class(TThreads)
|
||||
private
|
||||
FMonitor: TTestThreadsMonitor;
|
||||
FDataValidity: TDebuggerDataState;
|
||||
public
|
||||
constructor Create;
|
||||
function Count: Integer; override;
|
||||
procedure Clear; override;
|
||||
procedure SetValidity(AValidity: TDebuggerDataState); override;
|
||||
end;
|
||||
|
||||
{ TTestThreadsMonitor }
|
||||
|
||||
TTestThreadsMonitor = class(TThreadsMonitor)
|
||||
protected
|
||||
procedure DoStateEnterPause; override;
|
||||
function CreateThreads: TThreads; override;
|
||||
procedure RequestData;
|
||||
end;
|
||||
|
||||
{ TTestWatchValue }
|
||||
|
||||
TTestWatchValue = class(TWatchValue)
|
||||
@ -135,6 +158,35 @@ type
|
||||
function CreateWatches: TWatches; override;
|
||||
end;
|
||||
|
||||
TTestRegistersMonitor = class;
|
||||
{ TTestRegisters }
|
||||
|
||||
TTestRegisters = class(TRegisters)
|
||||
private
|
||||
FMonitor: TTestRegistersMonitor;
|
||||
protected
|
||||
procedure DoDataValidityChanged(AnOldValidity: TDebuggerDataState); override;
|
||||
public
|
||||
function Count: Integer; reintroduce; override;
|
||||
end;
|
||||
|
||||
{ TTEstRegistersList }
|
||||
|
||||
TTestRegistersList = class(TRegistersList)
|
||||
private
|
||||
FMonitor: TTestRegistersMonitor;
|
||||
protected
|
||||
function CreateEntry(AThreadId, AStackFrame: Integer): TRegisters; override;
|
||||
end;
|
||||
|
||||
{ TTestRegistersMonitor }
|
||||
|
||||
TTestRegistersMonitor = class(TRegistersMonitor)
|
||||
protected
|
||||
function CreateRegistersList: TRegistersList; override;
|
||||
procedure RequestData(ARegisters: TRegisters);
|
||||
end;
|
||||
|
||||
{ TBaseList }
|
||||
|
||||
TBaseList = class
|
||||
@ -283,8 +335,8 @@ type
|
||||
FLocals: TLocalsMonitor;
|
||||
FLineInfo: TBaseLineInfo;
|
||||
FWatches: TTestWatchesMonitor;
|
||||
FThreads: TThreadsMonitor;
|
||||
FRegisters: TRegistersMonitor;
|
||||
FThreads: TTestThreadsMonitor;
|
||||
FRegisters: TTestRegistersMonitor;
|
||||
private
|
||||
FParent: TGDBTestsuite;
|
||||
FTestBaseName: String;
|
||||
@ -357,10 +409,10 @@ type
|
||||
property Disassembler: TBaseDisassembler read FDisassembler;
|
||||
property Locals: TLocalsMonitor read FLocals;
|
||||
property LineInfo: TBaseLineInfo read FLineInfo;
|
||||
property Registers: TRegistersMonitor read FRegisters;
|
||||
property Registers: TTestRegistersMonitor read FRegisters;
|
||||
//property Signals: TBaseSignals read FSignals; // A list of actions for signals we know of
|
||||
property Watches: TTestWatchesMonitor read FWatches;
|
||||
property Threads: TThreadsMonitor read FThreads;
|
||||
property Threads: TTestThreadsMonitor read FThreads;
|
||||
end;
|
||||
|
||||
function GetCompilers: TCompilerList;
|
||||
@ -446,6 +498,107 @@ begin
|
||||
Debuggers := Result;
|
||||
end;
|
||||
|
||||
{ TTestThreads }
|
||||
|
||||
constructor TTestThreads.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
FDataValidity := ddsUnknown;
|
||||
end;
|
||||
|
||||
function TTestThreads.Count: Integer;
|
||||
begin
|
||||
if (FDataValidity = ddsUnknown) then begin
|
||||
FDataValidity := ddsRequested;
|
||||
FMonitor.RequestData;
|
||||
end;
|
||||
|
||||
Result := inherited Count;
|
||||
end;
|
||||
|
||||
procedure TTestThreads.Clear;
|
||||
begin
|
||||
FDataValidity := ddsUnknown;
|
||||
inherited Clear;
|
||||
end;
|
||||
|
||||
procedure TTestThreads.SetValidity(AValidity: TDebuggerDataState);
|
||||
begin
|
||||
if FDataValidity = AValidity then exit;
|
||||
FDataValidity := AValidity;
|
||||
if FDataValidity = ddsUnknown then Clear;
|
||||
end;
|
||||
|
||||
{ TTestThreadsMonitor }
|
||||
|
||||
procedure TTestThreadsMonitor.DoStateEnterPause;
|
||||
begin
|
||||
inherited DoStateEnterPause;
|
||||
TTestThreads(Threads).SetValidity(ddsUnknown);
|
||||
end;
|
||||
|
||||
function TTestThreadsMonitor.CreateThreads: TThreads;
|
||||
begin
|
||||
Result := TTestThreads.Create;
|
||||
TTestThreads(Result).FMonitor := Self;
|
||||
end;
|
||||
|
||||
procedure TTestThreadsMonitor.RequestData;
|
||||
begin
|
||||
if Supplier <> nil
|
||||
then Supplier.RequestMasterData;
|
||||
end;
|
||||
|
||||
{ TTestRegistersMonitor }
|
||||
|
||||
function TTestRegistersMonitor.CreateRegistersList: TRegistersList;
|
||||
begin
|
||||
Result := TTestRegistersList.Create;
|
||||
TTestRegistersList(Result).FMonitor := Self;
|
||||
end;
|
||||
|
||||
procedure TTestRegistersMonitor.RequestData(ARegisters: TRegisters);
|
||||
begin
|
||||
if Supplier <> nil
|
||||
then Supplier.RequestData(ARegisters)
|
||||
else ARegisters.DataValidity := ddsInvalid;
|
||||
end;
|
||||
|
||||
{ TTEstRegistersList }
|
||||
|
||||
function TTestRegistersList.CreateEntry(AThreadId, AStackFrame: Integer): TRegisters;
|
||||
begin
|
||||
Result := TTestRegisters.Create(AThreadId, AStackFrame);
|
||||
TTestRegisters(Result).FMonitor := FMonitor;
|
||||
end;
|
||||
|
||||
{ TTestRegisters }
|
||||
|
||||
procedure TTestRegisters.DoDataValidityChanged(AnOldValidity: TDebuggerDataState);
|
||||
begin
|
||||
inherited DoDataValidityChanged(AnOldValidity);
|
||||
end;
|
||||
|
||||
function TTestRegisters.Count: Integer;
|
||||
begin
|
||||
case DataValidity of
|
||||
ddsUnknown: begin
|
||||
AddReference;
|
||||
try
|
||||
Result := 0;
|
||||
DataValidity := ddsRequested;
|
||||
FMonitor.RequestData(Self); // Locals can be cleared, if debugger is "run" again
|
||||
if DataValidity = ddsValid then Result := inherited Count();
|
||||
finally
|
||||
ReleaseReference;
|
||||
end;
|
||||
end;
|
||||
ddsRequested, ddsEvaluating: Result := 0;
|
||||
ddsValid: Result := inherited Count;
|
||||
ddsInvalid, ddsError: Result := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TTestWatches }
|
||||
|
||||
function TTestWatches.WatchClass: TWatchClass;
|
||||
@ -595,6 +748,7 @@ function TTestCallStackList.NewEntryForThread(const AThreadId: Integer): TCallSt
|
||||
begin
|
||||
Result := TCallStackBase.Create;
|
||||
Result.ThreadId := AThreadId;
|
||||
add(Result);
|
||||
end;
|
||||
|
||||
{ TGDBTestCase }
|
||||
@ -752,14 +906,14 @@ begin
|
||||
//FBreakPoints := TManagedBreakPoints.Create(Self);
|
||||
//FBreakPointGroups := TIDEBreakPointGroups.Create;
|
||||
FWatches := TTestWatchesMonitor.Create;
|
||||
FThreads := TThreadsMonitor.Create;
|
||||
FThreads := TTestThreadsMonitor.Create;
|
||||
FExceptions := TBaseExceptions.Create(TBaseException);
|
||||
//FSignals := TBaseSignals.Create(TBaseSignal);
|
||||
FLocals := TLocalsMonitor.Create;
|
||||
FLineInfo := TBaseLineInfo.Create;
|
||||
FCallStack := TTestCallStackMonitor.Create;
|
||||
FDisassembler := TBaseDisassembler.Create;
|
||||
FRegisters := TRegistersMonitor.Create;
|
||||
FRegisters := TTestRegistersMonitor.Create;
|
||||
|
||||
Result := GdbClass.Create(DebuggerInfo.ExeName);
|
||||
Result.OnDbgOutput := @InternalDbgOutPut;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user