paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-19 04:02:11 +02:00
Code Issues Packages Projects Releases Wiki Activity

Debugger: refactor tests / start tests far fpgdbmi

Browse Source 
git-svn-id: trunk@44489 -
This commit is contained in:
martin 2014-03-22 12:41:28 +00:00
parent 35e34ba93c
commit b20ef6a9a5
15 changed files with 1098 additions and 620 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
.gitattributes vendored
View File

@ -2017,6 +2017,11 @@ components/lazcontrols/treefilteredit.pas svneol=native#text/plain
components/lazdebuggerfp/fpgdbmidebugger.pp svneol=native#text/pascal
components/lazdebuggerfp/lazdebuggerfp.lpk svneol=native#text/pascal
components/lazdebuggerfp/lazdebuggerfp.pas svneol=native#text/pascal
components/lazdebuggerfp/test/TestApps/TestWatchesProg.pas svneol=native#text/pascal
components/lazdebuggerfp/test/TestApps/TestWatchesUnitSimple.pas svneol=native#text/pascal
components/lazdebuggerfp/test/TestFpGdbmi.lpi svneol=native#text/pascal
components/lazdebuggerfp/test/TestFpGdbmi.lpr svneol=native#text/pascal
components/lazdebuggerfp/test/testwatches.pas svneol=native#text/pascal
components/lazdebuggergdbmi/Makefile svneol=native#text/plain
components/lazdebuggergdbmi/Makefile.compiled svneol=native#text/plain
components/lazdebuggergdbmi/Makefile.fpc svneol=native#text/plain
@ -2068,6 +2073,7 @@ components/lazdebuggergdbmi/test/gdbmitestutils/gdbmitestutils.lpk svneol=native
components/lazdebuggergdbmi/test/gdbmitestutils/testbase.pas svneol=native#text/pascal
components/lazdebuggergdbmi/test/gdbmitestutils/testgdbmicontrol.lfm svneol=native#text/plain
components/lazdebuggergdbmi/test/gdbmitestutils/testgdbmicontrol.pas svneol=native#text/pascal
components/lazdebuggergdbmi/test/gdbmitestutils/testwatchutils.pas svneol=native#text/pascal
components/lazdebuggergdbmi/test/rungdbmiform.lfm svneol=native#text/plain
components/lazdebuggergdbmi/test/rungdbmiform.pas svneol=native#text/pascal
components/lazdebuggergdbmi/test/testargv.pas svneol=native#text/pascal

7
components/lazdebuggerfp/test/TestApps/TestWatchesProg.pas Normal file
View File

@ -0,0 +1,7 @@
program TestWatchesProg;
uses TestWatchesUnitSimple;
begin
TestWatchesUnitSimple.Test1;
end.

17
components/lazdebuggerfp/test/TestApps/TestWatchesUnitSimple.pas Normal file
View File

@ -0,0 +1,17 @@
unit TestWatchesUnitSimple;
interface
procedure Test1;
implementation
procedure Test1;
var i: integer;
begin
i := 121;
i := i+1;
end;
end.

87
components/lazdebuggerfp/test/TestFpGdbmi.lpi Normal file
View File

@ -0,0 +1,87 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="TestFpGdbmi"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="5">
<Item1>
<PackageName Value="LazDebuggerFp"/>
</Item1>
<Item2>
<PackageName Value="GdbmiTestUtils"/>
</Item2>
<Item3>
<PackageName Value="FPCUnitTestRunner"/>
</Item3>
<Item4>
<PackageName Value="LCL"/>
</Item4>
<Item5>
<PackageName Value="FCL"/>
</Item5>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="TestFpGdbmi.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="TestFpGdbmi"/>
</Unit0>
<Unit1>
<Filename Value="testwatches.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="TestWatches"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
</SearchPaths>
<Other>
<CompilerMessages>
<MsgFileName Value=""/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

16
components/lazdebuggerfp/test/TestFpGdbmi.lpr Normal file
View File

@ -0,0 +1,16 @@
program TestFpGdbmi;
{$mode objfpc}{$H+}
uses
Interfaces, Forms, GuiTestRunner, TestGDBMIControl, TestWatches;
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TGuiTestRunner, TestRunner);
Application.CreateForm(TTestControlForm, TestControlForm);
Application.Run;
end.

258
components/lazdebuggerfp/test/testwatches.pas Normal file
View File

@ -0,0 +1,258 @@
unit TestWatches;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fpcunit, testutils, testregistry, TestGDBMIControl, DbgIntfBaseTypes,
DbgIntfDebuggerBase, TestBase, FpGdbmiDebugger, LCLProc, SynRegExpr, TestWatchUtils,
GDBMIDebugger;
const
BREAK_LINE_TestWatchesUnitSimple = 13;
type
{ TTestWatches }
TTestWatches = class(TTestWatchesBase)
private
FWatches: TWatches;
ExpectBreakSimple1: TWatchExpectationArray;
FCurrentExpArray: ^TWatchExpectationArray; // currently added to
FDbgOutPut: String;
FDbgOutPutEnable: Boolean;
procedure DoDbgOutput(Sender: TObject; const AText: String); override;
procedure ClearAllTestArrays;
function HasTestArraysData: Boolean;
function Add(AnExpr: string; AFmt: TWatchDisplayFormat; AMtch: string;
AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags): PWatchExpectation;
function Add(AnExpr: string; AFmt: TWatchDisplayFormat; AEvalFlags: TDBGEvaluateFlags; AMtch: string;
AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags): PWatchExpectation;
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;
procedure AddExpectSimple;
procedure RunTestWatches(NamePreFix: String;
TestExeName, ExtraOpts: String;
UsedUnits: array of TUsesDir
);
published
procedure TestWatches;
end;
implementation
const
RNoPreQuote = '(^|[^''])'; // No open qoute (Either at start, or other char)
RNoPostQuote = '($|[^''])'; // No close qoute (Either at end, or other char)
Match_Pointer = '\$[0-9A-F]+';
M_Int = 'Integer|LongInt';
{%region * Classes * }
// _vptr$TOBJECt on older gdb e.g. mac 6.3.50
Match_ArgTFoo = '<TFoo> = \{.*(<|vptr\$)TObject>?.+ValueInt = -11';
Match_ArgTFoo1 = '<TFoo> = \{.*(<|vptr\$)TObject>?.+ValueInt = 31';
{%ebdregion * Classes * }
// Todo: Dwarf fails with dereferenced var pointer types
function MatchPointer(TypeName: String=''): String;
begin
if TypeName = ''
then Result := '\$[0-9A-F]+'
else Result := TypeName+'\(\$[0-9A-F]+';
end;
function MatchRecord(TypeName: String; AContent: String = ''): String;
begin
Result := 'record '+TypeName+' .+'+AContent;
end;
function MatchRecord(TypeName: String; AValInt: integer; AValFoo: String = ''): String;
begin
Result := 'record '+TypeName+' .+ valint = '+IntToStr(AValInt);
If AValFoo <> '' then Result := Result + ',.* valfoo = '+AValFoo;
end;
function MatchClass(TypeName: String; AContent: String = ''): String;
begin
Result := '<'+TypeName+'> = \{.*(vptr\$|<TObject>).+'+AContent;
end;
function MatchClassNil(TypeName: String): String;
begin
Result := '<'+TypeName+'> = nil';
end;
{ TTestWatches }
procedure TTestWatches.DoDbgOutput(Sender: TObject; const AText: String);
begin
inherited DoDbgOutput(Sender, AText);
if FDbgOutPutEnable then
FDbgOutPut := FDbgOutPut + AText;
end;
procedure TTestWatches.ClearAllTestArrays;
begin
//SetLength(ExpectBreakFooGdb, 0);
//SetLength(ExpectBreakSubFoo, 0);
end;
function TTestWatches.HasTestArraysData: Boolean;
begin
//Result := (Length(ExpectBreakFooGdb) > 0) or
// (Length(ExpectBreakSubFoo) > 0) or
// (Length(ExpectBreakFoo) > 0) or
// (Length(ExpectBreakFooArray) >0 );
//
end;
function TTestWatches.Add(AnExpr: string; AFmt: TWatchDisplayFormat; AMtch: string;
AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags): PWatchExpectation;
begin
Result := AddWatchExp(FCurrentExpArray^, AnExpr, AFmt, AMtch, AKind, ATpNm, AFlgs );
end;
function TTestWatches.Add(AnExpr: string; AFmt: TWatchDisplayFormat;
AEvalFlags: TDBGEvaluateFlags; AMtch: string; AKind: TDBGSymbolKind; ATpNm: string;
AFlgs: TWatchExpectationFlags): PWatchExpectation;
begin
Result := AddWatchExp(FCurrentExpArray^, AnExpr, AFmt, AEvalFlags, AMtch, AKind, ATpNm, AFlgs );
end;
function TTestWatches.AddFmtDef(AnExpr, AMtch: string; AKind: TDBGSymbolKind; ATpNm: string;
AFlgs: TWatchExpectationFlags): PWatchExpectation;
begin
Result := Add(AnExpr, wdfDefault, AMtch, AKind, ATpNm, AFlgs );
end;
function TTestWatches.AddFmtDef(AnExpr: String; AEvalFlags: TDBGEvaluateFlags; AMtch: string;
AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags): PWatchExpectation;
begin
Result := Add(AnExpr, wdfDefault, AEvalFlags, AMtch, AKind, ATpNm, AFlgs );
end;
procedure TTestWatches.AddExpectSimple;
begin
FCurrentExpArray := @ExpectBreakSimple1;
//
AddFmtDef('i', '121', skSimple, M_Int, [fTpMtch]);
end;
procedure TTestWatches.RunTestWatches(NamePreFix: String; TestExeName, ExtraOpts: String;
UsedUnits: array of TUsesDir);
var
dbg: TGDBMIDebugger;
Only: Integer;
OnlyName, OnlyNamePart: String;
var
i: Integer;
WListSimple1: TTestWatchArray;
begin
TestBaseName := NamePreFix;
if not HasTestArraysData then exit;
Only := StrToIntDef(TestControlForm.EdOnlyWatch.Text, -1);
OnlyNamePart := '';OnlyName := '';
if Only < 0
then begin
OnlyName := TestControlForm.EdOnlyWatch.Text;
if (OnlyName <> '') and (OnlyName[1]='*') then begin
OnlyNamePart := copy(OnlyName, 2, length(OnlyName));
OnlyName := '';
end;
end;
try
TestCompile(AppDir + 'TestWatchesProg.pas', TestExeName, UsedUnits, '', ExtraOpts);
except
on e: Exception do begin
TestTrue('Compile error: ' + e.Message, False);
exit;
end;
end;
try
dbg := StartGDB(AppDir, TestExeName);
FWatches := Watches.Watches;
with dbg.BreakPoints.Add('TestWatchesUnitSimple.pas', BREAK_LINE_TestWatchesUnitSimple) do begin
InitialEnabled := True;
Enabled := True;
end;
if dbg.State = dsError then
Fail(' Failed Init');
AddWatches(ExpectBreakSimple1, WListSimple1, FWatches, Only, OnlyName, OnlyNamePart);
(* Start debugging *)
dbg.ShowConsole := True;
dbg.Run;
if TestTrue('State=Pause', dbg.State = dsPause)
then begin
(* Hit first breakpoint: BREAK_LINE_FOOFUNC_NEST SubFoo -- (1st loop) Called with none nil data *)
TestWatchList('Simple1',ExpectBreakSimple1, WListSimple1, dbg, Only, OnlyName, OnlyNamePart);
dbg.Run;
end
else TestTrue('Hit BREAK_LINE_FOOFUNC_NEST', False);
dbg.Stop;
except
on e: Exception do begin
TestTrue('Error: ' + e.Message, False);
exit;
end;
end;
dbg.Done;
CleanGdb;
dbg.Free;
end;
procedure TTestWatches.TestWatches;
var
TestExeName: string;
begin
if SkipTest then exit;
if not TestControlForm.CheckListBox1.Checked[TestControlForm.CheckListBox1.Items.IndexOf('TTestWatches')] then exit;
ClearTestErrors;
ClearAllTestArrays;
AddExpectSimple;
RunTestWatches('', TestExeName, '', []);
AssertTestErrors;
end;
initialization
RegisterDbgTest(TTestWatches);
RegisterTestSelectors(['TTestWatches'
]);
end.

8
components/lazdebuggergdbmi/test/gdbmitestutils/gdbmitestutils.lpk
View File

@ -8,7 +8,7 @@
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)\"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Other>
<CompilerMessages>
@ -20,7 +20,7 @@
<Description Value="Test helper units for LazDebuggerGDBMI"/>
<License Value="GPL2"/>
<Version Minor="1"/>
<Files Count="4">
<Files Count="5">
<Item1>
<Filename Value="testbase.pas"/>
<UnitName Value="TestBase"/>
@ -37,6 +37,10 @@
<Filename Value="testgdbmicontrol.lfm"/>
<Type Value="LFM"/>
</Item4>
<Item5>
<Filename Value="testwatchutils.pas"/>
<UnitName Value="testwatchutils"/>
</Item5>
</Files>
<Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="3">

11
components/lazdebuggergdbmi/test/gdbmitestutils/testbase.pas
View File

@ -6,7 +6,7 @@ interface
uses
Classes, SysUtils, FileUtil, fpcunit, testutils, testregistry,
LCLProc, LazLogger, DbgIntfDebuggerBase, CompileHelpers, Dialogs,
LCLProc, LazLogger, DbgIntfDebuggerBase, CompileHelpers, Dialogs, TestGDBMIControl,
GDBMIDebugger; // , FpGdbmiDebugger;
// EnvironmentOpts, ExtToolDialog, TransferMacros,
@ -374,9 +374,11 @@ var
Logdir: String;
WriteLog, WriteLogOnErr: Boolean;
implementation
TestGdbClass: TGDBMIDebuggerClass = TGDBMIDebugger;
// TestGdbClass: TGDBMIDebuggerClass = TFPGDBMIDebugger;
uses TestGDBMIControl;
implementation
var
Compilers: TCompilerList = nil;
@ -610,8 +612,7 @@ end;
function TGDBTestCase.GdbClass: TGDBMIDebuggerClass;
begin
Result := TGDBMIDebugger;
//Result := TFPGDBMIDebugger;
Result := TestGdbClass;
end;
procedure TGDBTestCase.DoDbgOut(Sender: TObject; S: string; var Handled: Boolean);

59
components/lazdebuggergdbmi/test/gdbmitestutils/testgdbmicontrol.pas
View File

@ -6,7 +6,7 @@ interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
CheckLst, testregistry, fpcunit;
CheckLst, testregistry, fpcunit, GuiTestRunner;
type
@ -38,8 +38,22 @@ procedure WriteLogsOnErrChange(Sender: TObject);
var
TestControlForm: TTestControlForm;
procedure RegisterTestSelectors(ANames: array of string);
implementation
uses GuiTestRunner, TestBase;
uses TestBase;
var
TestSelectors: TStringList = nil;
procedure RegisterTestSelectors(ANames: array of string);
var
i: Integer;
begin
if TestSelectors = nil then TestSelectors := TStringList.Create;
for i := low(ANames) to high(ANames) do
TestSelectors.Add(ANames[i]);
end;
{$R *.lfm}
@ -50,6 +64,8 @@ var
i, j: Integer;
d: TDebuggerList;
c: TCompilerList;
s: String;
f: Boolean;
begin
OnShow := nil;
Top := TestRunner.Top;
@ -62,36 +78,13 @@ begin
else
EditLogDir.Text := ConfDir;
j := CheckListBox1.Items.Add('TTestExceptionOne');
CheckListBox1.Checked[j] := True;
j := CheckListBox1.Items.Add('TTestWatch');
CheckListBox1.Checked[j] := True;
j := CheckListBox1.Items.Add(' TTestWatch.Unstable');
CheckListBox1.Checked[j] := False;
j := CheckListBox1.Items.Add(' TTestWatch.Gdb');
CheckListBox1.Checked[j] := True;
j := CheckListBox1.Items.Add(' TTestWatch.All');
CheckListBox1.Checked[j] := True;
j := CheckListBox1.Items.Add(' TTestWatch.Mix');
CheckListBox1.Checked[j] := True;
j := CheckListBox1.Items.Add(' TTestWatch.Mix.All');
CheckListBox1.Checked[j] := True;
j := CheckListBox1.Items.Add(' TTestWatch.Cache');
CheckListBox1.Checked[j] := True;
j := CheckListBox1.Items.Add('TTestBreakPoint');
CheckListBox1.Checked[j] := True;
j := CheckListBox1.Items.Add(' TTestBreakPoint.StartMethod');
CheckListBox1.Checked[j] := True;
j := CheckListBox1.Items.Add(' TTestBreakPoint.BadAddr');
CheckListBox1.Checked[j] := True;
j := CheckListBox1.Items.Add(' TTestBreakPoint.BadInterrupt');
CheckListBox1.Checked[j] := True;
j := CheckListBox1.Items.Add(' TTestBreakPoint.BadInterrupt.All');
CheckListBox1.Checked[j] := False;
j := CheckListBox1.Items.Add('TTestEnvironment');
CheckListBox1.Checked[j] := True;
j := CheckListBox1.Items.Add('TTestArgV');
CheckListBox1.Checked[j] := True;
for i := 0 to TestSelectors.Count - 1 do begin
s := TestSelectors[i];
f := (s<>'') and (s[1] = '-');
if f then delete(s,1,1);
j := CheckListBox1.Items.Add(s);
CheckListBox1.Checked[j] := not f;
end;
d := GetDebuggers;
for i := 0 to d.Count - 1 do begin
@ -123,5 +116,7 @@ begin
WriteLog := CheckWriteLogs.Checked;
end;
finalization
TestSelectors.Free;
end.

585
components/lazdebuggergdbmi/test/gdbmitestutils/testwatchutils.pas Normal file
View File

@ -0,0 +1,585 @@
unit TestWatchUtils;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, TestBase, LazLoggerBase, DbgIntfBaseTypes, DbgIntfDebuggerBase,
SynRegExpr;
type
TWatchExpectationFlag =
(IgnDwrf, // ignore error for dwarf at all
IgnDwrf2, // ignore error for dwarf 2
IgnDwrf2IfNoSet, // ignore error for dwarf2 (-gw) without set
IgnDwrf3, // ignore error for dwarf 3
IgnStabs,
//IgnDwrfSet, // no dwarf2 with set // no dwarf3
IgnData, // Ignore the data part
IgnDataDw, // Ignore the data part, if dwarf
IgnDataDw2, // Ignore the data part, if dwarf 2
IgnDataDw3, // Ignore the data part, if dwarf 3
IgnDataSt, // Ignore the data part, if Stabs
IgnKind, // Ignore skSimple, ....
IgnKindDw,
IgnKindDw2,
IgnKindDw3,
IgnKindSt,
IgnKindPtr, // Ignore skSimple, ONLY if got kind=skPointer
IgnKindPtrDw,
IgnKindPtrDw2,
IgnKindPtrDw3,
IgnKindPtrSt,
IgnTpName, // Ignore the typename
IgnTpNameDw,
IgnTpNameDw2,
IgnTpNameDw3,
IgnTpNameSt,
fTstSkip, // Do not run test
fTstSkipDwarf3,
fTpMtch,
fTExpectNotFound
);
TWatchExpectationFlags = set of TWatchExpectationFlag;
const
WatchExpFlagMask: array[TSymbolType] of TWatchExpectationFlags
= ( {stNone} [],
{stStabs} [IgnStabs,
IgnData, IgnDataSt,
IgnKind, IgnKindSt,
IgnKindPtr, IgnKindPtrSt,
IgnTpName, IgnTpNameSt
],
{stDwarf} [IgnDwrf, IgnDwrf2, IgnDwrf2IfNoSet,
IgnData, IgnDataDw, IgnDataDw2,
IgnKind, IgnKindDw, IgnKindDw2,
IgnKindPtr, IgnKindPtrDw, IgnKindPtrDw2,
IgnTpName, IgnTpNameDw, IgnTpNameDw2
],
{stDwarfSet} [IgnDwrf, IgnDwrf2,
IgnData, IgnDataDw, IgnDataDw2,
IgnKind, IgnKindDw, IgnKindDw2,
IgnKindPtr, IgnKindPtrDw, IgnKindPtrDw2,
IgnTpName, IgnTpNameDw, IgnTpNameDw2
],
{stDwarf3} [IgnDwrf, IgnDwrf3,
IgnData, IgnDataDw, IgnDataDw3,
IgnKind, IgnKindDw, IgnKindDw3,
IgnKindPtr, IgnKindPtrDw, IgnKindPtrDw3,
IgnTpName, IgnTpNameDw, IgnTpNameDw3
]
);
WatchExpFlagSIgnAll = [IgnStabs, IgnDwrf, IgnDwrf2, IgnDwrf2IfNoSet, IgnDwrf3];
WatchExpFlagSIgnData = [IgnStabs, IgnDwrf, IgnDwrf2, IgnDwrf2IfNoSet, IgnDwrf3, IgnData, IgnDataDw, IgnDataDw2, IgnDataDw3, IgnDataSt];
WatchExpFlagSIgnKind = [IgnStabs, IgnDwrf, IgnDwrf2, IgnDwrf2IfNoSet, IgnDwrf3, IgnKind, IgnKindDw, IgnKindDw2, IgnKindDw3, IgnKindSt];
WatchExpFlagSIgnKindPtr = [IgnStabs, IgnDwrf, IgnDwrf2, IgnDwrf2IfNoSet, IgnDwrf3, IgnKindPtr, IgnKindPtrDw, IgnKindPtrDw2, IgnKindPtrDw3, IgnKindPtrSt];
WatchExpFlagSIgnTpName = [IgnStabs, IgnDwrf, IgnDwrf2, IgnDwrf2IfNoSet, IgnDwrf3, IgnTpName, IgnTpNameDw, IgnTpNameDw2, IgnTpNameDw3, IgnTpNameSt];
type
TFullTypeMemberExpectationResult = record
Name: string;
ExpTypeName: string;
ExpKind: TDbgSymbolKind;
Flgs: TWatchExpectationFlags;
end;
TFullTypeMemberExpectationResultArray = array of TFullTypeMemberExpectationResult;
PWatchExpectation= ^TWatchExpectation;
TWatchExpectationResult = record
ExpMatch: string;
ExpKind: TDBGSymbolKind;
ExpTypeName: string;
Flgs: TWatchExpectationFlags;
MinGdb, MinFpc: Integer;
FullTypesExpect: TFullTypeMemberExpectationResultArray;
end;
TWatchExpectation = record
TestName: String;
Expression: string;
DspFormat: TWatchDisplayFormat;
EvaluateFlags: TDBGEvaluateFlags;
StackFrame: Integer;
Result: Array [TSymbolType] of TWatchExpectationResult;
end;
TWatchExpectationArray = array of TWatchExpectation;
TTestWatchArray = Array of TTestWatch;
{ TTestWatchesBase }
TTestWatchesBase = class(TGDBTestCase)
protected
procedure TestWatch(Name: String; ADbg: TDebuggerIntf;
AWatch: TTestWatch; Data: TWatchExpectation; WatchValue: String = '');
procedure AddWatches(ExpectList: TWatchExpectationArray; var WatchList: TTestWatchArray;
AWatches: TWatches;
Only: Integer; OnlyName, OnlyNamePart: String);
procedure TestWatchList(AName: String; ExpectList: TWatchExpectationArray; WatchList: TTestWatchArray;
ADbg: TDebuggerIntf;
Only: Integer; OnlyName, OnlyNamePart: String);
end;
function AddWatchExp(var ExpArray: TWatchExpectationArray;
AnExpr: string; AFmt: TWatchDisplayFormat;
AMtch: string; AKind: TDBGSymbolKind; ATpNm: string;
AFlgs: TWatchExpectationFlags = [];
AStackFrame: Integer = 0;
AMinGdb: Integer = 0; AMinFpc: Integer = 0
): PWatchExpectation;
function AddWatchExp(var ExpArray: TWatchExpectationArray;
AnExpr: string; AFmt: TWatchDisplayFormat; AEvaluateFlags: TDBGEvaluateFlags;
AMtch: string; AKind: TDBGSymbolKind; ATpNm: string;
AFlgs: TWatchExpectationFlags = [];
AStackFrame: Integer = 0;
AMinGdb: Integer = 0; AMinFpc: Integer = 0
): PWatchExpectation;
function AddWatchExp(var ExpArray: TWatchExpectationArray; ATestName: String;
AnExpr: string; AFmt: TWatchDisplayFormat;
AMtch: string; AKind: TDBGSymbolKind; ATpNm: string;
AFlgs: TWatchExpectationFlags = [];
AStackFrame: Integer = 0;
AMinGdb: Integer = 0; AMinFpc: Integer = 0
): PWatchExpectation;
function AddWatchExp(var ExpArray: TWatchExpectationArray; ATestName: String;
AnExpr: string; AFmt: TWatchDisplayFormat; AEvaluateFlags: TDBGEvaluateFlags;
AMtch: string; AKind: TDBGSymbolKind; ATpNm: string;
AFlgs: TWatchExpectationFlags = [];
AStackFrame: Integer = 0;
AMinGdb: Integer = 0; AMinFpc: Integer = 0
): PWatchExpectation;
procedure UpdExpRes(AWatchExp: PWatchExpectation; ASymbolType: TSymbolType;
AMtch: string; AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags;
AMinGdb: Integer; AMinFpc: Integer
);
procedure UpdExpRes(AWatchExp: PWatchExpectation; ASymbolType: TSymbolType;
AMtch: string; AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags = []
);
procedure UpdExpRes(AWatchExp: PWatchExpectation; ASymbolType: TSymbolType;
AMtch: string; AKind: TDBGSymbolKind
);
procedure UpdExpRes(AWatchExp: PWatchExpectation; ASymbolType: TSymbolType;
AKind: TDBGSymbolKind
);
procedure UpdExpRes(AWatchExp: PWatchExpectation; ASymbolType: TSymbolType;
ATpNm: string; AFlgs: TWatchExpectationFlags
);
procedure UpdResMinGdb(AWatchExp: PWatchExpectation; ASymbolType: TSymbolType; AMinGdb: Integer);
procedure UpdResMinFpc(AWatchExp: PWatchExpectation; ASymbolType: TSymbolType; AMinFpc: Integer);
procedure UpdExpRes(AWatchExp: PWatchExpectation; ASymbolTypes: TSymbolTypes;
ATpNm: string; AFlgs: TWatchExpectationFlags
);
procedure UpdResMinGdb(AWatchExp: PWatchExpectation; ASymbolTypes: TSymbolTypes; AMinGdb: Integer);
procedure UpdResMinFpc(AWatchExp: PWatchExpectation; ASymbolTypes: TSymbolTypes; AMinFpc: Integer);
procedure AddMemberExpect(AWatchExp: PWatchExpectation;
AName, ATpNm: string; AFlgs: TWatchExpectationFlags; AnExpKind: TDBGSymbolKind;
ASymbolTypes: TSymbolTypes = stSymAll
);
implementation
function AddWatchExp(var ExpArray: TWatchExpectationArray; AnExpr: string;
AFmt: TWatchDisplayFormat; AMtch: string; AKind: TDBGSymbolKind; ATpNm: string;
AFlgs: TWatchExpectationFlags; AStackFrame: Integer = 0; AMinGdb: Integer = 0;
AMinFpc: Integer = 0): PWatchExpectation;
begin
Result := AddWatchExp(ExpArray,
AnExpr + ' (' + TWatchDisplayFormatNames[AFmt] + ', []',
AnExpr, AFmt, [], AMtch, AKind, ATpNm, AFlgs, AStackFrame, AMinGdb, AMinFpc);
end;
function AddWatchExp(var ExpArray: TWatchExpectationArray; AnExpr: string;
AFmt: TWatchDisplayFormat; AEvaluateFlags: TDBGEvaluateFlags; AMtch: string;
AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags; AStackFrame: Integer;
AMinGdb: Integer; AMinFpc: Integer): PWatchExpectation;
begin
Result := AddWatchExp(ExpArray,
AnExpr + ' (' + TWatchDisplayFormatNames[AFmt] + ', ' + dbgs(AEvaluateFlags) + ')',
AnExpr, AFmt, AEvaluateFlags, AMtch, AKind, ATpNm, AFlgs, AStackFrame, AMinGdb, AMinFpc);
end;
function AddWatchExp(var ExpArray: TWatchExpectationArray; ATestName: String;
AnExpr: string; AFmt: TWatchDisplayFormat; AMtch: string; AKind: TDBGSymbolKind;
ATpNm: string; AFlgs: TWatchExpectationFlags; AStackFrame: Integer; AMinGdb: Integer = 0;
AMinFpc: Integer = 0): PWatchExpectation;
begin
Result := AddWatchExp(ExpArray, ATestName, AnExpr, AFmt, [], AMtch, AKind, ATpNm,
AFlgs, AStackFrame, AMinGdb, AMinFpc);
end;
function AddWatchExp(var ExpArray: TWatchExpectationArray; ATestName: String;
AnExpr: string; AFmt: TWatchDisplayFormat; AEvaluateFlags: TDBGEvaluateFlags; AMtch: string;
AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags; AStackFrame: Integer;
AMinGdb: Integer; AMinFpc: Integer): PWatchExpectation;
var
i: TSymbolType;
begin
SetLength(ExpArray, Length(ExpArray)+1);
with ExpArray[Length(ExpArray)-1] do begin
TestName := ATestName;
Expression := AnExpr;
DspFormat := AFmt;
EvaluateFlags := AEvaluateFlags;
for i := low(TSymbolType) to high(TSymbolType) do begin
Result[i].ExpMatch := AMtch;
Result[i].ExpKind := AKind;
Result[i].ExpTypeName := ATpNm;
Result[i].Flgs := AFlgs;
Result[i].MinGdb := AMinGdb;
Result[i].MinFpc := AMinFpc;
end;
StackFrame := AStackFrame;
end;
Result := @ExpArray[Length(ExpArray)-1];
end;
procedure UpdExpRes(AWatchExp: PWatchExpectation; ASymbolType: TSymbolType;
AMtch: string; AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags;
AMinGdb: Integer; AMinFpc: Integer);
begin
with AWatchExp^ do begin
Result[ASymbolType].ExpMatch := AMtch;
Result[ASymbolType].ExpKind := AKind;
Result[ASymbolType].ExpTypeName := ATpNm;
Result[ASymbolType].Flgs := AFlgs;
Result[ASymbolType].MinGdb := AMinGdb;
Result[ASymbolType].MinFpc := AMinFpc;
end;
end;
procedure UpdExpRes(AWatchExp: PWatchExpectation; ASymbolType: TSymbolType;
AMtch: string; AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags);
begin
with AWatchExp^ do begin
Result[ASymbolType].ExpMatch := AMtch;
Result[ASymbolType].ExpKind := AKind;
Result[ASymbolType].ExpTypeName := ATpNm;
Result[ASymbolType].Flgs := AFlgs;
end;
end;
procedure UpdExpRes(AWatchExp: PWatchExpectation; ASymbolType: TSymbolType;
AMtch: string; AKind: TDBGSymbolKind);
begin
with AWatchExp^ do begin
Result[ASymbolType].ExpMatch := AMtch;
Result[ASymbolType].ExpKind := AKind;
end;
end;
procedure UpdExpRes(AWatchExp: PWatchExpectation; ASymbolType: TSymbolType;
AKind: TDBGSymbolKind);
begin
with AWatchExp^ do begin
Result[ASymbolType].ExpKind := AKind;
end;
end;
procedure UpdExpRes(AWatchExp: PWatchExpectation; ASymbolType: TSymbolType;
ATpNm: string; AFlgs: TWatchExpectationFlags);
begin
with AWatchExp^ do begin
Result[ASymbolType].ExpTypeName := ATpNm;
Result[ASymbolType].Flgs := AFlgs;
end;
end;
procedure UpdExpRes(AWatchExp: PWatchExpectation; ASymbolTypes: TSymbolTypes;
ATpNm: string; AFlgs: TWatchExpectationFlags);
var
i: TSymbolType;
begin
for i := low(TSymbolType) to high(TSymbolType) do
if i in ASymbolTypes then
UpdExpRes(AWatchExp, i, ATpNm, AFlgs);
end;
procedure UpdResMinGdb(AWatchExp: PWatchExpectation; ASymbolTypes: TSymbolTypes;
AMinGdb: Integer);
var
i: TSymbolType;
begin
for i := low(TSymbolType) to high(TSymbolType) do
if i in ASymbolTypes then
UpdResMinGdb(AWatchExp, i, AMinGdb);
end;
procedure UpdResMinFpc(AWatchExp: PWatchExpectation; ASymbolTypes: TSymbolTypes;
AMinFpc: Integer);
var
i: TSymbolType;
begin
for i := low(TSymbolType) to high(TSymbolType) do
if i in ASymbolTypes then
UpdResMinFpc(AWatchExp, i, AMinFpc);
end;
procedure AddMemberExpect(AWatchExp: PWatchExpectation; AName, ATpNm: string;
AFlgs: TWatchExpectationFlags; AnExpKind: TDBGSymbolKind; ASymbolTypes: TSymbolTypes);
var
i: TSymbolType;
l: Integer;
begin
for i := low(TSymbolType) to high(TSymbolType) do
if i in ASymbolTypes then begin
l := length(AWatchExp^.Result[i].FullTypesExpect);
SetLength(AWatchExp^.Result[i].FullTypesExpect, l + 1);
AWatchExp^.Result[i].FullTypesExpect[l].Name := AName;
AWatchExp^.Result[i].FullTypesExpect[l].ExpTypeName := ATpNm;
AWatchExp^.Result[i].FullTypesExpect[l].ExpKind := AnExpKind;
AWatchExp^.Result[i].FullTypesExpect[l].Flgs := AFlgs;
end;
end;
procedure UpdResMinGdb(AWatchExp: PWatchExpectation; ASymbolType: TSymbolType;
AMinGdb: Integer);
begin
with AWatchExp^ do begin
Result[ASymbolType].MinGdb := AMinGdb;
end;
end;
procedure UpdResMinFpc(AWatchExp: PWatchExpectation; ASymbolType: TSymbolType;
AMinFpc: Integer);
begin
with AWatchExp^ do begin
Result[ASymbolType].MinFpc := AMinFpc;
end;
end;
var
Frx: TRegExpr;
{ TTestWatchesBase }
procedure TTestWatchesBase.TestWatch(Name: String; ADbg: TDebuggerIntf; AWatch: TTestWatch;
Data: TWatchExpectation; WatchValue: String);
var
rx: TRegExpr;
s, s2: String;
flag, IsValid, HasTpInfo, f2: Boolean;
WV: TWatchValue;
Stack: Integer;
n: String;
DataRes: TWatchExpectationResult;
IgnoreFlags: TWatchExpectationFlags;
IgnoreAll, IgnoreData, IgnoreKind, IgnoreKindPtr, IgnoreTpName: boolean;
IgnoreText: String;
i, j: Integer;
fld: TDBGField;
MemberTests: TFullTypeMemberExpectationResultArray;
function CmpNames(TestName, Exp, Got: String; Match: Boolean): Boolean;
begin
if Match then begin
if Frx = nil then Frx := TRegExpr.Create;
Frx.ModifierI := true;
Frx.Expression := Exp;
TestTrue(TestName + ' matches '+Exp+' but was '+Got, Frx.Exec(Got), DataRes.MinGdb, DataRes.MinFpc, IgnoreText);
end
else TestEquals(TestName + ' equals ', LowerCase(Exp), LowerCase(Got), DataRes.MinGdb, DataRes.MinFpc, IgnoreText);
end;
begin
if not TestTrue('Dbg did NOT enter dsError', ADbg.State <> dsError) then exit;
rx := nil;
Stack := Data.StackFrame;
DataRes := Data.Result[SymbolType];
IgnoreFlags := DataRes.Flgs * WatchExpFlagMask[SymbolType];
IgnoreAll := IgnoreFlags * WatchExpFlagSIgnAll <> [];
IgnoreData := IgnoreFlags * WatchExpFlagSIgnData <> [];
IgnoreKind := IgnoreFlags * WatchExpFlagSIgnKind <> [];
IgnoreKindPtr := IgnoreFlags * WatchExpFlagSIgnKindPtr <> [];
IgnoreTpName := IgnoreFlags * WatchExpFlagSIgnTpName <> [];
// Get Value
n := Data.TestName;
LogToFile('###### ' + n + '######' +LineEnding);
if n = '' then n := Data.Expression + ' (' + TWatchDisplayFormatNames[Data.DspFormat] + ', ' + dbgs(Data.EvaluateFlags) + ')';
Name := Name + ' ' + n;
flag := AWatch <> nil; // test for typeinfo/kind // Awatch=nil > direct gdb command
IsValid := True;
HasTpInfo := True;
if flag then begin;
WV := AWatch.Values[1, Stack];// trigger read
s := WV.Value;
IsValid := WV.Validity = ddsValid;
HasTpInfo := IsValid and (WV.TypeInfo <> nil);
// flag := flag and IsValid;
end
else
s := WatchValue;
if not TestTrue('ADbg did NOT enter dsError', ADbg.State <> dsError) then exit;
// Check Data
f2 := True;
IgnoreText := ''; if IgnoreData then IgnoreText := 'Ignored by flag';
if IsValid then begin
rx := TRegExpr.Create;
rx.ModifierI := true;
rx.Expression := DataRes.ExpMatch;
if DataRes.ExpMatch <> ''
then f2 := TestTrue(Name + ' Matches "'+DataRes.ExpMatch + '", but was "' + s + '"', rx.Exec(s), DataRes.MinGdb, DataRes.MinFpc, IgnoreText);
FreeAndNil(rx);
end else begin
f2 := TestTrue(Name + ' Matches "'+DataRes.ExpMatch + '", but STATE was <'+dbgs(WV.Validity)+'> Val="'+s+'"', False, DataRes.MinGdb, DataRes.MinFpc, IgnoreText);
//exit; // failed Data, do not list others as potential unexpected success
end;
if (not f2) and IgnoreAll then exit; // failed Data, do not list others as potential unexpected success
// TypeInfo checks ?
if (not flag) or (DataRes.ExpTypeName = '') then exit;
// Check TypeInfo
s:='';
if HasTpInfo then WriteStr(s, WV.TypeInfo.Kind);
WriteStr(s2, DataRes.ExpKind);
IgnoreText := ''; if IgnoreKind then IgnoreText := 'Ignored by flag';
if IsValid and HasTpInfo then begin
if (not IgnoreKind) and IgnoreKindPtr and (WV.TypeInfo.Kind = skPointer) then IgnoreText := 'Ignored by flag (Kind may be Ptr)';
f2 := TestEquals(Name + ' Kind', s2, s, DataRes.MinGdb, DataRes.MinFpc, IgnoreText);
end else begin
f2 := TestTrue(Name + ' Kind is "'+s2+'", failed: STATE was <'+dbgs(WV.Validity)+'>, HasTypeInfo='+dbgs(HasTpInfo)+' Val="'+s+'"', False, DataRes.MinGdb, DataRes.MinFpc, IgnoreText);
end;
if (not f2) and IgnoreAll then exit; // failed Data, do not list others as potential unexpected success
// Check TypeName
IgnoreText := ''; if IgnoreTpName then IgnoreText := 'Ignored by flag';
if IsValid and HasTpInfo then begin
s:='';
if HasTpInfo then s := WV.TypeInfo.TypeName;
CmpNames(Name+' TypeName', DataRes.ExpTypeName, s, fTpMtch in DataRes.Flgs);
//if fTpMtch in DataRes.Flgs
//then begin
// rx := TRegExpr.Create;
// rx.ModifierI := true;
// rx.Expression := DataRes.ExpTypeName;
// TestTrue(Name + ' TypeName matches '+DataRes.ExpTypeName+' but was '+s, rx.Exec(s), DataRes.MinGdb, DataRes.MinFpc, IgnoreText);
// FreeAndNil(rx);
// end
// else TestEquals(Name + ' TypeName', LowerCase(DataRes.ExpTypeName), LowerCase(s), DataRes.MinGdb, DataRes.MinFpc, IgnoreText);
end else begin
TestTrue(Name + ' TypeName matches '+DataRes.ExpTypeName+' but STATE was <'+dbgs(WV.Validity)+'> HasTypeInfo='+dbgs(HasTpInfo)+' Val="'+s+'"', False, DataRes.MinGdb, DataRes.MinFpc, IgnoreText);
end;
MemberTests := DataRes.FullTypesExpect;
if Length(MemberTests) > 0 then begin
if HasTpInfo then begin
for i := 0 to Length(MemberTests) - 1 do begin
j := WV.TypeInfo.Fields.Count - 1;
while (j >= 0) and (uppercase(WV.TypeInfo.Fields[j].Name) <> UpperCase(MemberTests[i].Name)) do dec(j);
TestTrue(Name + ' no members with name ' + MemberTests[i].Name,
(fTExpectNotFOund in MemberTests[i].Flgs) <> (j >= 0),
DataRes.MinGdb, DataRes.MinFpc, IgnoreText);;
if j >= 0 then begin
fld := WV.TypeInfo.Fields[j];
WriteStr(s, MemberTests[i].ExpKind);
WriteStr(s2, fld.DBGType.Kind);
if fld.DBGType <> nil then begin
TestTrue(Name + ' members with name ' + MemberTests[i].Name + ' type='
+ s + ' but was ' + s2,
MemberTests[i].ExpKind = fld.DBGType.Kind, DataRes.MinGdb, DataRes.MinFpc, IgnoreText);;
CmpNames(Name + ' members with name ' + MemberTests[i].Name + 'TypeName',
MemberTests[i].ExpTypeName, fld.DBGType.TypeName, fTpMtch in MemberTests[i].Flgs);
end
else
TestTrue(Name + ' no dbgtype for members with name' + MemberTests[i].Name, False, DataRes.MinGdb, DataRes.MinFpc, IgnoreText);;
end;
end;
end
else
TestTrue(Name + ' no typeinfo for members' , False, DataRes.MinGdb, DataRes.MinFpc, IgnoreText);;
end;
end;
procedure TTestWatchesBase.AddWatches(ExpectList: TWatchExpectationArray;
var WatchList: TTestWatchArray; AWatches: TWatches; Only: Integer; OnlyName,
OnlyNamePart: String);
function SkipTest(const Data: TWatchExpectation): Boolean;
begin
Result := True;
if Data.Result[SymbolType].Flgs * [fTstSkip, fTstSkipDwarf3] <> [] then exit;
Result := False;
end;
function MatchOnly(const Data: TWatchExpectation; Idx: Integer): Boolean;
begin
Result := True;
if ((Only >=0) and (Only <> Idx)) or
((OnlyName<>'') and (OnlyName <> Data.TestName)) or
((OnlyNamePart<>'') and (pos(OnlyNamePart, Data.TestName)<1))
then Result := False;
end;
var
i: Integer;
begin
SetLength(WatchList, length(ExpectList));
for i := low(ExpectList) to high(ExpectList) do begin
if not MatchOnly(ExpectList[i], i) then continue;
if not SkipTest(ExpectList[i]) then begin
WatchList[i] := TTestWatch.Create(AWatches);
WatchList[i].Expression := ExpectList[i].Expression;
WatchList[i].DisplayFormat := ExpectList[i].DspFormat;
WatchList[i].EvaluateFlags:= ExpectList[i].EvaluateFlags;
WatchList[i].enabled := True;
end;
end;
end;
procedure TTestWatchesBase.TestWatchList(AName: String; ExpectList: TWatchExpectationArray;
WatchList: TTestWatchArray; ADbg: TDebuggerIntf; Only: Integer; OnlyName,
OnlyNamePart: String);
function SkipTest(const Data: TWatchExpectation): Boolean;
begin
Result := True;
if Data.Result[SymbolType].Flgs * [fTstSkip, fTstSkipDwarf3] <> [] then exit;
Result := False;
end;
function MatchOnly(const Data: TWatchExpectation; Idx: Integer): Boolean;
begin
Result := True;
if ((Only >=0) and (Only <> Idx)) or
((OnlyName<>'') and (OnlyName <> Data.TestName)) or
((OnlyNamePart<>'') and (pos(OnlyNamePart, Data.TestName)<1))
then Result := False;
end;
var
i: Integer;
begin
for i := low(ExpectList) to high(ExpectList) do begin
if not MatchOnly(ExpectList[i], i) then continue;
if not SkipTest(ExpectList[i]) then
TestWatch(AName + ' '+IntToStr(i)+' ', ADbg, WatchList[i], ExpectList[i]);
end;
end;
finalization
FreeAndNil(Frx);
end.

2
components/lazdebuggergdbmi/test/testargv.pas
View File

@ -77,6 +77,8 @@ end;
initialization
RegisterDbgTest(TTestArgV);
RegisterTestSelectors(['TTestArgV'
]);
end.

7
components/lazdebuggergdbmi/test/testbreakpoint.pas
View File

@ -481,5 +481,12 @@ end;
initialization
RegisterDbgTest(TTestBreakPoint);
RegisterTestSelectors(['TTestBreakPoint',
' TTestBreakPoint.StartMethod',
' TTestBreakPoint.BadAddr',
' TTestBreakPoint.BadInterrupt',
' TTestBreakPoint.BadInterrupt.All'
]);
end.

2
components/lazdebuggergdbmi/test/testenvironment.pas
View File

@ -108,6 +108,8 @@ end;
initialization
RegisterDbgTest(TTestEnvironment);
RegisterTestSelectors(['TTestEnvironment'
]);
end.

2
components/lazdebuggergdbmi/test/testexception.pas
View File

@ -220,6 +220,8 @@ end;
initialization
RegisterDbgTest(TTestExceptionOne);
RegisterTestSelectors(['TTestExceptionOne'
]);
end.

651
components/lazdebuggergdbmi/test/testwatches.pas
View File

@ -6,7 +6,7 @@ interface
uses
Classes, SysUtils, fpcunit, testutils, testregistry, TestGDBMIControl, DbgIntfBaseTypes,
DbgIntfDebuggerBase, TestBase, GDBMIDebugger, LCLProc, SynRegExpr;
DbgIntfDebuggerBase, TestBase, GDBMIDebugger, LCLProc, SynRegExpr, TestWatchUtils;
const
BREAK_LINE_FOOFUNC_NEST = 206;
@ -26,119 +26,14 @@ const
- FooObject = BarObject (dwarf 3)
*)
type
TWatchExpectationFlag =
(IgnDwrf, // ignore error for dwarf at all
IgnDwrf2, // ignore error for dwarf 2
IgnDwrf2IfNoSet, // ignore error for dwarf2 (-gw) without set
IgnDwrf3, // ignore error for dwarf 3
IgnStabs,
//IgnDwrfSet, // no dwarf2 with set // no dwarf3
IgnData, // Ignore the data part
IgnDataDw, // Ignore the data part, if dwarf
IgnDataDw2, // Ignore the data part, if dwarf 2
IgnDataDw3, // Ignore the data part, if dwarf 3
IgnDataSt, // Ignore the data part, if Stabs
IgnKind, // Ignore skSimple, ....
IgnKindDw,
IgnKindDw2,
IgnKindDw3,
IgnKindSt,
IgnKindPtr, // Ignore skSimple, ONLY if got kind=skPointer
IgnKindPtrDw,
IgnKindPtrDw2,
IgnKindPtrDw3,
IgnKindPtrSt,
IgnTpName, // Ignore the typename
IgnTpNameDw,
IgnTpNameDw2,
IgnTpNameDw3,
IgnTpNameSt,
fTstSkip, // Do not run test
fTstSkipDwarf3,
fTpMtch,
fTExpectNotFound
);
TWatchExpectationFlags = set of TWatchExpectationFlag;
const
WatchExpFlagMask: array[TSymbolType] of TWatchExpectationFlags
= ( {stNone} [],
{stStabs} [IgnStabs,
IgnData, IgnDataSt,
IgnKind, IgnKindSt,
IgnKindPtr, IgnKindPtrSt,
IgnTpName, IgnTpNameSt
],
{stDwarf} [IgnDwrf, IgnDwrf2, IgnDwrf2IfNoSet,
IgnData, IgnDataDw, IgnDataDw2,
IgnKind, IgnKindDw, IgnKindDw2,
IgnKindPtr, IgnKindPtrDw, IgnKindPtrDw2,
IgnTpName, IgnTpNameDw, IgnTpNameDw2
],
{stDwarfSet} [IgnDwrf, IgnDwrf2,
IgnData, IgnDataDw, IgnDataDw2,
IgnKind, IgnKindDw, IgnKindDw2,
IgnKindPtr, IgnKindPtrDw, IgnKindPtrDw2,
IgnTpName, IgnTpNameDw, IgnTpNameDw2
],
{stDwarf3} [IgnDwrf, IgnDwrf3,
IgnData, IgnDataDw, IgnDataDw3,
IgnKind, IgnKindDw, IgnKindDw3,
IgnKindPtr, IgnKindPtrDw, IgnKindPtrDw3,
IgnTpName, IgnTpNameDw, IgnTpNameDw3
]
);
WatchExpFlagSIgnAll = [IgnStabs, IgnDwrf, IgnDwrf2, IgnDwrf2IfNoSet, IgnDwrf3];
WatchExpFlagSIgnData = [IgnStabs, IgnDwrf, IgnDwrf2, IgnDwrf2IfNoSet, IgnDwrf3, IgnData, IgnDataDw, IgnDataDw2, IgnDataDw3, IgnDataSt];
WatchExpFlagSIgnKind = [IgnStabs, IgnDwrf, IgnDwrf2, IgnDwrf2IfNoSet, IgnDwrf3, IgnKind, IgnKindDw, IgnKindDw2, IgnKindDw3, IgnKindSt];
WatchExpFlagSIgnKindPtr = [IgnStabs, IgnDwrf, IgnDwrf2, IgnDwrf2IfNoSet, IgnDwrf3, IgnKindPtr, IgnKindPtrDw, IgnKindPtrDw2, IgnKindPtrDw3, IgnKindPtrSt];
WatchExpFlagSIgnTpName = [IgnStabs, IgnDwrf, IgnDwrf2, IgnDwrf2IfNoSet, IgnDwrf3, IgnTpName, IgnTpNameDw, IgnTpNameDw2, IgnTpNameDw3, IgnTpNameSt];
type
TFullTypeMemberExpectationResult = record
Name: string;
ExpTypeName: string;
ExpKind: TDBGSymbolKind;
Flgs: TWatchExpectationFlags;
end;
TFullTypeMemberExpectationResultArray = array of TFullTypeMemberExpectationResult;
PWatchExpectation= ^TWatchExpectation;
TWatchExpectationResult = record
ExpMatch: string;
ExpKind: TDBGSymbolKind;
ExpTypeName: string;
Flgs: TWatchExpectationFlags;
MinGdb, MinFpc: Integer;
FullTypesExpect: TFullTypeMemberExpectationResultArray;
end;
TWatchExpectation = record
TestName: String;
Expression: string;
DspFormat: TWatchDisplayFormat;
EvaluateFlags: TDBGEvaluateFlags;
StackFrame: Integer;
Result: Array [TSymbolType] of TWatchExpectationResult;
end;
TWatchExpectationArray = array of TWatchExpectation;
{ TTestWatches }
TTestWatches = class(TGDBTestCase)
TTestWatches = class(TTestWatchesBase)
private
FWatches: TWatches;
Frx: TRegExpr;
ExpectBreakFooGdb: TWatchExpectationArray; // direct commands to gdb, to check assumptions // only Exp and Mtch
@ -155,35 +50,6 @@ type
procedure DoDbgOutput(Sender: TObject; const AText: String); override;
procedure ClearAllTestArrays;
function HasTestArraysData: Boolean;
function AddTo(var ExpArray: TWatchExpectationArray;
AnExpr: string; AFmt: TWatchDisplayFormat;
AMtch: string; AKind: TDBGSymbolKind; ATpNm: string;
AFlgs: TWatchExpectationFlags = [];
AStackFrame: Integer = 0;
AMinGdb: Integer = 0; AMinFpc: Integer = 0
): PWatchExpectation;
function AddTo(var ExpArray: TWatchExpectationArray;
AnExpr: string; AFmt: TWatchDisplayFormat; AEvaluateFlags: TDBGEvaluateFlags;
AMtch: string; AKind: TDBGSymbolKind; ATpNm: string;
AFlgs: TWatchExpectationFlags = [];
AStackFrame: Integer = 0;
AMinGdb: Integer = 0; AMinFpc: Integer = 0
): PWatchExpectation;
function AddTo(var ExpArray: TWatchExpectationArray; ATestName: String;
AnExpr: string; AFmt: TWatchDisplayFormat;
AMtch: string; AKind: TDBGSymbolKind; ATpNm: string;
AFlgs: TWatchExpectationFlags = [];
AStackFrame: Integer = 0;
AMinGdb: Integer = 0; AMinFpc: Integer = 0
): PWatchExpectation;
function AddTo(var ExpArray: TWatchExpectationArray; ATestName: String;
AnExpr: string; AFmt: TWatchDisplayFormat; AEvaluateFlags: TDBGEvaluateFlags;
AMtch: string; AKind: TDBGSymbolKind; ATpNm: string;
AFlgs: TWatchExpectationFlags = [];
AStackFrame: Integer = 0;
AMinGdb: Integer = 0; AMinFpc: Integer = 0
): PWatchExpectation;
// using FCurrentExpArray
function Add(AnExpr: string; AFmt: TWatchDisplayFormat; AMtch: string;
AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags): PWatchExpectation;
@ -199,35 +65,6 @@ type
function AddPointerFmtDefRaw(AnExpr, AMtch, ATpNm: string; AFlgs: TWatchExpectationFlags=[]): PWatchExpectation;
procedure UpdRes(AWatchExp: PWatchExpectation; ASymbolType: TSymbolType;
AMtch: string; AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags;
AMinGdb: Integer; AMinFpc: Integer
);
procedure UpdRes(AWatchExp: PWatchExpectation; ASymbolType: TSymbolType;
AMtch: string; AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags = []
);
procedure UpdRes(AWatchExp: PWatchExpectation; ASymbolType: TSymbolType;
AMtch: string; AKind: TDBGSymbolKind
);
procedure UpdRes(AWatchExp: PWatchExpectation; ASymbolType: TSymbolType;
AKind: TDBGSymbolKind
);
procedure UpdRes(AWatchExp: PWatchExpectation; ASymbolType: TSymbolType;
ATpNm: string; AFlgs: TWatchExpectationFlags
);
procedure UpdResMinGdb(AWatchExp: PWatchExpectation; ASymbolType: TSymbolType; AMinGdb: Integer);
procedure UpdResMinFpc(AWatchExp: PWatchExpectation; ASymbolType: TSymbolType; AMinFpc: Integer);
procedure UpdRes(AWatchExp: PWatchExpectation; ASymbolTypes: TSymbolTypes;
ATpNm: string; AFlgs: TWatchExpectationFlags
);
procedure UpdResMinGdb(AWatchExp: PWatchExpectation; ASymbolTypes: TSymbolTypes; AMinGdb: Integer);
procedure UpdResMinFpc(AWatchExp: PWatchExpectation; ASymbolTypes: TSymbolTypes; AMinFpc: Integer);
procedure AddMemberExpect(AWatchExp: PWatchExpectation;
AName, ATpNm: string; AFlgs: TWatchExpectationFlags; AnExpKind: TDBGSymbolKind;
ASymbolTypes: TSymbolTypes = stSymAll
);
procedure AddExpectBreakFooGdb;
procedure AddExpectBreakFooAll;
@ -306,74 +143,17 @@ begin
end;
function TTestWatches.AddTo(var ExpArray: TWatchExpectationArray; AnExpr: string;
AFmt: TWatchDisplayFormat; AMtch: string; AKind: TDBGSymbolKind; ATpNm: string;
AFlgs: TWatchExpectationFlags; AStackFrame: Integer = 0; AMinGdb: Integer = 0;
AMinFpc: Integer = 0): PWatchExpectation;
begin
Result := AddTo(ExpArray,
AnExpr + ' (' + TWatchDisplayFormatNames[AFmt] + ', []',
AnExpr, AFmt, [], AMtch, AKind, ATpNm, AFlgs, AStackFrame, AMinGdb, AMinFpc);
end;
function TTestWatches.AddTo(var ExpArray: TWatchExpectationArray; AnExpr: string;
AFmt: TWatchDisplayFormat; AEvaluateFlags: TDBGEvaluateFlags; AMtch: string;
AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags; AStackFrame: Integer;
AMinGdb: Integer; AMinFpc: Integer): PWatchExpectation;
begin
Result := AddTo(ExpArray,
AnExpr + ' (' + TWatchDisplayFormatNames[AFmt] + ', ' + dbgs(AEvaluateFlags) + ')',
AnExpr, AFmt, AEvaluateFlags, AMtch, AKind, ATpNm, AFlgs, AStackFrame, AMinGdb, AMinFpc);
end;
function TTestWatches.AddTo(var ExpArray: TWatchExpectationArray; ATestName: String;
AnExpr: string; AFmt: TWatchDisplayFormat; AMtch: string; AKind: TDBGSymbolKind;
ATpNm: string; AFlgs: TWatchExpectationFlags; AStackFrame: Integer; AMinGdb: Integer = 0;
AMinFpc: Integer = 0): PWatchExpectation;
var
i: TSymbolType;
begin
Result := AddTo(ExpArray, ATestName, AnExpr, AFmt, [], AMtch, AKind, ATpNm,
AFlgs, AStackFrame, AMinGdb, AMinFpc);
end;
function TTestWatches.AddTo(var ExpArray: TWatchExpectationArray; ATestName: String;
AnExpr: string; AFmt: TWatchDisplayFormat; AEvaluateFlags: TDBGEvaluateFlags; AMtch: string;
AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags; AStackFrame: Integer;
AMinGdb: Integer; AMinFpc: Integer): PWatchExpectation;
var
i: TSymbolType;
begin
SetLength(ExpArray, Length(ExpArray)+1);
with ExpArray[Length(ExpArray)-1] do begin
TestName := ATestName;
Expression := AnExpr;
DspFormat := AFmt;
EvaluateFlags := AEvaluateFlags;
for i := low(TSymbolType) to high(TSymbolType) do begin
Result[i].ExpMatch := AMtch;
Result[i].ExpKind := AKind;
Result[i].ExpTypeName := ATpNm;
Result[i].Flgs := AFlgs;
Result[i].MinGdb := AMinGdb;
Result[i].MinFpc := AMinFpc;
end;
StackFrame := AStackFrame;
end;
Result := @ExpArray[Length(ExpArray)-1];
end;
function TTestWatches.Add(AnExpr: string; AFmt: TWatchDisplayFormat; AMtch: string;
AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags): PWatchExpectation;
begin
Result := AddTo(FCurrentExpArray^, AnExpr, AFmt, AMtch, AKind, ATpNm, AFlgs );
Result := AddWatchExp(FCurrentExpArray^, AnExpr, AFmt, AMtch, AKind, ATpNm, AFlgs );
end;
function TTestWatches.Add(AnExpr: string; AFmt: TWatchDisplayFormat;
AEvalFlags: TDBGEvaluateFlags; AMtch: string; AKind: TDBGSymbolKind; ATpNm: string;
AFlgs: TWatchExpectationFlags): PWatchExpectation;
begin
Result := AddTo(FCurrentExpArray^, AnExpr, AFmt, AEvalFlags, AMtch, AKind, ATpNm, AFlgs );
Result := AddWatchExp(FCurrentExpArray^, AnExpr, AFmt, AEvalFlags, AMtch, AKind, ATpNm, AFlgs );
end;
function TTestWatches.AddFmtDef(AnExpr, AMtch: string; AKind: TDBGSymbolKind; ATpNm: string;
@ -396,7 +176,7 @@ begin
// but the IDE only gets that with Dwarf-3
// might be prefixed, with address
Result := AddFmtDef(AnExpr, '''' + AMtch + '''$', skPOINTER, ATpNm, AFlgs );
UpdRes(Result, stDwarf3, skSimple);
UpdExpRes(Result, stDwarf3, skSimple);
end;
function TTestWatches.AddShortStrFmtDef(AnExpr, AMtch: string; ATpNm: string;
@ -434,120 +214,6 @@ begin
Result := AddFmtDef(AnExpr, AMtch, skPointer, ATpNm, AFlgs );
end;
procedure TTestWatches.UpdRes(AWatchExp: PWatchExpectation; ASymbolType: TSymbolType;
AMtch: string; AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags;
AMinGdb: Integer; AMinFpc: Integer);
begin
with AWatchExp^ do begin
Result[ASymbolType].ExpMatch := AMtch;
Result[ASymbolType].ExpKind := AKind;
Result[ASymbolType].ExpTypeName := ATpNm;
Result[ASymbolType].Flgs := AFlgs;
Result[ASymbolType].MinGdb := AMinGdb;
Result[ASymbolType].MinFpc := AMinFpc;
end;
end;
procedure TTestWatches.UpdRes(AWatchExp: PWatchExpectation; ASymbolType: TSymbolType;
AMtch: string; AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags);
begin
with AWatchExp^ do begin
Result[ASymbolType].ExpMatch := AMtch;
Result[ASymbolType].ExpKind := AKind;
Result[ASymbolType].ExpTypeName := ATpNm;
Result[ASymbolType].Flgs := AFlgs;
end;
end;
procedure TTestWatches.UpdRes(AWatchExp: PWatchExpectation; ASymbolType: TSymbolType;
AMtch: string; AKind: TDBGSymbolKind);
begin
with AWatchExp^ do begin
Result[ASymbolType].ExpMatch := AMtch;
Result[ASymbolType].ExpKind := AKind;
end;
end;
procedure TTestWatches.UpdRes(AWatchExp: PWatchExpectation; ASymbolType: TSymbolType;
AKind: TDBGSymbolKind);
begin
with AWatchExp^ do begin
Result[ASymbolType].ExpKind := AKind;
end;
end;
procedure TTestWatches.UpdRes(AWatchExp: PWatchExpectation; ASymbolType: TSymbolType;
ATpNm: string; AFlgs: TWatchExpectationFlags);
begin
with AWatchExp^ do begin
Result[ASymbolType].ExpTypeName := ATpNm;
Result[ASymbolType].Flgs := AFlgs;
end;
end;
procedure TTestWatches.UpdRes(AWatchExp: PWatchExpectation; ASymbolTypes: TSymbolTypes;
ATpNm: string; AFlgs: TWatchExpectationFlags);
var
i: TSymbolType;
begin
for i := low(TSymbolType) to high(TSymbolType) do
if i in ASymbolTypes then
UpdRes(AWatchExp, i, ATpNm, AFlgs);
end;
procedure TTestWatches.UpdResMinGdb(AWatchExp: PWatchExpectation; ASymbolTypes: TSymbolTypes;
AMinGdb: Integer);
var
i: TSymbolType;
begin
for i := low(TSymbolType) to high(TSymbolType) do
if i in ASymbolTypes then
UpdResMinGdb(AWatchExp, i, AMinGdb);
end;
procedure TTestWatches.UpdResMinFpc(AWatchExp: PWatchExpectation; ASymbolTypes: TSymbolTypes;
AMinFpc: Integer);
var
i: TSymbolType;
begin
for i := low(TSymbolType) to high(TSymbolType) do
if i in ASymbolTypes then
UpdResMinFpc(AWatchExp, i, AMinFpc);
end;
procedure TTestWatches.AddMemberExpect(AWatchExp: PWatchExpectation; AName, ATpNm: string;
AFlgs: TWatchExpectationFlags; AnExpKind: TDBGSymbolKind; ASymbolTypes: TSymbolTypes);
var
i: TSymbolType;
l: Integer;
begin
for i := low(TSymbolType) to high(TSymbolType) do
if i in ASymbolTypes then begin
l := length(AWatchExp^.Result[i].FullTypesExpect);
SetLength(AWatchExp^.Result[i].FullTypesExpect, l + 1);
AWatchExp^.Result[i].FullTypesExpect[l].Name := AName;
AWatchExp^.Result[i].FullTypesExpect[l].ExpTypeName := ATpNm;
AWatchExp^.Result[i].FullTypesExpect[l].ExpKind := AnExpKind;
AWatchExp^.Result[i].FullTypesExpect[l].Flgs := AFlgs;
end;
end;
procedure TTestWatches.UpdResMinGdb(AWatchExp: PWatchExpectation; ASymbolType: TSymbolType;
AMinGdb: Integer);
begin
with AWatchExp^ do begin
Result[ASymbolType].MinGdb := AMinGdb;
end;
end;
procedure TTestWatches.UpdResMinFpc(AWatchExp: PWatchExpectation; ASymbolType: TSymbolType;
AMinFpc: Integer);
begin
with AWatchExp^ do begin
Result[ASymbolType].MinFpc := AMinFpc;
end;
end;
procedure TTestWatches.AddExpectBreakFooGdb;
begin
if not TestControlForm.CheckListBox1.Checked[TestControlForm.CheckListBox1.Items.IndexOf(' TTestWatch.Gdb')] then exit;
@ -873,58 +539,58 @@ begin
{ gdb below 6.7.50 with stabs may fail }
r := AddFmtDef('VarOTestTCast2', [defFullTypeInfo],
MatchClass('TObject'), skClass, 'TObject', []);
if (DebuggerInfo.Version > 0) and (DebuggerInfo.Version < 060750) then UpdRes(r, stStabs, '.', skClass, '.', [fTpMtch]);
if (DebuggerInfo.Version > 0) and (DebuggerInfo.Version < 060750) then UpdExpRes(r, stStabs, '.', skClass, '.', [fTpMtch]);
r := AddFmtDef('VarOTestTCast2', [],
MatchClass('TObject'), skClass, 'TObject', []);
if (DebuggerInfo.Version > 0) and (DebuggerInfo.Version < 060750) then UpdRes(r, stStabs, '.', skClass, '.', [fTpMtch]);
if (DebuggerInfo.Version > 0) and (DebuggerInfo.Version < 060750) then UpdExpRes(r, stStabs, '.', skClass, '.', [fTpMtch]);
r := AddFmtDef('TObject(VarOTestTCast2)', [defFullTypeInfo],
MatchClass('TObject'), skClass, 'TObject', []);
if (DebuggerInfo.Version > 0) and (DebuggerInfo.Version < 060750) then UpdRes(r, stStabs, '.', skClass, '.', [fTpMtch]);
if (DebuggerInfo.Version > 0) and (DebuggerInfo.Version < 060750) then UpdExpRes(r, stStabs, '.', skClass, '.', [fTpMtch]);
r := AddFmtDef('TObject(VarOTestTCast2)', [],
MatchClass('TObject'), skClass, 'TObject', []);
if (DebuggerInfo.Version > 0) and (DebuggerInfo.Version < 060750) then UpdRes(r, stStabs, '.', skClass, '.', [fTpMtch]);
if (DebuggerInfo.Version > 0) and (DebuggerInfo.Version < 060750) then UpdExpRes(r, stStabs, '.', skClass, '.', [fTpMtch]);
r := AddFmtDef('TClassTCast(VarOTestTCast2)', [defFullTypeInfo],
MatchClass('TClassTCast', 'b *='), skClass, 'TClassTCast', []);
if (DebuggerInfo.Version > 0) and (DebuggerInfo.Version < 060750) then UpdRes(r, stStabs, '.', skClass, '.', [fTpMtch]);
if (DebuggerInfo.Version > 0) and (DebuggerInfo.Version < 060750) then UpdExpRes(r, stStabs, '.', skClass, '.', [fTpMtch]);
r := AddFmtDef('TClassTCast(VarOTestTCast2)', [],
MatchClass('TClassTCast', 'b *='), skClass, 'TClassTCast', []);
if (DebuggerInfo.Version > 0) and (DebuggerInfo.Version < 060750) then UpdRes(r, stStabs, '.', skClass, '.', [fTpMtch]);
if (DebuggerInfo.Version > 0) and (DebuggerInfo.Version < 060750) then UpdExpRes(r, stStabs, '.', skClass, '.', [fTpMtch]);
{ UseInstanceClass }
{ gdb below 6.7.50 with stabs may fail }
r := AddFmtDef('VarOTestTCast2', [defFullTypeInfo, defClassAutoCast],
MatchClass('TClassTCast', 'b *='), skClass, 'TClassTCast', []);
if (DebuggerInfo.Version > 0) and (DebuggerInfo.Version < 060750) then UpdRes(r, stStabs, '.', skClass, '.', [fTpMtch]);
if (DebuggerInfo.Version > 0) and (DebuggerInfo.Version < 060750) then UpdExpRes(r, stStabs, '.', skClass, '.', [fTpMtch]);
r := AddFmtDef('VarOTestTCast2', [defClassAutoCast],
MatchClass('TClassTCast', 'b *='), skClass, 'TClassTCast', []);
if (DebuggerInfo.Version > 0) and (DebuggerInfo.Version < 060750) then UpdRes(r, stStabs, '.', skClass, '.', [fTpMtch]);
if (DebuggerInfo.Version > 0) and (DebuggerInfo.Version < 060750) then UpdExpRes(r, stStabs, '.', skClass, '.', [fTpMtch]);
r := AddFmtDef('TObject(VarOTestTCast2)', [defFullTypeInfo, defClassAutoCast],
MatchClass('TClassTCast', 'b *='), skClass, 'TClassTCast', []);
//if (DebuggerInfo.Version > 0) and (DebuggerInfo.Version < 060750) then
UpdRes(r, stStabs, '.', skClass, '.', [fTpMtch]);
UpdExpRes(r, stStabs, '.', skClass, '.', [fTpMtch]);
r := AddFmtDef('TObject(VarOTestTCast2)', [defClassAutoCast],
MatchClass('TClassTCast', 'b *='), skClass, 'TClassTCast', []);
//if (DebuggerInfo.Version > 0) and (DebuggerInfo.Version < 060750) then
UpdRes(r, stStabs, '.', skClass, '.', [fTpMtch]);
UpdExpRes(r, stStabs, '.', skClass, '.', [fTpMtch]);
r := AddFmtDef('TClassTCast(VarOTestTCast2)', [defFullTypeInfo, defClassAutoCast],
MatchClass('TClassTCast', 'b *='), skClass, 'TClassTCast', []);
//if (DebuggerInfo.Version > 0) and (DebuggerInfo.Version < 060750) then
UpdRes(r, stStabs, '.', skClass, '.', [fTpMtch]);
UpdExpRes(r, stStabs, '.', skClass, '.', [fTpMtch]);
r := AddFmtDef('TClassTCast(VarOTestTCast2)', [defClassAutoCast],
MatchClass('TClassTCast', 'b *='), skClass, 'TClassTCast', []);
//if (DebuggerInfo.Version > 0) and (DebuggerInfo.Version < 060750) then
UpdRes(r, stStabs, '.', skClass, '.', [fTpMtch]);
UpdExpRes(r, stStabs, '.', skClass, '.', [fTpMtch]);
// access dyn array in casted object
{%endregion * Classes * typecasts}
r := AddFmtDef('TClassTCastObject(VarOTestTCastObj).l[1]', [], '1144', skSimple, 'Integer|LongInt', [fTpMtch]);
// if (DebuggerInfo.Version > 0) and (DebuggerInfo.Version < 060750) then UpdRes(r, stStabs, '.', skClass, '.', [fTpMtch]);
// if (DebuggerInfo.Version > 0) and (DebuggerInfo.Version < 060750) then UpdExpRes(r, stStabs, '.', skClass, '.', [fTpMtch]);
// Full type info
@ -947,9 +613,9 @@ begin
r:=AddStringFmtDef('VArgTMyAnsiString', 'MyAnsi 2', '^(TMy)?AnsiString$', [fTpMtch]);
r:=AddFmtDef('ArgPMyAnsiString', MatchPointer, skPointer, 'PMyAnsiString', []);
UpdRes(r, stStabs, '^(PMyAnsiString|PPChar)$', [fTpMtch]);
UpdExpRes(r, stStabs, '^(PMyAnsiString|PPChar)$', [fTpMtch]);
r:=AddFmtDef('VArgPMyAnsiString', MatchPointer, skPointer, 'PMyAnsiString', []);
UpdRes(r, stStabs, '^(PMyAnsiString|PPChar)$', [fTpMtch]);
UpdExpRes(r, stStabs, '^(PMyAnsiString|PPChar)$', [fTpMtch]);
r:=AddStringFmtDef('ArgPMyAnsiString^', 'MyAnsi P', '^(TMy)?AnsiString$', [fTpMtch]);
r:=AddStringFmtDef('VArgPMyAnsiString^', 'MyAnsi P2', '^(TMy)?AnsiString$', [fTpMtch]);
UpdResMinFpc(r, stDwarf, 020600); UpdResMinFpc(r, stDwarfSet, 020600);
@ -957,9 +623,9 @@ begin
r:=AddFmtDef('ArgPPMyAnsiString', MatchPointer, skPointer, 'PPMyAnsiString', []);
r:=AddFmtDef('VArgPPMyAnsiString', MatchPointer, skPointer, 'PPMyAnsiString', []);
r:=AddFmtDef('ArgPPMyAnsiString^', MatchPointer, skPointer, 'PMyAnsiString', []);
UpdRes(r, stStabs, '^(PMyAnsiString|PPChar)$', [fTpMtch]);
UpdExpRes(r, stStabs, '^(PMyAnsiString|PPChar)$', [fTpMtch]);
r:=AddFmtDef('VArgPPMyAnsiString^', MatchPointer, skPointer, 'PMyAnsiString', []);
UpdRes(r, stStabs, '^(PMyAnsiString|PPChar)$', [fTpMtch]);
UpdExpRes(r, stStabs, '^(PMyAnsiString|PPChar)$', [fTpMtch]);
UpdResMinFpc(r, stDwarf, 020600); UpdResMinFpc(r, stDwarfSet, 020600);
r:=AddStringFmtDef('ArgPPMyAnsiString^^', 'MyAnsi P', '^(TMy)?AnsiString$', [fTpMtch]);
r:=AddStringFmtDef('VArgPPMyAnsiString^^', 'MyAnsi P2', '^(TMy)?AnsiString$', [fTpMtch]);
@ -967,36 +633,36 @@ begin
r:=AddStringFmtDef('ArgTNewAnsiString', 'NewAnsi', 'TNewAnsiString', []);
UpdRes(r, stStabs, '(TNew)?AnsiString', [fTpMtch]);
UpdExpRes(r, stStabs, '(TNew)?AnsiString', [fTpMtch]);
r:=AddStringFmtDef('VArgTNewAnsiString', 'NewAnsi 2', 'TNewAnsiString', []);
UpdRes(r, stStabs, '(TNew)?AnsiString', [fTpMtch]);
UpdExpRes(r, stStabs, '(TNew)?AnsiString', [fTpMtch]);
r:=AddFmtDef('ArgPNewAnsiString', MatchPointer, skPointer, 'PNewAnsiString', []);
UpdRes(r, stStabs, '(\^|PNew|P)AnsiString|PPChar', [fTpMtch]);
UpdExpRes(r, stStabs, '(\^|PNew|P)AnsiString|PPChar', [fTpMtch]);
r:=AddFmtDef('VArgPNewAnsiString', MatchPointer, skPointer, 'PNewAnsiString', []);
UpdRes(r, stStabs, '(\^|PNew|P)AnsiString|PPChar', [fTpMtch]);
UpdExpRes(r, stStabs, '(\^|PNew|P)AnsiString|PPChar', [fTpMtch]);
r:=AddStringFmtDef('ArgPNewAnsiString^', 'NewAnsi P', 'TNewAnsiString', []);
UpdRes(r, stStabs, '(TNew)?AnsiString', [fTpMtch]);
UpdExpRes(r, stStabs, '(TNew)?AnsiString', [fTpMtch]);
r:=AddStringFmtDef('VArgPNewAnsiString^', 'NewAnsi P2', 'TNewAnsiString', []);
UpdResMinFpc(r, stDwarf, 020600); UpdResMinFpc(r, stDwarfSet, 020600);
UpdRes(r, stStabs, '(TNew)?AnsiString', [fTpMtch]);
UpdExpRes(r, stStabs, '(TNew)?AnsiString', [fTpMtch]);
// typecasts
r:=AddStringFmtDef('AnsiString(ArgTMyAnsiString)', 'MyAnsi', 'AnsiString|\^char', [fTpMtch]);
UpdRes(r, stDwarf3, 'AnsiString', []);
UpdExpRes(r, stDwarf3, 'AnsiString', []);
r:=AddStringFmtDef('AnsiString(VArgTMyAnsiString)', 'MyAnsi 2', 'AnsiString|\^char', [fTpMtch]);
UpdRes(r, stDwarf3, 'AnsiString', []);
UpdExpRes(r, stDwarf3, 'AnsiString', []);
r:=AddFmtDef('PMyAnsiString(ArgPMyAnsiString)', MatchPointer, skPointer, '^(\^|PMy)AnsiString$', [fTpMtch]);
UpdRes(r, stStabs, '^(PMyAnsiString|PPChar)$', [fTpMtch]);
UpdExpRes(r, stStabs, '^(PMyAnsiString|PPChar)$', [fTpMtch]);
r:=AddFmtDef('PMyAnsiString(VArgPMyAnsiString)', MatchPointer, skPointer, '^(\^|PMy)AnsiString$', [fTpMtch]);
UpdRes(r, stStabs, '^(PMyAnsiString|PPChar)$', [fTpMtch]);
UpdExpRes(r, stStabs, '^(PMyAnsiString|PPChar)$', [fTpMtch]);
// TODO,, IDE derefs with dwarf3
r:=AddFmtDef('^AnsiString(ArgPMyAnsiString)', MatchPointer, skPointer, '^(\^AnsiString|\^\^char)', [fTpMtch]);
UpdRes(r, stStabs, '^(\^AnsiString|PPChar)$', [fTpMtch]);
UpdExpRes(r, stStabs, '^(\^AnsiString|PPChar)$', [fTpMtch]);
r:=AddFmtDef('^AnsiString(VArgPMyAnsiString)', MatchPointer, skPointer, '^(\^AnsiString|\^\^char)', [fTpMtch]);
UpdRes(r, stStabs, '^(\^AnsiString|PPChar)$', [fTpMtch]);
UpdExpRes(r, stStabs, '^(\^AnsiString|PPChar)$', [fTpMtch]);
r:=AddStringFmtDef('AnsiString(ArgPMyAnsiString^)', 'MyAnsi P', '^((TMy)?AnsiString|\^char)$', [fTpMtch]);
r:=AddStringFmtDef('AnsiString(VArgPMyAnsiString^)', 'MyAnsi P2', '^((TMy)?AnsiString|\^char)$', [fTpMtch]);
@ -1008,8 +674,8 @@ begin
r:=AddFmtDef('PChar(ArgTMyAnsiString)',
'''MyAnsi''$', skPOINTER, '(\^|p)char', [fTpMtch]);
UpdRes(r, stStabs, '''MyAnsi''$', skPOINTER, 'pchar|AnsiString', [fTpMtch]);
//UpdRes(r, stDwarf3, '''MyAnsi''$', skSimple, 'AnsiString', []);
UpdExpRes(r, stStabs, '''MyAnsi''$', skPOINTER, 'pchar|AnsiString', [fTpMtch]);
//UpdExpRes(r, stDwarf3, '''MyAnsi''$', skSimple, 'AnsiString', []);
// accessing len/refcount
r:=AddFmtDef('^^longint(ArgTMyAnsiString)[-1]',
@ -1020,31 +686,31 @@ begin
// accessing char
// TODO: only works with dwarf 3
r:=AddFmtDef('ArgTMyAnsiString[1]', '.', skSimple, 'char', []);
UpdRes(r, stDwarf3, '''M''$', skSimple, 'char', []);
UpdExpRes(r, stDwarf3, '''M''$', skSimple, 'char', []);
r:=AddFmtDef('VArgTMyAnsiString[1]', '.', skSimple, 'char', []);
UpdRes(r, stDwarf3, '''M''$', skSimple, 'char', []);
UpdExpRes(r, stDwarf3, '''M''$', skSimple, 'char', []);
r:=AddFmtDef('ArgPMyAnsiString^[1]', '.', skSimple, 'char', []);
UpdRes(r, stDwarf3, '''M''$', skSimple, 'char', []);
UpdExpRes(r, stDwarf3, '''M''$', skSimple, 'char', []);
r:=AddFmtDef('VArgPMyAnsiString^[1]', '.', skSimple, 'char', []);
UpdResMinFpc(r, stDwarf, 020600); UpdResMinFpc(r, stDwarfSet, 020600);
UpdRes(r, stDwarf3, '''M''$', skSimple, 'char', []);
UpdExpRes(r, stDwarf3, '''M''$', skSimple, 'char', []);
r:=AddFmtDef('AnsiString(ArgTMyAnsiString)[1]', '.', skSimple, 'char', []);
UpdRes(r, stDwarf3, '''M''$', skSimple, 'char', []);
UpdExpRes(r, stDwarf3, '''M''$', skSimple, 'char', []);
r:=AddFmtDef('AnsiString(VArgTMyAnsiString)[1]', '.', skSimple, 'char', []);
UpdRes(r, stDwarf3, '''M''$', skSimple, 'char', []);
UpdExpRes(r, stDwarf3, '''M''$', skSimple, 'char', []);
// accessing char, after typecast
r:=AddFmtDef('AnsiString(ArgTMyAnsiString)[1]', '.', skSimple, 'char', []);
UpdRes(r, stDwarf3, '''M''$', skSimple, 'char', []);
UpdExpRes(r, stDwarf3, '''M''$', skSimple, 'char', []);
// string in array
r:=AddStringFmtDef('ArgTMyAnsiStringDArray[0]', 'DArray1 Str0', 'AnsiString', []);
r:=AddStringFmtDef('ArgTMyAnsiStringDArray[1]', 'DArray1 Str1', 'AnsiString', []);
r:=AddStringFmtDef('VArgTMyAnsiStringDArray[0]', 'DArray2 Str0', 'AnsiString', []);
if (DebuggerInfo.Version > 0) and (DebuggerInfo.Version < 070000) then UpdRes(r, stDwarf2All, '^(\^Char|AnsiString)$', [fTpMtch]);
if (DebuggerInfo.Version > 0) and (DebuggerInfo.Version < 070000) then UpdExpRes(r, stDwarf2All, '^(\^Char|AnsiString)$', [fTpMtch]);
r:=AddStringFmtDef('VArgTMyAnsiStringDArray[1]', 'DArray2 Str1', 'AnsiString', []);
if (DebuggerInfo.Version > 0) and (DebuggerInfo.Version < 070000) then UpdRes(r, stDwarf2All, '^(\^Char|AnsiString)$', [fTpMtch]);
if (DebuggerInfo.Version > 0) and (DebuggerInfo.Version < 070000) then UpdExpRes(r, stDwarf2All, '^(\^Char|AnsiString)$', [fTpMtch]);
r:=AddCharFmtDef('ArgTMyAnsiStringDArray[0][1]', 'D', 'char', [IgnDwrf2, IgnStabs]);
@ -1111,30 +777,30 @@ begin
r:=AddStringFmtDef('VArgTStringHolderObj.FTMyAnsiString', 'Obj2 MyAnsi', 'AnsiString', []);
r:=AddFmtDef('ArgTStringHolderObj.FTMyAnsiString[1]', '.$', skSimple, 'char', []);
UpdRes(r, stDwarf3, '''O''$', skSimple);
UpdExpRes(r, stDwarf3, '''O''$', skSimple);
r:=AddFmtDef('VArgTStringHolderObj.FTMyAnsiString[1]', '.$', skSimple, 'char', []);
UpdRes(r, stDwarf3, '''O''$', skSimple);
UpdExpRes(r, stDwarf3, '''O''$', skSimple);
// string in rec
r:=AddStringFmtDef('ArgTStringHolderRec.FTMyAnsiString', 'Rec1 MyAnsi', 'AnsiString', [fTstSkipDwarf3]);
r:=AddStringFmtDef('VArgTStringHolderRec.FTMyAnsiString', 'Rec2 MyAnsi', 'AnsiString', [fTstSkipDwarf3]);
r:=AddFmtDef('ArgTStringHolderRec.FTMyAnsiString[1]', '.$', skSimple, 'char', [fTstSkipDwarf3]);
UpdRes(r, stDwarf3, '''R''$', skSimple);
UpdExpRes(r, stDwarf3, '''R''$', skSimple);
r:=AddFmtDef('VArgTStringHolderRec.FTMyAnsiString[1]', '.$', skSimple, 'char', [fTstSkipDwarf3]);
UpdRes(r, stDwarf3, '''R''$', skSimple);
UpdExpRes(r, stDwarf3, '''R''$', skSimple);
//r:=AddFmtDef('ArgTNewAnsiString', '''NewAnsi''$', skPOINTER, '(TNew)?AnsiString', []);
// UpdRes(r, stDwarf3, '''NewAnsi''$', skSimple, '(TNew)?AnsiString', [fTpMtch]);
// UpdExpRes(r, stDwarf3, '''NewAnsi''$', skSimple, '(TNew)?AnsiString', [fTpMtch]);
//r:=AddFmtDef('VArgTNewAnsiString', '''NewAnsi 2''$', skPOINTER, '(TNew)?AnsiString', []);
// UpdRes(r, stDwarf3, '''NewAnsi 2''$', skSimple, '(TNew)?AnsiString', [fTpMtch]);
// UpdExpRes(r, stDwarf3, '''NewAnsi 2''$', skSimple, '(TNew)?AnsiString', [fTpMtch]);
//r:=AddFmtDef('ArgPNewAnsiString', MatchPointer, skPointer, '(\^|PNew|P)AnsiString', []);
//r:=AddFmtDef('VArgPNewAnsiString', MatchPointer, skPointer, '(\^|PNew|P)AnsiString', []);
//r:=AddFmtDef('ArgPNewAnsiString^', '''NewAnsi P''', skPOINTER, '(TNew)?AnsiString', []);
// UpdRes(r, stDwarf3, '''NewAnsi''$', skSimple, '(TNew)?AnsiString', [fTpMtch]);
// UpdExpRes(r, stDwarf3, '''NewAnsi''$', skSimple, '(TNew)?AnsiString', [fTpMtch]);
//r:=AddFmtDef('VArgPNewAnsiString^', '''NewAnsi P2''', skPOINTER, '(TNew)?AnsiString', []);
// UpdRes(r, stDwarf3, '''NewAnsi 2''$', skSimple, '(TNew)?AnsiString', [fTpMtch]);
// UpdExpRes(r, stDwarf3, '''NewAnsi 2''$', skSimple, '(TNew)?AnsiString', [fTpMtch]);
@ -1957,14 +1623,14 @@ procedure TTestWatches.AddExpectBreakFooAndSubFoo;
AStackFrame: Integer=0);
begin
FCurrentExpArray := @ExpectBreakFoo;
AddTo(ExpectBreakFoo, AnExpr, AFmt, AMtch, AKind, ATpNm, AFlgs, AStackFrame)
AddWatchExp(ExpectBreakFoo, AnExpr, AFmt, AMtch, AKind, ATpNm, AFlgs, AStackFrame)
end;
procedure AddS(AnExpr: string; AFmt: TWatchDisplayFormat;
AMtch: string; AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags;
AStackFrame: Integer=0);
begin
FCurrentExpArray := @ExpectBreakSubFoo;
AddTo(ExpectBreakSubFoo, AnExpr, AFmt, AMtch, AKind, ATpNm, AFlgs, AStackFrame)
AddWatchExp(ExpectBreakSubFoo, AnExpr, AFmt, AMtch, AKind, ATpNm, AFlgs, AStackFrame)
end;
begin
if not TestControlForm.CheckListBox1.Checked[TestControlForm.CheckListBox1.Items.IndexOf(' TTestWatch.Cache')] then exit;
@ -2003,7 +1669,6 @@ var
dbg: TGDBMIDebugger;
Only: Integer;
OnlyName, OnlyNamePart: String;
MemberTests: TFullTypeMemberExpectationResultArray;
function SkipTest(const Data: TWatchExpectation): Boolean;
begin
@ -2021,149 +1686,6 @@ var
then Result := False;
end;
procedure TestWatch(Name: String; AWatch: TTestWatch; Data: TWatchExpectation; WatchValue: String = '');
var
rx: TRegExpr;
s, s2: String;
flag, IsValid, HasTpInfo, f2: Boolean;
WV: TWatchValue;
Stack: Integer;
n: String;
DataRes: TWatchExpectationResult;
IgnoreFlags: TWatchExpectationFlags;
IgnoreAll, IgnoreData, IgnoreKind, IgnoreKindPtr, IgnoreTpName: boolean;
IgnoreText: String;
i, j: Integer;
fld: TDBGField;
function CmpNames(TestName, Exp, Got: String; Match: Boolean): Boolean;
begin
if Match then begin
if Frx = nil then Frx := TRegExpr.Create;
Frx.ModifierI := true;
Frx.Expression := Exp;
TestTrue(TestName + ' matches '+Exp+' but was '+Got, Frx.Exec(Got), DataRes.MinGdb, DataRes.MinFpc, IgnoreText);
end
else TestEquals(TestName + ' equals ', LowerCase(Exp), LowerCase(Got), DataRes.MinGdb, DataRes.MinFpc, IgnoreText);
end;
begin
if not TestTrue('Dbg did NOT enter dsError', dbg.State <> dsError) then exit;
rx := nil;
Stack := Data.StackFrame;
DataRes := Data.Result[SymbolType];
IgnoreFlags := DataRes.Flgs * WatchExpFlagMask[SymbolType];
IgnoreAll := IgnoreFlags * WatchExpFlagSIgnAll <> [];
IgnoreData := IgnoreFlags * WatchExpFlagSIgnData <> [];
IgnoreKind := IgnoreFlags * WatchExpFlagSIgnKind <> [];
IgnoreKindPtr := IgnoreFlags * WatchExpFlagSIgnKindPtr <> [];
IgnoreTpName := IgnoreFlags * WatchExpFlagSIgnTpName <> [];
// Get Value
n := Data.TestName;
LogToFile('###### ' + n + '######' +LineEnding);
if n = '' then n := Data.Expression + ' (' + TWatchDisplayFormatNames[Data.DspFormat] + ', ' + dbgs(Data.EvaluateFlags) + ')';
Name := Name + ' ' + n;
flag := AWatch <> nil; // test for typeinfo/kind // Awatch=nil > direct gdb command
IsValid := True;
HasTpInfo := True;
if flag then begin;
WV := AWatch.Values[1, Stack];// trigger read
s := WV.Value;
IsValid := WV.Validity = ddsValid;
HasTpInfo := IsValid and (WV.TypeInfo <> nil);
// flag := flag and IsValid;
end
else
s := WatchValue;
if not TestTrue('Dbg did NOT enter dsError', dbg.State <> dsError) then exit;
// Check Data
f2 := True;
IgnoreText := ''; if IgnoreData then IgnoreText := 'Ignored by flag';
if IsValid then begin
rx := TRegExpr.Create;
rx.ModifierI := true;
rx.Expression := DataRes.ExpMatch;
if DataRes.ExpMatch <> ''
then f2 := TestTrue(Name + ' Matches "'+DataRes.ExpMatch + '", but was "' + s + '"', rx.Exec(s), DataRes.MinGdb, DataRes.MinFpc, IgnoreText);
FreeAndNil(rx);
end else begin
f2 := TestTrue(Name + ' Matches "'+DataRes.ExpMatch + '", but STATE was <'+dbgs(WV.Validity)+'> Val="'+s+'"', False, DataRes.MinGdb, DataRes.MinFpc, IgnoreText);
//exit; // failed Data, do not list others as potential unexpected success
end;
if (not f2) and IgnoreAll then exit; // failed Data, do not list others as potential unexpected success
// TypeInfo checks ?
if (not flag) or (DataRes.ExpTypeName = '') then exit;
// Check TypeInfo
s:='';
if HasTpInfo then WriteStr(s, WV.TypeInfo.Kind);
WriteStr(s2, DataRes.ExpKind);
IgnoreText := ''; if IgnoreKind then IgnoreText := 'Ignored by flag';
if IsValid and HasTpInfo then begin
if (not IgnoreKind) and IgnoreKindPtr and (WV.TypeInfo.Kind = skPointer) then IgnoreText := 'Ignored by flag (Kind may be Ptr)';
f2 := TestEquals(Name + ' Kind', s2, s, DataRes.MinGdb, DataRes.MinFpc, IgnoreText);
end else begin
f2 := TestTrue(Name + ' Kind is "'+s2+'", failed: STATE was <'+dbgs(WV.Validity)+'>, HasTypeInfo='+dbgs(HasTpInfo)+' Val="'+s+'"', False, DataRes.MinGdb, DataRes.MinFpc, IgnoreText);
end;
if (not f2) and IgnoreAll then exit; // failed Data, do not list others as potential unexpected success
// Check TypeName
IgnoreText := ''; if IgnoreTpName then IgnoreText := 'Ignored by flag';
if IsValid and HasTpInfo then begin
s:='';
if HasTpInfo then s := WV.TypeInfo.TypeName;
CmpNames(Name+' TypeName', DataRes.ExpTypeName, s, fTpMtch in DataRes.Flgs);
//if fTpMtch in DataRes.Flgs
//then begin
// rx := TRegExpr.Create;
// rx.ModifierI := true;
// rx.Expression := DataRes.ExpTypeName;
// TestTrue(Name + ' TypeName matches '+DataRes.ExpTypeName+' but was '+s, rx.Exec(s), DataRes.MinGdb, DataRes.MinFpc, IgnoreText);
// FreeAndNil(rx);
// end
// else TestEquals(Name + ' TypeName', LowerCase(DataRes.ExpTypeName), LowerCase(s), DataRes.MinGdb, DataRes.MinFpc, IgnoreText);
end else begin
TestTrue(Name + ' TypeName matches '+DataRes.ExpTypeName+' but STATE was <'+dbgs(WV.Validity)+'> HasTypeInfo='+dbgs(HasTpInfo)+' Val="'+s+'"', False, DataRes.MinGdb, DataRes.MinFpc, IgnoreText);
end;
MemberTests := DataRes.FullTypesExpect;
if Length(MemberTests) > 0 then begin
if HasTpInfo then begin
for i := 0 to Length(MemberTests) - 1 do begin
j := WV.TypeInfo.Fields.Count - 1;
while (j >= 0) and (uppercase(WV.TypeInfo.Fields[j].Name) <> UpperCase(MemberTests[i].Name)) do dec(j);
TestTrue(Name + ' no members with name ' + MemberTests[i].Name,
(fTExpectNotFOund in MemberTests[i].Flgs) <> (j >= 0),
DataRes.MinGdb, DataRes.MinFpc, IgnoreText);;
if j >= 0 then begin
fld := WV.TypeInfo.Fields[j];
WriteStr(s, MemberTests[i].ExpKind);
WriteStr(s2, fld.DBGType.Kind);
if fld.DBGType <> nil then begin
TestTrue(Name + ' members with name ' + MemberTests[i].Name + ' type='
+ s + ' but was ' + s2,
MemberTests[i].ExpKind = fld.DBGType.Kind, DataRes.MinGdb, DataRes.MinFpc, IgnoreText);;
CmpNames(Name + ' members with name ' + MemberTests[i].Name + 'TypeName',
MemberTests[i].ExpTypeName, fld.DBGType.TypeName, fTpMtch in MemberTests[i].Flgs);
end
else
TestTrue(Name + ' no dbgtype for members with name' + MemberTests[i].Name, False, DataRes.MinGdb, DataRes.MinFpc, IgnoreText);;
end;
end;
end
else
TestTrue(Name + ' no typeinfo for members' , False, DataRes.MinGdb, DataRes.MinFpc, IgnoreText);;
end;
end;
var
i: Integer;
WList, WListSub, WListArray: Array of TTestWatch;
@ -2213,41 +1735,9 @@ begin
Fail(' Failed Init');
(* Create all watches *)
SetLength(WList, length(ExpectBreakFoo));
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] := TTestWatch.Create(FWatches);
WList[i].Expression := ExpectBreakFoo[i].Expression;
WList[i].DisplayFormat := ExpectBreakFoo[i].DspFormat;
WList[i].EvaluateFlags:= ExpectBreakFoo[i].EvaluateFlags;
WList[i].enabled := True;
end;
end;
SetLength(WListSub, length(ExpectBreakSubFoo));
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] := TTestWatch.Create(FWatches);
WListSub[i].Expression := ExpectBreakSubFoo[i].Expression;
WListSub[i].DisplayFormat := ExpectBreakSubFoo[i].DspFormat;
WListSub[i].EvaluateFlags:= ExpectBreakSubFoo[i].EvaluateFlags;
WListSub[i].enabled := True;
end;
end;
SetLength(WListArray, length(ExpectBreakFooArray));
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] := TTestWatch.Create(FWatches);
WListArray[i].Expression := ExpectBreakFooArray[i].Expression;
WListArray[i].DisplayFormat := ExpectBreakFooArray[i].DspFormat;
WListArray[i].EvaluateFlags:= ExpectBreakFooArray[i].EvaluateFlags;
WListArray[i].enabled := True;
end;
end;
AddWatches(ExpectBreakFoo, WList, FWatches, Only, OnlyName, OnlyNamePart);
AddWatches(ExpectBreakSubFoo, WListSub, FWatches, Only, OnlyName, OnlyNamePart);
AddWatches(ExpectBreakFooArray, WListArray, FWatches, Only, OnlyName, OnlyNamePart);
(* Start debugging *)
dbg.ShowConsole := True;
@ -2257,11 +1747,7 @@ begin
then begin
(* Hit first breakpoint: BREAK_LINE_FOOFUNC_NEST SubFoo -- (1st loop) Called with none nil data *)
for i := low(ExpectBreakSubFoo) to high(ExpectBreakSubFoo) do begin
if not MatchOnly(ExpectBreakSubFoo[i], i) then continue;
if not SkipTest(ExpectBreakSubFoo[i]) then
TestWatch('Brk1 '+IntToStr(i)+' ', WListSub[i], ExpectBreakSubFoo[i]);
end;
TestWatchList('Brk1', ExpectBreakSubFoo, WListSub, dbg, Only, OnlyName, OnlyNamePart);
dbg.Run;
end
@ -2277,7 +1763,7 @@ begin
if not SkipTest(ExpectBreakFooGdb[i]) then begin
FDbgOutPut := '';
dbg.TestCmd(ExpectBreakFooGdb[i].Expression);
TestWatch('Brk1 Direct Gdb '+IntToStr(i)+' ', nil, ExpectBreakFooGdb[i], FDbgOutPut);
TestWatch('Brk2 Direct Gdb '+IntToStr(i)+' ', dbg, nil, ExpectBreakFooGdb[i], FDbgOutPut);
end;
end;
FDbgOutPutEnable := False;
@ -2285,7 +1771,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
TestWatch('Brk1 '+IntToStr(i)+' ', WList[i], ExpectBreakFoo[i]);
TestWatch('Brk2 '+IntToStr(i)+' ', dbg, WList[i], ExpectBreakFoo[i]);
end;
dbg.Run;
@ -2296,11 +1782,7 @@ begin
then begin
(* Hit 2nd breakpoint: BREAK_LINE_FOOFUNC_ARRAY SubFoo_Watches -- (1st loop) Called with none nil data *)
for i := low(ExpectBreakFooArray) to high(ExpectBreakFooArray) do begin
if not MatchOnly(ExpectBreakFooArray[i], i) then continue;
if not SkipTest(ExpectBreakFooArray[i]) then
TestWatch('Brk1 '+IntToStr(i)+' ', WListArray[i], ExpectBreakFooArray[i]);
end;
TestWatchList('Brk3', ExpectBreakFooArray, WListArray, dbg, Only, OnlyName, OnlyNamePart);
dbg.Run;
end
@ -2406,7 +1888,6 @@ begin
end;
FreeAndNil(Frx);
AssertTestErrors;
end;
@ -2415,5 +1896,13 @@ end;
initialization
RegisterDbgTest(TTestWatches);
RegisterTestSelectors(['TTestWatch',
'- TTestWatch.Unstable',
' TTestWatch.Gdb',
' TTestWatch.All',
' TTestWatch.Mix',
' TTestWatch.Mix.All',
' TTestWatch.Cache'
]);
end.