mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-04 20:46:23 +02:00
2037 lines
68 KiB
ObjectPascal
2037 lines
68 KiB
ObjectPascal
unit TTestWatchUtilities;
|
|
|
|
{$mode objfpc}{$H+}
|
|
{$modeswitch AdvancedRecords}
|
|
{$modeswitch TypeHelpers}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, math, DbgIntfBaseTypes, DbgIntfDebuggerBase,
|
|
FpPascalBuilder, LazLoggerBase, Forms, RegExpr, TestDbgTestSuites,
|
|
TTestDebuggerClasses, TTestDbgExecuteables, TestDbgConfig, TestOutputLogger;
|
|
|
|
type
|
|
TWatchExpectationResultKind = (
|
|
rkMatch, rkInteger, rkCardinal, rkFloat, rkBool, rkEnum, rkSet,
|
|
rkChar, rkAnsiString, rkShortString, rkWideString, rkPointer, rkPointerAddr,
|
|
rkClass, rkObject, rkRecord, rkInterface, rkField,
|
|
rkStatArray, rkDynArray
|
|
);
|
|
|
|
TWatchExpErrorHandlingFlag =
|
|
(ehIgnAll, // ignore error for all
|
|
ehTestSkip, // Do not run test
|
|
|
|
ehIgnData, // Ignore the data part
|
|
ehIgnPointerDerefData, // Ignore if a pointer has deref data or not
|
|
ehIgnKind, // Ignore skSimple, ....
|
|
ehIgnKindPtr, // Ignore skSimple, ONLY if got kind=skPointer
|
|
ehIgnTypeName, // Ignore the typename
|
|
ehIgnTypeNameInData, // Ignore any appearance of typename in data
|
|
ehMatchTypeName, // The typename is a regex
|
|
ehNoTypeInfo,
|
|
|
|
ehCharFromIndex, // Debugger is allowed Pchar: 'x' String 'y'
|
|
ehNoFieldOrder, // structure: fields can be in any order
|
|
ehMissingFields, // structure: fields may have gaps
|
|
|
|
ehExpectNotFound,
|
|
ehExpectError, // watch is invalid (less specific, than not found / maybe invalid expression ?)
|
|
|
|
ehNotImplemented, // The debugger is known to fail this test // same as ehIgnAll
|
|
ehNotImplementedKind, // skSimple...
|
|
ehNotImplementedType, // typename
|
|
ehNotImplementedData
|
|
);
|
|
TWatchExpErrorHandlingFlags = set of TWatchExpErrorHandlingFlag;
|
|
|
|
|
|
{ TWatchExpectationResult }
|
|
|
|
TWatchExpectationResult = record
|
|
//ResultKind: TWatchExpectationResultKind;
|
|
|
|
ExpTextData: string; // depends on ResultKind
|
|
ExpSymKind: TDbgSymbolKind; // skSimple, skInteger...
|
|
ExpTypeName: string; // AnsiString, Integer, TObject...
|
|
ExpErrorHandlingFlags: Array [TSymbolType] of TWatchExpErrorHandlingFlags;
|
|
|
|
ExpSubResults: Array of TWatchExpectationResult;
|
|
// MinDbg, MinFpc: Integer;
|
|
//FullTypesExpect: TFullTypeMemberExpectationResultArray;
|
|
|
|
ExpSetData: array of string; // rkSet
|
|
|
|
ExpFieldName: string; // member in structure
|
|
|
|
function AddFlag(AFlag: TWatchExpErrorHandlingFlag; ASymTypes: TSymbolTypes = []): TWatchExpectationResult;
|
|
function AddFlag(AFlags: TWatchExpErrorHandlingFlags; ASymTypes: TSymbolTypes = []): TWatchExpectationResult;
|
|
|
|
function N(AFieldName: String): TWatchExpectationResult; // FieldName
|
|
|
|
function Skip(ASymTypes: TSymbolTypes = []): TWatchExpectationResult;
|
|
function SkipIf(ACond: Boolean; ASymTypes: TSymbolTypes = []): TWatchExpectationResult;
|
|
|
|
function IgnAll(ASymTypes: TSymbolTypes = []): TWatchExpectationResult;
|
|
function IgnData(ASymTypes: TSymbolTypes = []): TWatchExpectationResult;
|
|
function IgnKind(ASymTypes: TSymbolTypes = []): TWatchExpectationResult;
|
|
function IgnKindPtr(ASymTypes: TSymbolTypes = []): TWatchExpectationResult;
|
|
function IgnTypeName(ASymTypes: TSymbolTypes = []): TWatchExpectationResult;
|
|
function MatchTypeName(ASymTypes: TSymbolTypes = []): TWatchExpectationResult;
|
|
|
|
function CharFromIndex(ASymTypes: TSymbolTypes = []): TWatchExpectationResult;
|
|
|
|
function ExpectNotFound(ASymTypes: TSymbolTypes = []): TWatchExpectationResult;
|
|
function ExpectError(ASymTypes: TSymbolTypes = []): TWatchExpectationResult;
|
|
|
|
function NotImplemented(ASymTypes: TSymbolTypes = []): TWatchExpectationResult;
|
|
function NotImplementedData(ASymTypes: TSymbolTypes = []): TWatchExpectationResult;
|
|
|
|
procedure MakeCopy;
|
|
|
|
|
|
case ExpResultKind: TWatchExpectationResultKind of
|
|
rkMatch: ();
|
|
rkInteger: (
|
|
ExpIntValue: Int64;
|
|
ExpIntSize: Integer; // Byte=1, Word=2, ...
|
|
);
|
|
rkCardinal: (
|
|
ExpCardinalValue: QWord;
|
|
ExpCardinalSize: Integer; // Byte=1, Word=2, ...
|
|
);
|
|
rkFloat: (
|
|
ExpFloatValue: Extended;
|
|
);
|
|
rkBool: (
|
|
ExpBoolValue: Boolean;
|
|
);
|
|
rkPointerAddr: (
|
|
ExpPointerValue: Pointer;
|
|
);
|
|
rkDynArray: (
|
|
ExpFullArrayLen: integer;
|
|
);
|
|
end;
|
|
|
|
TWatchExpectationResultArray = array of TWatchExpectationResult;
|
|
|
|
(* Do *NOT* start any other identifiers with "Tst...".
|
|
There are a lot of
|
|
with TWatchExpectation do ...
|
|
blocks
|
|
*)
|
|
PWatchExpectation = ^TWatchExpectation;
|
|
|
|
{ TWatchExpectation }
|
|
|
|
TWatchExpectation = record
|
|
TstTestName: String;
|
|
TstWatch: TTestWatch;
|
|
|
|
EvalCallTestFlags: TDBGEvaluateFlags;
|
|
EvalCallResReceived: Boolean;
|
|
EvalCallResSuccess: Boolean;
|
|
EvalCallResText: String;
|
|
EvalCallResDBGType: TDBGType;
|
|
|
|
//TstDspFormat: TWatchDisplayFormat;
|
|
//TstRepeatCount: Integer;
|
|
//TstEvaluateFlags: TDBGEvaluateFlags;
|
|
TstStackFrame: Integer;
|
|
TstMinDbg, TstMinFpc: Integer;
|
|
|
|
TstExpected: TWatchExpectationResult;
|
|
//TstExpected: Array [TSymbolType] of TWatchExpectationResult;
|
|
|
|
//TstUserData, TstUserData2: Pointer;
|
|
//TstOnBeforeTest: TWatchExpectOnBeforeTest;
|
|
|
|
function AddFlag(AFlag: TWatchExpErrorHandlingFlag; ASymTypes: TSymbolTypes = []): PWatchExpectation;
|
|
function AddFlag(AFlags: TWatchExpErrorHandlingFlags; ASymTypes: TSymbolTypes = []): PWatchExpectation;
|
|
end;
|
|
|
|
{ TWatchExpectationHelper }
|
|
|
|
TWatchExpectationHelper = type helper for PWatchExpectation
|
|
function AddFlag(AFlag: TWatchExpErrorHandlingFlag; ASymTypes: TSymbolTypes = []; ACond: Boolean = True): PWatchExpectation;
|
|
function AddFlag(AFlags: TWatchExpErrorHandlingFlags; ASymTypes: TSymbolTypes = []; ACond: Boolean = True): PWatchExpectation;
|
|
function AddFlag(AFlag: TWatchExpErrorHandlingFlag; ACond: Boolean): PWatchExpectation;
|
|
function AddFlag(AFlags: TWatchExpErrorHandlingFlags; ACond: Boolean): PWatchExpectation;
|
|
|
|
function Skip(ASymTypes: TSymbolTypes = []): PWatchExpectation;
|
|
function SkipIf(ACond: Boolean; ASymTypes: TSymbolTypes = []): PWatchExpectation;
|
|
|
|
function IgnAll(ASymTypes: TSymbolTypes = []; ACond: Boolean = True): PWatchExpectation;
|
|
function IgnData(ASymTypes: TSymbolTypes = []; ACond: Boolean = True): PWatchExpectation;
|
|
function IgnKind(ASymTypes: TSymbolTypes = []; ACond: Boolean = True): PWatchExpectation;
|
|
function IgnKindPtr(ASymTypes: TSymbolTypes = []; ACond: Boolean = True): PWatchExpectation;
|
|
function IgnTypeName(ASymTypes: TSymbolTypes = []; ACond: Boolean = True): PWatchExpectation;
|
|
function MatchTypeName(ASymTypes: TSymbolTypes = []; ACond: Boolean = True): PWatchExpectation;
|
|
|
|
function CharFromIndex(ASymTypes: TSymbolTypes = []; ACond: Boolean = True): PWatchExpectation;
|
|
|
|
function ExpectNotFound(ASymTypes: TSymbolTypes = []; ACond: Boolean = True): PWatchExpectation;
|
|
function ExpectError(ASymTypes: TSymbolTypes = []; ACond: Boolean = True): PWatchExpectation;
|
|
|
|
function NotImplemented(ASymTypes: TSymbolTypes = []; ACond: Boolean = True): PWatchExpectation;
|
|
function NotImplementedData(ASymTypes: TSymbolTypes = []; ACond: Boolean = True): PWatchExpectation;
|
|
end;
|
|
|
|
TWatchExpectationResultArrayHelper = type helper for TWatchExpectationResultArray
|
|
end;
|
|
|
|
TWatchExpTestCurrentData = record
|
|
WatchExp: TWatchExpectation;
|
|
WatchVal: TWatchValue;
|
|
Expectation: TWatchExpectationResult;
|
|
HasTypeInfo: Boolean;
|
|
end;
|
|
|
|
{ TWatchExpectationList }
|
|
TDbgSymbolKinds = set of TDbgSymbolKind;
|
|
|
|
TWatchExpectationList = class
|
|
private
|
|
FAcceptSkSimple: TDbgSymbolKinds;
|
|
FTest: TDBGTestCase;
|
|
FList: array of TWatchExpectation;
|
|
FTypeNameAliases: TStringList;
|
|
|
|
FCurEvalCallWatchExp: PWatchExpectation;
|
|
procedure EvalCallback(Sender: TObject; ASuccess: Boolean;
|
|
ResultText: String; ResultDBGType: TDBGType);
|
|
function GetCompiler: TTestDbgCompiler;
|
|
function GetDebugger: TTestDbgDebugger;
|
|
function GetLazDebugger: TDebuggerIntf;
|
|
function GetTests(Index: Integer): PWatchExpectation;
|
|
function ParseCommaList(AVal: String; out AFoundCount: Integer;
|
|
AMaxLen: Integer = -1; AComma: char = ','): TStringArray;
|
|
protected
|
|
function EvaluateWatch(AWatchExp: PWatchExpectation; AThreadId: Integer): Boolean; virtual;
|
|
procedure WaitWhileEval; virtual;
|
|
|
|
function TestMatches(Name: string; Expected, Got: string; AContext: TWatchExpTestCurrentData; AIgnoreReason: String): Boolean;
|
|
function TestMatches(Name: string; Expected, Got: string; ACaseSense: Boolean; AContext: TWatchExpTestCurrentData; AIgnoreReason: String): Boolean;
|
|
function TestEquals(Name: string; Expected, Got: string; AContext: TWatchExpTestCurrentData; AIgnoreReason: String): Boolean;
|
|
function TestEquals(Name: string; Expected, Got: string; ACaseSense: Boolean; AContext: TWatchExpTestCurrentData; AIgnoreReason: String): Boolean;
|
|
function TestEquals(Name: string; Expected, Got: integer; AContext: TWatchExpTestCurrentData; AIgnoreReason: String): Boolean;
|
|
function TestTrue(Name: string; Got: Boolean; AContext: TWatchExpTestCurrentData; AIgnoreReason: String): Boolean;
|
|
function TestFalse(Name: string; Got: Boolean; AContext: TWatchExpTestCurrentData; AIgnoreReason: String): Boolean;
|
|
|
|
function CheckResult(AnWatchExp: TWatchExpectation): Boolean;
|
|
function CheckData(AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean; virtual;
|
|
function VerifyDebuggerState: Boolean; virtual;
|
|
function VerifySymType(AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean; virtual;
|
|
function VerifyTypeName(AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean; virtual;
|
|
|
|
function CheckResultMatch(AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean; virtual;
|
|
function CheckResultNum(AContext: TWatchExpTestCurrentData; IsCardinal: Boolean; AnIgnoreRsn: String): Boolean; virtual;
|
|
function CheckResultBool(AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean; virtual;
|
|
function CheckResultFloat(AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean; virtual;
|
|
function CheckResultEnum(AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean; virtual;
|
|
function CheckResultSet(AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean; virtual;
|
|
function CheckResultChar(AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean; virtual;
|
|
function CheckResultAnsiStr(AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean; virtual;
|
|
function CheckResultShortStr(AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean; virtual;
|
|
function CheckResultPointer(AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean; virtual;
|
|
function CheckResultPointerAddr(AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean; virtual;
|
|
function CheckResultArray(AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean; virtual;
|
|
function CheckStructureFields(const AnIgnoreRsn: String; var AContext: TWatchExpTestCurrentData): Boolean; virtual;
|
|
function CheckResultRecord(AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean; virtual;
|
|
function CheckResultClass(AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean; virtual;
|
|
function CheckResultObject(AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean; virtual;
|
|
function CheckResultInstance(AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean; virtual;
|
|
|
|
property Compiler: TTestDbgCompiler read GetCompiler;
|
|
property Debugger: TTestDbgDebugger read GetDebugger;
|
|
property LazDebugger: TDebuggerIntf read GetLazDebugger;
|
|
public
|
|
constructor Create(ATest: TDBGTestCase);
|
|
destructor Destroy; override;
|
|
|
|
function AddWithoutExpect(ATestName: String;
|
|
AnExpr: string;
|
|
AStackFrame: Integer = 0; AMinFpc: Integer = 0; AMinDbg: Integer = 0
|
|
): PWatchExpectation;
|
|
|
|
function Add(ATestName: String;
|
|
AnExpr: string; // AEvaluateFlags: TDBGEvaluateFlags; // AFmt: TWatchDisplayFormat;
|
|
AnExpect: TWatchExpectationResult;
|
|
AStackFrame: Integer = 0; AMinFpc: Integer = 0; AMinDbg: Integer = 0
|
|
// ASpecialFlags: ... // Ignore this or that // maybe per result
|
|
): PWatchExpectation;
|
|
|
|
function Add(
|
|
AnExpr: string; // AEvaluateFlags: TDBGEvaluateFlags; // AFmt: TWatchDisplayFormat;
|
|
AnExpect: TWatchExpectationResult;
|
|
AStackFrame: Integer = 0; AMinFpc: Integer = 0; AMinDbg: Integer = 0
|
|
): PWatchExpectation;
|
|
|
|
procedure AddIndexFromPrevious(IndexNames: array of string;
|
|
ValueIndex: array of integer; AnPreviousOffset: Integer = 0);
|
|
|
|
|
|
procedure Clear;
|
|
function Count: Integer;
|
|
procedure EvaluateWatches;
|
|
procedure CheckResults;
|
|
|
|
procedure AddTypeNameAlias(ATypeName, AnAliases: String);
|
|
property AcceptSkSimple: TDbgSymbolKinds read FAcceptSkSimple write FAcceptSkSimple ; // skSimple for skInteger,skChar,...
|
|
property Tests[Index: Integer]: PWatchExpectation read GetTests;
|
|
end;
|
|
|
|
|
|
function weMatch(AExpVal: String; ASymKind: TDBGSymbolKind; ATypeName: String=''): TWatchExpectationResult;
|
|
|
|
function weInteger(AExpVal: Int64; ATypeName: String=#1; ASize: Integer = 4): TWatchExpectationResult;
|
|
function weCardinal(AExpVal: QWord; ATypeName: String=#1; ASize: Integer = 4): TWatchExpectationResult;
|
|
function weSingle(AExpVal: Extended; ATypeName: String=#1): TWatchExpectationResult;
|
|
function weDouble(AExpVal: Extended; ATypeName: String=#1): TWatchExpectationResult;
|
|
function weFloat(AExpVal: Extended; ATypeName: String=''): TWatchExpectationResult;
|
|
|
|
function weBool(AExpVal: Boolean; ATypeName: String=#1): TWatchExpectationResult;
|
|
function weEnum(AExpVal: string; ATypeName: String=#1): TWatchExpectationResult;
|
|
function weSet(const AExpVal: Array of string; ATypeName: String=#1): TWatchExpectationResult;
|
|
|
|
function weChar(AExpVal: char; ATypeName: String=#1): TWatchExpectationResult;
|
|
function weWideChar(AExpVal: char; ATypeName: String=#1): TWatchExpectationResult;
|
|
function weAnsiStr(AExpVal: string; ATypeName: String=#1): TWatchExpectationResult;
|
|
function weShortStr(AExpVal: string; ATypeName: String=#1): TWatchExpectationResult;
|
|
function weWideStr(AExpVal: string; ATypeName: String=#1): TWatchExpectationResult;
|
|
function weUniStr(AExpVal: string; ATypeName: String=#1): TWatchExpectationResult;
|
|
|
|
function wePointer(ATypeName: String=''): TWatchExpectationResult;
|
|
function wePointer(AExpVal: TWatchExpectationResult; ATypeName: String=''): TWatchExpectationResult;
|
|
function wePointerAddr(AExpVal: Pointer; ATypeName: String=''): TWatchExpectationResult;
|
|
|
|
function weStatArray(const AExpVal: Array of TWatchExpectationResult; ATypeName: String=''): TWatchExpectationResult; overload;
|
|
function weStatArray(const AExpVal: Array of TWatchExpectationResult; AExpFullLen: Integer; ATypeName: String=''): TWatchExpectationResult; overload;
|
|
function weDynArray(const AExpVal: Array of TWatchExpectationResult; ATypeName: String=''): TWatchExpectationResult; overload;
|
|
function weDynArray(const AExpVal: Array of TWatchExpectationResult; AExpFullLen: Integer; ATypeName: String=''): TWatchExpectationResult; overload;
|
|
|
|
// common arrays: weTttArray(weChar([...]))
|
|
function weChar(const AExpVal: array of char; ATypeName: String=#1): TWatchExpectationResultArray;
|
|
function weWideChar(const AExpVal: array of char; ATypeName: String=#1): TWatchExpectationResultArray;
|
|
function weInteger(const AExpVal: array of Int64; ATypeName: String=#1; ASize: Integer = 4): TWatchExpectationResultArray;
|
|
function weAnsiStr(const AExpVal: array of string; ATypeName: String=#1): TWatchExpectationResultArray;
|
|
function weShortStr(const AExpVal: array of string; ATypeName: String=#1): TWatchExpectationResultArray;
|
|
|
|
|
|
|
|
function weRecord(AExpFields: array of TWatchExpectationResult; ATypeName: String=#1): TWatchExpectationResult;
|
|
function weClass(AExpFields: array of TWatchExpectationResult; ATypeName: String=#1): TWatchExpectationResult;
|
|
function weObject(AExpFields: array of TWatchExpectationResult; ATypeName: String=#1): TWatchExpectationResult;
|
|
function weInterface(AExpFields: array of TWatchExpectationResult; ATypeName: String=#1): TWatchExpectationResult;
|
|
|
|
|
|
operator := (a:string): TWatchExpectationResult;
|
|
operator := (a:integer): TWatchExpectationResult;
|
|
operator := (a:pointer): TWatchExpectationResult;
|
|
|
|
|
|
|
|
implementation
|
|
|
|
operator := (a:string): TWatchExpectationResult;
|
|
begin
|
|
Result := weAnsiStr(a);
|
|
end;
|
|
|
|
operator := (a:integer): TWatchExpectationResult;
|
|
begin
|
|
Result := weInteger(a);
|
|
end;
|
|
|
|
operator := (a: pointer): TWatchExpectationResult;
|
|
begin
|
|
Result := wePointerAddr(a);
|
|
end;
|
|
|
|
type
|
|
|
|
{ TStringArrayHelper }
|
|
|
|
TStringArrayHelper = type helper for TStringArray
|
|
function IndexOfFieldName(AName: String; ALength: Integer = Maxint; Sep: char = '='): Integer;
|
|
function ValueOfFieldName(AnIndex: Integer; Sep: char = '='): String;
|
|
procedure delete(AStart, ACnt: Integer);
|
|
end;
|
|
|
|
{ TStringArrayHelper }
|
|
|
|
function TStringArrayHelper.IndexOfFieldName(AName: String; ALength: Integer;
|
|
Sep: char): Integer;
|
|
var
|
|
i: Integer;
|
|
p: SizeInt;
|
|
begin
|
|
ALength := Min(ALength, Length(Self));
|
|
Result := 0;
|
|
while Result < ALength do begin
|
|
p := pos(Sep, Self[Result]);
|
|
if (p >= 0) and (LowerCase(trim(Copy(Self[Result], 1, p-1))) = LowerCase(AName)) then
|
|
exit;
|
|
inc(Result);
|
|
end;
|
|
if Result >= ALength then
|
|
Result := -1;
|
|
end;
|
|
|
|
function TStringArrayHelper.ValueOfFieldName(AnIndex: Integer; Sep: char
|
|
): String;
|
|
begin
|
|
Result := trim(copy(Self[AnIndex], pos(Sep, Self[AnIndex])+1, MaxInt));
|
|
end;
|
|
|
|
procedure TStringArrayHelper.delete(AStart, ACnt: Integer);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if ACnt <= 0 then exit;
|
|
for i := AStart to Length(Self)-1 - ACnt do
|
|
Self[i] := Self[i+ACnt];
|
|
end;
|
|
|
|
function weMatch(AExpVal: String; ASymKind: TDBGSymbolKind; ATypeName: String
|
|
): TWatchExpectationResult;
|
|
begin
|
|
Result := Default(TWatchExpectationResult);
|
|
Result.ExpResultKind := rkMatch;
|
|
Result.ExpSymKind := ASymKind;
|
|
Result.ExpTextData := AExpVal;
|
|
end;
|
|
|
|
function weInteger(AExpVal: Int64; ATypeName: String; ASize: Integer
|
|
): TWatchExpectationResult;
|
|
begin
|
|
Result := Default(TWatchExpectationResult);
|
|
if ATypeName = #1 then ATypeName := 'Integer';
|
|
Result.ExpResultKind := rkInteger;
|
|
Result.ExpSymKind := skInteger;
|
|
Result.ExpTypeName := ATypeName;
|
|
Result.expIntValue := AExpVal;
|
|
Result.expIntSize := ASize;
|
|
end;
|
|
|
|
function weCardinal(AExpVal: QWord; ATypeName: String; ASize: Integer
|
|
): TWatchExpectationResult;
|
|
begin
|
|
Result := Default(TWatchExpectationResult);
|
|
if ATypeName = #1 then ATypeName := 'Cardinal';
|
|
Result.ExpResultKind := rkCardinal;
|
|
Result.ExpSymKind := skCardinal;
|
|
Result.ExpTypeName := ATypeName;
|
|
Result.expCardinalValue := AExpVal;
|
|
Result.expCardinalSize := ASize;
|
|
end;
|
|
|
|
function weSingle(AExpVal: Extended; ATypeName: String
|
|
): TWatchExpectationResult;
|
|
begin
|
|
if ATypeName = #1 then ATypeName := 'Single';
|
|
Result := weFloat(AExpVal, ATypeName);
|
|
end;
|
|
|
|
function weDouble(AExpVal: Extended; ATypeName: String
|
|
): TWatchExpectationResult;
|
|
begin
|
|
if ATypeName = #1 then ATypeName := 'Double';
|
|
Result := weFloat(AExpVal, ATypeName);
|
|
end;
|
|
|
|
function weFloat(AExpVal: Extended; ATypeName: String): TWatchExpectationResult;
|
|
begin
|
|
Result := Default(TWatchExpectationResult);
|
|
Result.ExpResultKind := rkFloat;
|
|
Result.ExpSymKind := skFloat;
|
|
Result.ExpTypeName := ATypeName;
|
|
Result.ExpFloatValue := AExpVal;
|
|
end;
|
|
|
|
function weBool(AExpVal: Boolean; ATypeName: String): TWatchExpectationResult;
|
|
begin
|
|
Result := Default(TWatchExpectationResult);
|
|
if ATypeName = #1 then ATypeName := 'Boolean';
|
|
Result.ExpResultKind := rkBool;
|
|
Result.ExpSymKind := skBoolean;
|
|
Result.ExpTypeName := ATypeName;
|
|
Result.ExpBoolValue := AExpVal;
|
|
end;
|
|
|
|
function weEnum(AExpVal: string; ATypeName: String): TWatchExpectationResult;
|
|
begin
|
|
Result := Default(TWatchExpectationResult);
|
|
if ATypeName = #1 then ATypeName := '';
|
|
Result.ExpResultKind := rkEnum;
|
|
Result.ExpSymKind := skEnum;
|
|
Result.ExpTypeName := ATypeName;
|
|
Result.ExpTextData := AExpVal;
|
|
end;
|
|
|
|
function weSet(const AExpVal: array of string; ATypeName: String
|
|
): TWatchExpectationResult;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := Default(TWatchExpectationResult);
|
|
if ATypeName = #1 then ATypeName := '';
|
|
Result.ExpResultKind := rkSet;
|
|
Result.ExpSymKind := skSet;
|
|
Result.ExpTypeName := ATypeName;
|
|
SetLength(Result.ExpSetData, Length(AExpVal));
|
|
for i := 0 to Length(AExpVal) - 1 do
|
|
Result.ExpSetData[i] := AExpVal[i];
|
|
end;
|
|
|
|
function weChar(AExpVal: char; ATypeName: String): TWatchExpectationResult;
|
|
begin
|
|
Result := Default(TWatchExpectationResult);
|
|
if ATypeName = #1 then ATypeName := 'Char';
|
|
Result.ExpResultKind := rkChar;
|
|
Result.ExpSymKind := skChar;
|
|
Result.ExpTypeName := ATypeName;
|
|
Result.ExpTextData := AExpVal;
|
|
end;
|
|
|
|
function weWideChar(AExpVal: char; ATypeName: String): TWatchExpectationResult;
|
|
begin
|
|
Result := Default(TWatchExpectationResult);
|
|
if ATypeName = #1 then ATypeName := 'WideChar';
|
|
Result.ExpResultKind := rkChar;
|
|
Result.ExpSymKind := skChar;
|
|
Result.ExpTypeName := ATypeName;
|
|
Result.ExpTextData := AExpVal;
|
|
end;
|
|
|
|
function weAnsiStr(AExpVal: string; ATypeName: String): TWatchExpectationResult;
|
|
begin
|
|
Result := Default(TWatchExpectationResult);
|
|
if ATypeName = #1 then ATypeName := 'AnsiString';
|
|
Result.ExpResultKind := rkAnsiString;
|
|
Result.ExpSymKind := skAnsiString;
|
|
Result.ExpTypeName := ATypeName;
|
|
Result.ExpTextData := AExpVal;
|
|
end;
|
|
|
|
function weShortStr(AExpVal: string; ATypeName: String
|
|
): TWatchExpectationResult;
|
|
begin
|
|
Result := Default(TWatchExpectationResult);
|
|
if ATypeName = #1 then ATypeName := 'ShortString';
|
|
Result.ExpResultKind := rkShortString;
|
|
Result.ExpSymKind := skString;
|
|
Result.ExpTypeName := ATypeName;
|
|
Result.ExpTextData := AExpVal;
|
|
end;
|
|
|
|
function weWideStr(AExpVal: string; ATypeName: String): TWatchExpectationResult;
|
|
begin
|
|
Result := Default(TWatchExpectationResult);
|
|
if ATypeName = #1 then ATypeName := 'WideString';
|
|
Result.ExpResultKind := rkWideString;
|
|
Result.ExpSymKind := skWideString;
|
|
Result.ExpTypeName := ATypeName;
|
|
Result.ExpTextData := AExpVal;
|
|
end;
|
|
|
|
function weUniStr(AExpVal: string; ATypeName: String): TWatchExpectationResult;
|
|
begin
|
|
Result := Default(TWatchExpectationResult);
|
|
if ATypeName = #1 then ATypeName := 'UnicodeString';
|
|
Result.ExpResultKind := rkWideString;
|
|
Result.ExpSymKind := skWideString;
|
|
Result.ExpTypeName := ATypeName;
|
|
Result.ExpTextData := AExpVal;
|
|
end;
|
|
|
|
function wePointer(ATypeName: String): TWatchExpectationResult;
|
|
begin
|
|
Result := Default(TWatchExpectationResult);
|
|
Result.ExpResultKind := rkPointer;
|
|
Result.ExpSymKind := skPointer;
|
|
Result.ExpTypeName := ATypeName;
|
|
end;
|
|
|
|
function wePointer(AExpVal: TWatchExpectationResult; ATypeName: String
|
|
): TWatchExpectationResult;
|
|
begin
|
|
Result := Default(TWatchExpectationResult);
|
|
Result.ExpResultKind := rkPointer;
|
|
Result.ExpSymKind := skPointer;
|
|
Result.ExpTypeName := ATypeName;
|
|
SetLength(Result.ExpSubResults, 1);
|
|
Result.ExpSubResults[0] := AExpVal;
|
|
end;
|
|
|
|
function wePointerAddr(AExpVal: Pointer; ATypeName: String
|
|
): TWatchExpectationResult;
|
|
begin
|
|
Result := Default(TWatchExpectationResult);
|
|
Result.ExpResultKind := rkPointerAddr;
|
|
Result.ExpSymKind := skPointer;
|
|
Result.ExpTypeName := ATypeName;
|
|
Result.ExpPointerValue := AExpVal;
|
|
end;
|
|
|
|
function weStatArray(const AExpVal: array of TWatchExpectationResult;
|
|
ATypeName: String): TWatchExpectationResult;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := Default(TWatchExpectationResult);
|
|
Result.ExpResultKind := rkStatArray;
|
|
Result.ExpSymKind := skArray;
|
|
Result.ExpTypeName := ATypeName;
|
|
Result.ExpFullArrayLen := Length(AExpVal);
|
|
SetLength(Result.ExpSubResults, Length(AExpVal));
|
|
for i := 0 to high(AExpVal) do
|
|
Result.ExpSubResults[i] := AExpVal[i];
|
|
end;
|
|
|
|
function weStatArray(const AExpVal: array of TWatchExpectationResult;
|
|
AExpFullLen: Integer; ATypeName: String): TWatchExpectationResult;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := Default(TWatchExpectationResult);
|
|
Result.ExpResultKind := rkStatArray;
|
|
Result.ExpSymKind := skArray;
|
|
Result.ExpTypeName := ATypeName;
|
|
Result.ExpFullArrayLen := AExpFullLen;
|
|
SetLength(Result.ExpSubResults, Length(AExpVal));
|
|
for i := 0 to high(AExpVal) do
|
|
Result.ExpSubResults[i] := AExpVal[i];
|
|
end;
|
|
|
|
function weDynArray(const AExpVal: array of TWatchExpectationResult;
|
|
ATypeName: String): TWatchExpectationResult;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := Default(TWatchExpectationResult);
|
|
Result.ExpResultKind := rkDynArray;
|
|
Result.ExpSymKind := skArray;
|
|
Result.ExpTypeName := ATypeName;
|
|
Result.ExpFullArrayLen := Length(AExpVal);
|
|
SetLength(Result.ExpSubResults, Length(AExpVal));
|
|
for i := 0 to high(AExpVal) do
|
|
Result.ExpSubResults[i] := AExpVal[i];
|
|
end;
|
|
|
|
function weDynArray(const AExpVal: array of TWatchExpectationResult;
|
|
AExpFullLen: Integer; ATypeName: String): TWatchExpectationResult;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := Default(TWatchExpectationResult);
|
|
Result.ExpResultKind := rkDynArray;
|
|
Result.ExpSymKind := skArray;
|
|
Result.ExpTypeName := ATypeName;
|
|
Result.ExpFullArrayLen := AExpFullLen;
|
|
SetLength(Result.ExpSubResults, Length(AExpVal));
|
|
for i := 0 to high(AExpVal) do
|
|
Result.ExpSubResults[i] := AExpVal[i];
|
|
end;
|
|
|
|
function weChar(const AExpVal: array of char; ATypeName: String
|
|
): TWatchExpectationResultArray;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
SetLength(Result, Length(AExpVal));
|
|
for i := 0 to Length(AExpVal) - 1 do
|
|
Result[i] := weChar(AExpVal[i], ATypeName);
|
|
end;
|
|
|
|
function weWideChar(const AExpVal: array of char; ATypeName: String
|
|
): TWatchExpectationResultArray;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
SetLength(Result, Length(AExpVal));
|
|
for i := 0 to Length(AExpVal) - 1 do
|
|
Result[i] := weWideChar(AExpVal[i], ATypeName);
|
|
end;
|
|
|
|
function weInteger(const AExpVal: array of Int64; ATypeName: String;
|
|
ASize: Integer): TWatchExpectationResultArray;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
SetLength(Result, Length(AExpVal));
|
|
for i := 0 to Length(AExpVal) - 1 do
|
|
Result[i] := weInteger(AExpVal[i], ATypeName, ASize);
|
|
end;
|
|
|
|
function weAnsiStr(const AExpVal: array of string; ATypeName: String
|
|
): TWatchExpectationResultArray;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
SetLength(Result, Length(AExpVal));
|
|
for i := 0 to Length(AExpVal) - 1 do
|
|
Result[i] := weAnsiStr(AExpVal[i], ATypeName);
|
|
end;
|
|
|
|
function weShortStr(const AExpVal: array of string; ATypeName: String
|
|
): TWatchExpectationResultArray;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
SetLength(Result, Length(AExpVal));
|
|
for i := 0 to Length(AExpVal) - 1 do
|
|
Result[i] := weShortStr(AExpVal[i], ATypeName);
|
|
end;
|
|
|
|
function weRecord(AExpFields: array of TWatchExpectationResult;
|
|
ATypeName: String): TWatchExpectationResult;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := Default(TWatchExpectationResult);
|
|
Result.ExpResultKind := rkRecord;
|
|
Result.ExpSymKind := skRecord;
|
|
Result.ExpTypeName := ATypeName;
|
|
Result.ExpFullArrayLen := Length(AExpFields);
|
|
SetLength(Result.ExpSubResults, Length(AExpFields));
|
|
for i := 0 to high(AExpFields) do
|
|
Result.ExpSubResults[i] := AExpFields[i];
|
|
end;
|
|
|
|
function weClass(AExpFields: array of TWatchExpectationResult; ATypeName: String
|
|
): TWatchExpectationResult;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := Default(TWatchExpectationResult);
|
|
Result.ExpResultKind := rkClass;
|
|
Result.ExpSymKind := skClass;
|
|
Result.ExpTypeName := ATypeName;
|
|
Result.ExpFullArrayLen := Length(AExpFields);
|
|
SetLength(Result.ExpSubResults, Length(AExpFields));
|
|
for i := 0 to high(AExpFields) do
|
|
Result.ExpSubResults[i] := AExpFields[i];
|
|
end;
|
|
|
|
function weObject(AExpFields: array of TWatchExpectationResult;
|
|
ATypeName: String): TWatchExpectationResult;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := Default(TWatchExpectationResult);
|
|
Result.ExpResultKind := rkObject;
|
|
Result.ExpSymKind := skObject;
|
|
Result.ExpTypeName := ATypeName;
|
|
Result.ExpFullArrayLen := Length(AExpFields);
|
|
SetLength(Result.ExpSubResults, Length(AExpFields));
|
|
for i := 0 to high(AExpFields) do
|
|
Result.ExpSubResults[i] := AExpFields[i];
|
|
end;
|
|
|
|
function weInterface(AExpFields: array of TWatchExpectationResult;
|
|
ATypeName: String): TWatchExpectationResult;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := Default(TWatchExpectationResult);
|
|
Result.ExpResultKind := rkInterface;
|
|
Result.ExpSymKind := skInterface;
|
|
Result.ExpTypeName := ATypeName;
|
|
Result.ExpFullArrayLen := Length(AExpFields);
|
|
SetLength(Result.ExpSubResults, Length(AExpFields));
|
|
for i := 0 to high(AExpFields) do
|
|
Result.ExpSubResults[i] := AExpFields[i];
|
|
end;
|
|
|
|
{ TWatchExpectationResult }
|
|
|
|
function TWatchExpectationResult.AddFlag(AFlag: TWatchExpErrorHandlingFlag;
|
|
ASymTypes: TSymbolTypes): TWatchExpectationResult;
|
|
var
|
|
i: TSymbolType;
|
|
begin
|
|
if ASymTypes = [] then ASymTypes := [low(ASymTypes)..high(ASymTypes)];
|
|
for i := low(ASymTypes) to high(ASymTypes) do
|
|
if i in ASymTypes then
|
|
ExpErrorHandlingFlags[i] := ExpErrorHandlingFlags[i] + [AFlag];
|
|
Result := Self;
|
|
end;
|
|
|
|
function TWatchExpectationResult.AddFlag(AFlags: TWatchExpErrorHandlingFlags;
|
|
ASymTypes: TSymbolTypes): TWatchExpectationResult;
|
|
var
|
|
i: TSymbolType;
|
|
begin
|
|
if ASymTypes = [] then ASymTypes := [low(ASymTypes)..high(ASymTypes)];
|
|
for i := low(ASymTypes) to high(ASymTypes) do
|
|
if i in ASymTypes then
|
|
ExpErrorHandlingFlags[i] := ExpErrorHandlingFlags[i] + AFlags;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TWatchExpectationResult.N(AFieldName: String): TWatchExpectationResult;
|
|
begin
|
|
Self.ExpFieldName := AFieldName;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TWatchExpectationResult.Skip(ASymTypes: TSymbolTypes
|
|
): TWatchExpectationResult;
|
|
begin
|
|
Result := Self.AddFlag(ehTestSkip, ASymTypes);
|
|
end;
|
|
|
|
function TWatchExpectationResult.SkipIf(ACond: Boolean; ASymTypes: TSymbolTypes
|
|
): TWatchExpectationResult;
|
|
begin
|
|
if ACond then
|
|
Result := Self.AddFlag(ehTestSkip, ASymTypes)
|
|
else
|
|
Result := Self;
|
|
end;
|
|
|
|
function TWatchExpectationResult.IgnAll(ASymTypes: TSymbolTypes
|
|
): TWatchExpectationResult;
|
|
begin
|
|
Result := Self.AddFlag(ehIgnAll, ASymTypes);
|
|
end;
|
|
|
|
function TWatchExpectationResult.IgnData(ASymTypes: TSymbolTypes
|
|
): TWatchExpectationResult;
|
|
begin
|
|
Result := Self.AddFlag(ehIgnData, ASymTypes);
|
|
end;
|
|
|
|
function TWatchExpectationResult.IgnKind(ASymTypes: TSymbolTypes
|
|
): TWatchExpectationResult;
|
|
begin
|
|
Result := Self.AddFlag(ehIgnKind, ASymTypes);
|
|
end;
|
|
|
|
function TWatchExpectationResult.IgnKindPtr(ASymTypes: TSymbolTypes
|
|
): TWatchExpectationResult;
|
|
begin
|
|
Result := Self.AddFlag(ehIgnKindPtr, ASymTypes);
|
|
end;
|
|
|
|
function TWatchExpectationResult.IgnTypeName(ASymTypes: TSymbolTypes
|
|
): TWatchExpectationResult;
|
|
begin
|
|
Result := Self.AddFlag(ehIgnTypeName, ASymTypes);
|
|
end;
|
|
|
|
function TWatchExpectationResult.MatchTypeName(ASymTypes: TSymbolTypes
|
|
): TWatchExpectationResult;
|
|
begin
|
|
Result := Self.AddFlag(ehMatchTypeName, ASymTypes);
|
|
end;
|
|
|
|
function TWatchExpectationResult.CharFromIndex(ASymTypes: TSymbolTypes
|
|
): TWatchExpectationResult;
|
|
begin
|
|
Result := Self.AddFlag(ehCharFromIndex, ASymTypes);
|
|
end;
|
|
|
|
function TWatchExpectationResult.ExpectNotFound(ASymTypes: TSymbolTypes
|
|
): TWatchExpectationResult;
|
|
begin
|
|
Result := Self.AddFlag(ehExpectNotFound, ASymTypes);
|
|
end;
|
|
|
|
function TWatchExpectationResult.ExpectError(ASymTypes: TSymbolTypes
|
|
): TWatchExpectationResult;
|
|
begin
|
|
Result := Self.AddFlag(ehExpectError, ASymTypes);
|
|
end;
|
|
|
|
function TWatchExpectationResult.NotImplemented(ASymTypes: TSymbolTypes
|
|
): TWatchExpectationResult;
|
|
begin
|
|
Result := Self.AddFlag(ehNotImplemented, ASymTypes);
|
|
end;
|
|
|
|
function TWatchExpectationResult.NotImplementedData(ASymTypes: TSymbolTypes
|
|
): TWatchExpectationResult;
|
|
begin
|
|
Result := Self.AddFlag(ehNotImplementedData, ASymTypes);
|
|
end;
|
|
|
|
procedure TWatchExpectationResult.MakeCopy;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
ExpSubResults := copy(ExpSubResults, low(ExpSubResults), high(ExpSubResults));
|
|
ExpSetData := copy(ExpSetData, low(ExpSetData), high(ExpSetData));
|
|
for i := low(ExpSubResults) to high(ExpSubResults) do
|
|
ExpSubResults[i].MakeCopy;
|
|
end;
|
|
|
|
{ TWatchExpectationHelper }
|
|
|
|
function TWatchExpectationHelper.AddFlag(AFlag: TWatchExpErrorHandlingFlag;
|
|
ASymTypes: TSymbolTypes; ACond: Boolean): PWatchExpectation;
|
|
begin
|
|
if ACond then
|
|
Result := Self^.AddFlag(AFlag, ASymTypes)
|
|
else
|
|
Result := Self;
|
|
end;
|
|
|
|
function TWatchExpectationHelper.AddFlag(AFlags: TWatchExpErrorHandlingFlags;
|
|
ASymTypes: TSymbolTypes; ACond: Boolean): PWatchExpectation;
|
|
begin
|
|
if ACond then
|
|
Result := Self^.AddFlag(AFlags, ASymTypes)
|
|
else
|
|
Result := Self;
|
|
end;
|
|
|
|
function TWatchExpectationHelper.AddFlag(AFlag: TWatchExpErrorHandlingFlag;
|
|
ACond: Boolean): PWatchExpectation;
|
|
begin
|
|
if ACond then
|
|
Result := Self^.AddFlag(AFlag, [])
|
|
else
|
|
Result := Self;
|
|
end;
|
|
|
|
function TWatchExpectationHelper.AddFlag(AFlags: TWatchExpErrorHandlingFlags;
|
|
ACond: Boolean): PWatchExpectation;
|
|
begin
|
|
if ACond then
|
|
Result := Self^.AddFlag(AFlags, [])
|
|
else
|
|
Result := Self;
|
|
end;
|
|
|
|
function TWatchExpectationHelper.Skip(ASymTypes: TSymbolTypes
|
|
): PWatchExpectation;
|
|
begin
|
|
Result := Self^.AddFlag(ehTestSkip, ASymTypes);
|
|
end;
|
|
|
|
function TWatchExpectationHelper.SkipIf(ACond: Boolean; ASymTypes: TSymbolTypes
|
|
): PWatchExpectation;
|
|
begin
|
|
if ACond then
|
|
Result := Self^.AddFlag(ehTestSkip, ASymTypes)
|
|
else
|
|
Result := Self;
|
|
end;
|
|
|
|
function TWatchExpectationHelper.IgnAll(ASymTypes: TSymbolTypes; ACond: Boolean
|
|
): PWatchExpectation;
|
|
begin
|
|
if not ACond then exit(Self);
|
|
Result := Self^.AddFlag(ehIgnAll, ASymTypes);
|
|
end;
|
|
|
|
function TWatchExpectationHelper.IgnData(ASymTypes: TSymbolTypes; ACond: Boolean): PWatchExpectation;
|
|
begin
|
|
if not ACond then exit(Self);
|
|
Result := Self^.AddFlag(ehIgnData, ASymTypes);
|
|
end;
|
|
|
|
function TWatchExpectationHelper.IgnKind(ASymTypes: TSymbolTypes; ACond: Boolean): PWatchExpectation;
|
|
begin
|
|
if not ACond then exit(Self);
|
|
Result := Self^.AddFlag(ehIgnKind, ASymTypes);
|
|
end;
|
|
|
|
function TWatchExpectationHelper.IgnKindPtr(ASymTypes: TSymbolTypes; ACond: Boolean): PWatchExpectation;
|
|
begin
|
|
if not ACond then exit(Self);
|
|
Result := Self^.AddFlag(ehIgnKindPtr, ASymTypes);
|
|
end;
|
|
|
|
function TWatchExpectationHelper.IgnTypeName(ASymTypes: TSymbolTypes; ACond: Boolean): PWatchExpectation;
|
|
begin
|
|
if not ACond then exit(Self);
|
|
Result := Self^.AddFlag(ehIgnTypeName, ASymTypes);
|
|
end;
|
|
|
|
function TWatchExpectationHelper.MatchTypeName(ASymTypes: TSymbolTypes; ACond: Boolean): PWatchExpectation;
|
|
begin
|
|
if not ACond then exit(Self);
|
|
Result := Self^.AddFlag(ehMatchTypeName, ASymTypes);
|
|
end;
|
|
|
|
function TWatchExpectationHelper.CharFromIndex(ASymTypes: TSymbolTypes; ACond: Boolean): PWatchExpectation;
|
|
begin
|
|
if not ACond then exit(Self);
|
|
Result := Self^.AddFlag(ehCharFromIndex, ASymTypes);
|
|
end;
|
|
|
|
function TWatchExpectationHelper.ExpectNotFound(ASymTypes: TSymbolTypes; ACond: Boolean): PWatchExpectation;
|
|
begin
|
|
if not ACond then exit(Self);
|
|
Result := Self^.AddFlag(ehExpectNotFound, ASymTypes);
|
|
end;
|
|
|
|
function TWatchExpectationHelper.ExpectError(ASymTypes: TSymbolTypes; ACond: Boolean): PWatchExpectation;
|
|
begin
|
|
if not ACond then exit(Self);
|
|
Result := Self^.AddFlag(ehExpectError, ASymTypes);
|
|
end;
|
|
|
|
function TWatchExpectationHelper.NotImplemented(ASymTypes: TSymbolTypes; ACond: Boolean): PWatchExpectation;
|
|
begin
|
|
if not ACond then exit(Self);
|
|
Result := Self^.AddFlag(ehNotImplemented, ASymTypes);
|
|
end;
|
|
|
|
function TWatchExpectationHelper.NotImplementedData(ASymTypes: TSymbolTypes; ACond: Boolean): PWatchExpectation;
|
|
begin
|
|
if not ACond then exit(Self);
|
|
Result := Self^.AddFlag(ehNotImplementedData, ASymTypes);
|
|
end;
|
|
|
|
{ TWatchExpectation }
|
|
|
|
function TWatchExpectation.AddFlag(AFlag: TWatchExpErrorHandlingFlag;
|
|
ASymTypes: TSymbolTypes): PWatchExpectation;
|
|
var
|
|
i: TSymbolType;
|
|
begin
|
|
if ASymTypes = [] then ASymTypes := [low(ASymTypes)..high(ASymTypes)];
|
|
for i := low(ASymTypes) to high(ASymTypes) do
|
|
if i in ASymTypes then
|
|
TstExpected.ExpErrorHandlingFlags[i] := TstExpected.ExpErrorHandlingFlags[i] + [AFlag];
|
|
Result := @Self;
|
|
end;
|
|
|
|
function TWatchExpectation.AddFlag(AFlags: TWatchExpErrorHandlingFlags;
|
|
ASymTypes: TSymbolTypes): PWatchExpectation;
|
|
var
|
|
i: TSymbolType;
|
|
begin
|
|
if ASymTypes = [] then ASymTypes := [low(ASymTypes)..high(ASymTypes)];
|
|
for i := low(ASymTypes) to high(ASymTypes) do
|
|
if i in ASymTypes then
|
|
TstExpected.ExpErrorHandlingFlags[i] := TstExpected.ExpErrorHandlingFlags[i] + AFlags;
|
|
Result := @Self;
|
|
end;
|
|
|
|
{ TWatchExpectationList }
|
|
|
|
function TWatchExpectationList.GetDebugger: TTestDbgDebugger;
|
|
begin
|
|
Result := FTest.Debugger;
|
|
end;
|
|
|
|
function TWatchExpectationList.GetCompiler: TTestDbgCompiler;
|
|
begin
|
|
Result := FTest.Compiler;
|
|
end;
|
|
|
|
function TWatchExpectationList.GetLazDebugger: TDebuggerIntf;
|
|
begin
|
|
Result := Debugger.LazDebugger;
|
|
end;
|
|
|
|
function TWatchExpectationList.GetTests(Index: Integer): PWatchExpectation;
|
|
begin
|
|
if Index < 0 then
|
|
Index := Index + Count;
|
|
Result := @FList[Index];
|
|
end;
|
|
|
|
function TWatchExpectationList.ParseCommaList(AVal: String; out
|
|
AFoundCount: Integer; AMaxLen: Integer; AComma: char): TStringArray;
|
|
var
|
|
i, BracketLvl: Integer;
|
|
InQuote: Boolean;
|
|
begin
|
|
if AMaxLen < 0 then
|
|
SetLength(Result, Length(AVal) div 2)
|
|
else
|
|
SetLength(Result, AMaxLen);
|
|
|
|
i := 1;
|
|
AFoundCount := 0;
|
|
BracketLvl := 0;
|
|
InQuote := false;
|
|
while length(AVal) > 0 do begin
|
|
while (i <= length(AVal)) and (
|
|
(AVal[i] <> AComma) or (BracketLvl > 0) or InQuote
|
|
)
|
|
do begin
|
|
case AVal[i] of
|
|
'(': if not InQuote then inc(BracketLvl);
|
|
')': if not InQuote then dec(BracketLvl);
|
|
'''':
|
|
if InQuote and (i < length(AVal)) and (AVal[i+1] = '''') then inc(i)
|
|
else InQuote := not InQuote;
|
|
end;
|
|
inc(i);
|
|
end;
|
|
|
|
//if (AMaxLen >=0) and (AFoundCount >= AMaxLen) then begin
|
|
// AFoundCount := -1; // more than expected
|
|
// exit;
|
|
//end;
|
|
|
|
if AFoundCount < Length(Result) then
|
|
Result[AFoundCount] := copy(AVal, 1, i-1);
|
|
inc(AFoundCount);
|
|
delete(AVal, 1, i);
|
|
i := 1;
|
|
if (length(AVal) > 0) and (AVal[1] = ' ') then
|
|
delete(AVal, 1, 1);
|
|
end;
|
|
end;
|
|
|
|
procedure TWatchExpectationList.EvalCallback(Sender: TObject;
|
|
ASuccess: Boolean; ResultText: String; ResultDBGType: TDBGType);
|
|
begin
|
|
if FCurEvalCallWatchExp = nil then begin
|
|
DebugLn('???????? Late result');
|
|
exit;
|
|
end;
|
|
FCurEvalCallWatchExp^.EvalCallResSuccess := ASuccess;
|
|
FCurEvalCallWatchExp^.EvalCallResText := ResultText;
|
|
FCurEvalCallWatchExp^.EvalCallResDBGType := ResultDBGType;
|
|
FCurEvalCallWatchExp^.EvalCallResReceived := True;
|
|
end;
|
|
|
|
function TWatchExpectationList.EvaluateWatch(AWatchExp: PWatchExpectation;
|
|
AThreadId: Integer): Boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
with LazDebugger.GetLocation do
|
|
FTest.LogText('###### ' + AWatchExp^.TstTestName + ' // ' + AWatchExp^.TstWatch.Expression +
|
|
' (AT '+ SrcFile + ':' + IntToStr(SrcLine) +')' +
|
|
'###### '+LineEnding);
|
|
AWatchExp^.TstWatch.Values[AThreadId, AWatchExp^.TstStackFrame].Value;
|
|
|
|
for i := 1 to 5 do begin
|
|
Application.Idle(False);
|
|
Result := AWatchExp^.TstWatch.Values[AThreadId, AWatchExp^.TstStackFrame].Validity <> ddsRequested;
|
|
if Result then break;
|
|
WaitWhileEval;
|
|
end;
|
|
FTest.LogText('<<<<< ' + dbgs(AWatchExp^.TstWatch.Values[AThreadId, AWatchExp^.TstStackFrame].Validity) + ': ' +
|
|
AWatchExp^.TstWatch.Values[AThreadId, AWatchExp^.TstStackFrame].Value );
|
|
|
|
|
|
if AWatchExp^.EvalCallTestFlags <> [] then begin
|
|
// TODO: set thread/stack
|
|
FCurEvalCallWatchExp := AWatchExp;
|
|
AWatchExp^.EvalCallResReceived := False;
|
|
|
|
LazDebugger.Evaluate(AWatchExp^.TstWatch.Expression, @EvalCallback, AWatchExp^.EvalCallTestFlags);
|
|
|
|
for i := 1 to 5 do begin
|
|
Application.Idle(False);
|
|
if AWatchExp^.EvalCallResReceived then break;
|
|
WaitWhileEval;
|
|
end;
|
|
|
|
FTest.LogText('<<<<< CB:'+ dbgs(AWatchExp^.EvalCallResReceived)+ ' Res'+ dbgs(AWatchExp^.EvalCallResSuccess)+
|
|
' Tp:'+dbgs(AWatchExp^.EvalCallResDBGType <> nil)+ ' '+ AWatchExp^.EvalCallResText );
|
|
end;
|
|
FCurEvalCallWatchExp := nil;
|
|
end;
|
|
|
|
procedure TWatchExpectationList.WaitWhileEval;
|
|
begin
|
|
FTest.Debugger.WaitForFinishRun(25, True);
|
|
end;
|
|
|
|
function TWatchExpectationList.TestMatches(Name: string; Expected, Got: string;
|
|
AContext: TWatchExpTestCurrentData; AIgnoreReason: String): Boolean;
|
|
begin
|
|
Result := FTest.TestMatches(Name, Expected, Got, AContext.WatchExp.TstMinDbg, AContext.WatchExp.TstMinFpc, AIgnoreReason);
|
|
end;
|
|
|
|
function TWatchExpectationList.TestMatches(Name: string; Expected, Got: string;
|
|
ACaseSense: Boolean; AContext: TWatchExpTestCurrentData; AIgnoreReason: String
|
|
): Boolean;
|
|
begin
|
|
Result := FTest.TestMatches(Name, Expected, Got, ACaseSense, AContext.WatchExp.TstMinDbg, AContext.WatchExp.TstMinFpc, AIgnoreReason);
|
|
end;
|
|
|
|
function TWatchExpectationList.TestEquals(Name: string; Expected, Got: string;
|
|
AContext: TWatchExpTestCurrentData; AIgnoreReason: String): Boolean;
|
|
begin
|
|
Result := FTest.TestEquals(Name, Expected, Got, AContext.WatchExp.TstMinDbg, AContext.WatchExp.TstMinFpc, AIgnoreReason);
|
|
end;
|
|
|
|
function TWatchExpectationList.TestEquals(Name: string; Expected, Got: string;
|
|
ACaseSense: Boolean; AContext: TWatchExpTestCurrentData; AIgnoreReason: String
|
|
): Boolean;
|
|
begin
|
|
Result := FTest.TestEquals(Name, Expected, Got, ACaseSense, AContext.WatchExp.TstMinDbg, AContext.WatchExp.TstMinFpc, AIgnoreReason);
|
|
end;
|
|
|
|
function TWatchExpectationList.TestEquals(Name: string; Expected, Got: integer;
|
|
AContext: TWatchExpTestCurrentData; AIgnoreReason: String): Boolean;
|
|
begin
|
|
Result := FTest.TestEquals(Name, Expected, Got, AContext.WatchExp.TstMinDbg, AContext.WatchExp.TstMinFpc, AIgnoreReason);
|
|
end;
|
|
|
|
function TWatchExpectationList.TestTrue(Name: string; Got: Boolean;
|
|
AContext: TWatchExpTestCurrentData; AIgnoreReason: String): Boolean;
|
|
begin
|
|
Result := FTest.TestTrue(Name, Got, AContext.WatchExp.TstMinDbg, AContext.WatchExp.TstMinFpc, AIgnoreReason);
|
|
end;
|
|
|
|
function TWatchExpectationList.TestFalse(Name: string; Got: Boolean;
|
|
AContext: TWatchExpTestCurrentData; AIgnoreReason: String): Boolean;
|
|
begin
|
|
Result := FTest.TestFalse(Name, Got, AContext.WatchExp.TstMinDbg, AContext.WatchExp.TstMinFpc, AIgnoreReason);
|
|
end;
|
|
|
|
function TWatchExpectationList.CheckResult(AnWatchExp: TWatchExpectation
|
|
): Boolean;
|
|
var
|
|
Thread, Stack: Integer;
|
|
CurBaseName, AnIgnoreRsn: String;
|
|
WatchVal: TWatchValue;
|
|
Context: TWatchExpTestCurrentData;
|
|
ehf: TWatchExpErrorHandlingFlags;
|
|
begin
|
|
Result := False;
|
|
CurBaseName := FTest.TestBaseName;
|
|
Context.WatchExp := AnWatchExp;
|
|
Context.Expectation := AnWatchExp.TstExpected;
|
|
Context.HasTypeInfo := False;
|
|
ehf := Context.Expectation.ExpErrorHandlingFlags[Compiler.SymbolType];
|
|
if ehTestSkip in ehf then
|
|
exit(True);
|
|
|
|
with AnWatchExp do begin
|
|
try
|
|
with LazDebugger.GetLocation do
|
|
FTest.TestBaseName := FTest.TestBaseName + ' ' + TstTestName + ' WATCH: '+TstWatch.Expression+' AT '+ SrcFile + ':' + IntToStr(SrcLine) +')';
|
|
if TstStackFrame > 0 then
|
|
FTest.TestBaseName := FTest.TestBaseName + ' (Stack: ' + IntToStr(TstStackFrame) + ')';
|
|
if not VerifyDebuggerState then
|
|
exit;
|
|
FTest.LogText('###### ' + TstTestName + ' // ' + TstWatch.Expression + '###### '+LineEnding);
|
|
|
|
AnIgnoreRsn := '';
|
|
if ehIgnAll in ehf then
|
|
AnIgnoreRsn := AnIgnoreRsn + 'All ignored';
|
|
if ehNotImplemented in ehf then
|
|
AnIgnoreRsn := AnIgnoreRsn + 'Not implemented';
|
|
|
|
Thread := LazDebugger.Threads.CurrentThreads.CurrentThreadId;
|
|
Stack := TstStackFrame;
|
|
WatchVal := TstWatch.Values[Thread, Stack];
|
|
Context.WatchVal := WatchVal;
|
|
|
|
if not VerifyDebuggerState then
|
|
exit;
|
|
|
|
if ehExpectError in ehf then begin
|
|
//TODO
|
|
Result := TestTrue('TstWatch.value is NOT valid', WatchVal.Validity in [ddsError, ddsInvalid], Context, AnIgnoreRsn);
|
|
exit;
|
|
end;
|
|
if ehExpectNotFound in ehf then begin
|
|
Result := TestMatches('TstWatch.value NOT found', 'not found', WatchVal.Value, Context, AnIgnoreRsn);
|
|
Result := TestTrue('TstWatch.value NOT found', WatchVal.Validity in [ddsError, ddsInvalid], Context, AnIgnoreRsn);
|
|
exit;
|
|
end;
|
|
if not TestTrue('TstWatch.value is valid', WatchVal.Validity = ddsValid, Context, AnIgnoreRsn) then
|
|
exit;
|
|
|
|
if (not (ehNoTypeInfo in ehf)) and
|
|
TestTrue('Has TypeInfo', Context.WatchVal.TypeInfo <> nil, Context, AnIgnoreRsn)
|
|
then
|
|
Context.HasTypeInfo := True;
|
|
|
|
if EvalCallTestFlags <> [] then begin
|
|
TestTrue('Got eval res', EvalCallResReceived, Context, AnIgnoreRsn);
|
|
TestTrue('Got eval success', EvalCallResSuccess, Context, AnIgnoreRsn);
|
|
TestTrue('Got eval type', EvalCallResDBGType <> nil, Context, AnIgnoreRsn);
|
|
end;
|
|
|
|
VerifySymType(Context, AnIgnoreRsn);
|
|
VerifyTypeName(Context, AnIgnoreRsn);
|
|
|
|
if ehIgnData in ehf then
|
|
AnIgnoreRsn := AnIgnoreRsn + 'Test ignored (Data)';
|
|
if ehNotImplementedData in ehf then
|
|
AnIgnoreRsn := AnIgnoreRsn + 'Not implemented (Data)';
|
|
|
|
Result := CheckData(Context, AnIgnoreRsn);
|
|
finally
|
|
FTest.TestBaseName := CurBaseName;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TWatchExpectationList.CheckData(AContext: TWatchExpTestCurrentData;
|
|
AnIgnoreRsn: String): Boolean;
|
|
begin
|
|
case AContext.Expectation.ExpResultKind of
|
|
rkMatch: Result := CheckResultMatch(AContext, AnIgnoreRsn);
|
|
rkInteger: Result := CheckResultNum(AContext, False, AnIgnoreRsn);
|
|
rkCardinal: Result := CheckResultNum(AContext, True, AnIgnoreRsn);
|
|
rkBool: Result := CheckResultBool(AContext, AnIgnoreRsn);
|
|
rkFloat: Result := CheckResultFloat(AContext, AnIgnoreRsn);
|
|
rkEnum: Result := CheckResultEnum(AContext, AnIgnoreRsn);
|
|
rkSet: Result := CheckResultSet(AContext, AnIgnoreRsn);
|
|
rkChar: Result := CheckResultChar(AContext, AnIgnoreRsn);
|
|
rkWideString,
|
|
rkAnsiString: Result := CheckResultAnsiStr(AContext, AnIgnoreRsn);
|
|
rkShortString: Result := CheckResultShortStr(AContext, AnIgnoreRsn);
|
|
rkPointer: Result := CheckResultPointer(AContext, AnIgnoreRsn);
|
|
rkPointerAddr: Result := CheckResultPointerAddr(AContext, AnIgnoreRsn);
|
|
rkClass: Result := CheckResultClass(AContext, AnIgnoreRsn);
|
|
rkObject: Result := CheckResultObject(AContext, AnIgnoreRsn);
|
|
rkRecord: Result := CheckResultRecord(AContext, AnIgnoreRsn);
|
|
rkInterface: Result := CheckResultInstance(AContext, AnIgnoreRsn);
|
|
rkStatArray: Result := CheckResultArray(AContext, AnIgnoreRsn);
|
|
rkDynArray: Result := CheckResultArray(AContext, AnIgnoreRsn);
|
|
end;
|
|
end;
|
|
|
|
function TWatchExpectationList.VerifyDebuggerState: Boolean;
|
|
begin
|
|
Result := FTest.TestTrue('Dbg State is paused: '+dbgs(LazDebugger.State), LazDebugger.State in [dsPause, dsInternalPause]);
|
|
end;
|
|
|
|
function TWatchExpectationList.VerifySymType(
|
|
AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean;
|
|
var
|
|
Expect: TWatchExpectationResult;
|
|
ehf: TWatchExpErrorHandlingFlags;
|
|
t: TDbgSymbolKind;
|
|
s1, s2, n: string;
|
|
begin
|
|
with AContext.WatchExp do begin
|
|
Result := True;
|
|
Expect := AContext.Expectation;
|
|
|
|
if (not AContext.HasTypeInfo) then
|
|
exit;
|
|
|
|
t := AContext.WatchVal.TypeInfo.Kind;
|
|
WriteStr(s1, t);
|
|
WriteStr(s2, Expect.ExpSymKind);
|
|
|
|
ehf := Expect.ExpErrorHandlingFlags[Compiler.SymbolType];
|
|
if ehIgnKind in ehf then
|
|
AnIgnoreRsn := AnIgnoreRsn + 'Test ignored'
|
|
else
|
|
if (ehIgnKindPtr in ehf) and (t = skPointer) then
|
|
AnIgnoreRsn := 'Ignored by flag (Kind may be Ptr)';
|
|
if ehNotImplementedKind in ehf then
|
|
AnIgnoreRsn := AnIgnoreRsn + 'Not implemented (symkind)';
|
|
|
|
n := '';
|
|
if (t = skSimple) and (Expect.ExpSymKind in AcceptSkSimple) then begin
|
|
n := ' (skSimple for '+s2+')';
|
|
s2 := 'skSimple';
|
|
end;
|
|
|
|
//if (t in [skRecord, skClass]) and (Expect.ExpSymKind = skObject) then begin
|
|
// n := ' (skObject for '+s1+')';
|
|
// s1 := 'skObject';
|
|
//end;
|
|
//if (t in [skClass]) and (Expect.ExpSymKind = skInterface) then begin
|
|
// n := ' (skInterface for '+s1+')';
|
|
// s1 := 'skInterface';
|
|
//end;
|
|
|
|
Result := TestEquals('SymbolType'+n, s2, s1, AContext, AnIgnoreRsn);
|
|
//if ((s2='skClass') and (s = 'skRecord')) or ((s='skClass') and (s2 = 'skRecord')) then begin
|
|
// TotalClassVsRecord := TotalClassVsRecord + 1;
|
|
end;
|
|
end;
|
|
|
|
function TWatchExpectationList.VerifyTypeName(
|
|
AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean;
|
|
var
|
|
ehf: TWatchExpErrorHandlingFlags;
|
|
Expect: TWatchExpectationResult;
|
|
WtchTpName, ExpTpName, s, n, n2: String;
|
|
i: SizeInt;
|
|
begin
|
|
with AContext.WatchExp do begin
|
|
Result := True;
|
|
Expect := AContext.Expectation;
|
|
|
|
if (Expect.ExpTypeName = '') or (Expect.ExpTypeName = #1) or (not AContext.HasTypeInfo) then
|
|
exit;
|
|
|
|
ehf := Expect.ExpErrorHandlingFlags[Compiler.SymbolType];
|
|
if ehIgnTypeName in ehf then
|
|
AnIgnoreRsn := AnIgnoreRsn + 'Test ignored';
|
|
if ehNotImplementedType in ehf then
|
|
AnIgnoreRsn := AnIgnoreRsn + 'Not implemented (typename)';
|
|
|
|
WtchTpName := AContext.WatchVal.TypeInfo.TypeName;
|
|
|
|
if ehMatchTypeName in ehf then
|
|
Result := TestMatches('TypeName', Expect.ExpTypeName, WtchTpName, AContext, AnIgnoreRsn)
|
|
else begin
|
|
n := '';
|
|
ExpTpName := Expect.ExpTypeName;
|
|
n2 := FTypeNameAliases.Values[UpperCase(ExpTpName)];
|
|
if n2 <> '' then begin
|
|
n := ' using alias "' + n2 + '" for "' + ExpTpName + '"';
|
|
ExpTpName := n2;
|
|
end;
|
|
|
|
i := pos('|', ExpTpName);
|
|
if i > 1 then begin
|
|
n := n + ' in "' + ExpTpName + '"';
|
|
while i > 1 do begin
|
|
s := copy(ExpTpName, 1, i-1);
|
|
delete(ExpTpName, i, i);
|
|
if UpperCase(s) = UpperCase(WtchTpName) then begin
|
|
Result := TestEquals('TypeName'+n, s, WtchTpName, EqIgnoreCase, AContext, AnIgnoreRsn);
|
|
exit;
|
|
end;
|
|
i := pos('|', ExpTpName);
|
|
end;
|
|
if (ExpTpName <> '') and (UpperCase(ExpTpName) = UpperCase(WtchTpName)) then begin
|
|
Result := TestEquals('TypeName'+n, ExpTpName, WtchTpName, EqIgnoreCase, AContext, AnIgnoreRsn);
|
|
exit;
|
|
end;
|
|
Result := TestTrue('TypeName "' + WtchTpName + '"' + n, True, AContext, AnIgnoreRsn);
|
|
end
|
|
|
|
else begin
|
|
Result := TestEquals('TypeName'+n, ExpTpName, WtchTpName, EqIgnoreCase, AContext, AnIgnoreRsn);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TWatchExpectationList.CheckResultMatch(
|
|
AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean;
|
|
var
|
|
Expect: TWatchExpectationResult;
|
|
begin
|
|
with AContext.WatchExp do begin
|
|
Result := True;
|
|
Expect := AContext.Expectation;
|
|
|
|
Result := TestMatches('Data', Expect.ExpTextData, AContext.WatchVal.Value, AContext, AnIgnoreRsn);
|
|
end;
|
|
end;
|
|
|
|
function TWatchExpectationList.CheckResultNum(
|
|
AContext: TWatchExpTestCurrentData; IsCardinal: Boolean; AnIgnoreRsn: String
|
|
): Boolean;
|
|
var
|
|
Expect: TWatchExpectationResult;
|
|
s: String;
|
|
begin
|
|
with AContext.WatchExp do begin
|
|
Result := True;
|
|
Expect := AContext.Expectation;
|
|
|
|
if IsCardinal then
|
|
s := IntToStr(Expect.expCardinalValue)
|
|
else
|
|
s := IntToStr(Expect.expIntValue);
|
|
|
|
Result := TestEquals('Data', s, AContext.WatchVal.Value, AContext, AnIgnoreRsn);
|
|
|
|
//if not TestEquals('DataSize', Expect.ExpIntSize, AContext.WatchVal.TypeInfo.Len, AContext, AnIgnoreRsn) then
|
|
// Result := False;
|
|
end;
|
|
end;
|
|
|
|
function TWatchExpectationList.CheckResultBool(
|
|
AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean;
|
|
var
|
|
Expect: TWatchExpectationResult;
|
|
s: String;
|
|
begin
|
|
with AContext.WatchExp do begin
|
|
Result := True;
|
|
Expect := AContext.Expectation;
|
|
|
|
WriteStr(s, Expect.ExpBoolValue);
|
|
Result := TestEquals('Data', s, AContext.WatchVal.Value, False, AContext, AnIgnoreRsn);
|
|
|
|
end;
|
|
end;
|
|
|
|
function TWatchExpectationList.CheckResultFloat(
|
|
AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean;
|
|
var
|
|
Expect: TWatchExpectationResult;
|
|
begin
|
|
with AContext.WatchExp do begin
|
|
Result := True;
|
|
Expect := AContext.Expectation;
|
|
|
|
Result := TestEquals('Data', FloatToStr(Expect.ExpFloatValue), AContext.WatchVal.Value, EqIgnoreCase, AContext, AnIgnoreRsn);
|
|
end;
|
|
end;
|
|
|
|
function TWatchExpectationList.CheckResultEnum(
|
|
AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean;
|
|
var
|
|
Expect: TWatchExpectationResult;
|
|
begin
|
|
with AContext.WatchExp do begin
|
|
Result := True;
|
|
Expect := AContext.Expectation;
|
|
|
|
Result := TestEquals('Data', Expect.ExpTextData, AContext.WatchVal.Value, not(Compiler.SymbolType in stDwarf2), AContext, AnIgnoreRsn);
|
|
end;
|
|
end;
|
|
|
|
function TWatchExpectationList.CheckResultSet(
|
|
AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean;
|
|
var
|
|
Expect: TWatchExpectationResult;
|
|
v: String;
|
|
parsed: TStringArray;
|
|
e, i: Integer;
|
|
begin
|
|
with AContext.WatchExp do begin
|
|
Result := True;
|
|
Expect := AContext.Expectation;
|
|
|
|
v := AContext.WatchVal.Value;
|
|
|
|
if (v='') or (v[1] <> '[') or (v[length(v)] <> ']') then begin
|
|
Result := TestTrue('elements are in [...]', False, AContext, AnIgnoreRsn);
|
|
exit;
|
|
end;
|
|
delete(v, 1, 1);
|
|
delete(v, length(v), 1);
|
|
|
|
parsed := ParseCommaList(v, e, Length(Expect.ExpSetData));
|
|
TestTrue('FieldParser len', e <= Length(parsed), AContext, AnIgnoreRsn);
|
|
|
|
Result := TestEquals('Length', Length(Expect.ExpSetData), e, AContext, AnIgnoreRsn);
|
|
|
|
e := min(e, Length(parsed));
|
|
for i := 0 to min(e, length(Expect.ExpSetData)) - 1 do
|
|
TestEquals('element'+IntToStr(i), Expect.ExpSetData[i], parsed[i], not(Compiler.SymbolType in stDwarf2), AContext, AnIgnoreRsn);
|
|
|
|
end;
|
|
end;
|
|
|
|
function TWatchExpectationList.CheckResultChar(
|
|
AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean;
|
|
var
|
|
Expect: TWatchExpectationResult;
|
|
ehf: TWatchExpErrorHandlingFlags;
|
|
e: String;
|
|
begin
|
|
with AContext.WatchExp do begin
|
|
Result := True;
|
|
Expect := AContext.Expectation;
|
|
|
|
e := QuoteText(Expect.ExpTextData);
|
|
|
|
ehf := Expect.ExpErrorHandlingFlags[Compiler.SymbolType];
|
|
if ehCharFromIndex in ehf then begin
|
|
if AContext.WatchVal.Value <> e then begin
|
|
//AnIgnoreRsn := AnIgnoreRsn + 'char from index not implemented';
|
|
Result := TestMatches('Data (pchar/string)', '([Pp][Cc]har|[Ss]tring):? *'+e,
|
|
AContext.WatchVal.Value, EqMatchCase, AContext, AnIgnoreRsn);
|
|
exit;
|
|
end
|
|
else
|
|
if AnIgnoreRsn = '' then
|
|
TestTrue('Expect from Index, yet got only one value', False, AContext, 'Success, better than expected');
|
|
end;
|
|
|
|
Result := TestEquals('Data', e, AContext.WatchVal.Value, AContext, AnIgnoreRsn);
|
|
end;
|
|
end;
|
|
|
|
function TWatchExpectationList.CheckResultAnsiStr(
|
|
AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean;
|
|
var
|
|
Expect: TWatchExpectationResult;
|
|
v, e, tn: String;
|
|
ehf: TWatchExpErrorHandlingFlags;
|
|
begin
|
|
with AContext.WatchExp do begin
|
|
Result := True;
|
|
Expect := AContext.Expectation;
|
|
|
|
v := AContext.WatchVal.Value;
|
|
ehf := Expect.ExpErrorHandlingFlags[Compiler.SymbolType];
|
|
|
|
// in dwarf 2 ansistring are pchar
|
|
// widestring are always pwidechar
|
|
if (Compiler.SymbolType in stDwarf2) or (AContext.Expectation.ExpResultKind = rkWideString) then begin
|
|
tn := QuoteRegExprMetaChars(Expect.ExpTypeName);
|
|
if ehIgnTypeNameInData in ehf then
|
|
tn := '.*';
|
|
if (tn <> '') then begin
|
|
if (Expect.ExpTextData = '') and
|
|
FTest.Matches('^'+tn+'\(nil\)', v)
|
|
then
|
|
v := ''''''
|
|
else
|
|
if FTest.Matches('^'+tn+'\(\$[0-9a-fA-F]+\) ', v) then
|
|
delete(v, 1, pos(') ', v)+1)
|
|
else
|
|
if FTest.Matches('^\$[0-9a-fA-F]+ ', v) then
|
|
delete(v, 1, pos(' ', v));
|
|
end
|
|
else begin
|
|
if (Expect.ExpTextData = '') and (v = 'nil')
|
|
then
|
|
v := ''''''
|
|
else
|
|
if FTest.Matches('^\$[0-9a-fA-F]+ ', v) then
|
|
delete(v, 1, pos(' ', v));
|
|
end;
|
|
end;
|
|
|
|
e := QuoteText(Expect.ExpTextData);
|
|
Result := TestEquals('Data', e, v, AContext, AnIgnoreRsn);
|
|
end;
|
|
end;
|
|
|
|
function TWatchExpectationList.CheckResultShortStr(
|
|
AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean;
|
|
var
|
|
Expect: TWatchExpectationResult;
|
|
e: String;
|
|
begin
|
|
with AContext.WatchExp do begin
|
|
Result := True;
|
|
Expect := AContext.Expectation;
|
|
e := QuoteText(Expect.ExpTextData);
|
|
|
|
Result := TestEquals('Data', e, AContext.WatchVal.Value, AContext, AnIgnoreRsn);
|
|
end;
|
|
end;
|
|
|
|
function TWatchExpectationList.CheckResultPointer(
|
|
AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean;
|
|
var
|
|
Expect: TWatchExpectationResult;
|
|
g, e, n, tn: String;
|
|
i: SizeInt;
|
|
SubContext: TWatchExpTestCurrentData;
|
|
ehf: TWatchExpErrorHandlingFlags;
|
|
begin
|
|
with AContext.WatchExp do begin
|
|
Result := True;
|
|
Expect := AContext.Expectation;
|
|
ehf := Expect.ExpErrorHandlingFlags[Compiler.SymbolType];
|
|
tn := QuoteRegExprMetaChars(Expect.ExpTypeName);
|
|
if ehIgnTypeNameInData in ehf then
|
|
tn := '.*';
|
|
|
|
e := '(\$[0-9a-fA-F]*|nil)';
|
|
if tn <> '' then
|
|
e := tn+'\('+e+'\)';
|
|
e := '^'+e;
|
|
|
|
Result := TestMatches('Data', e, AContext.WatchVal.Value, AContext, AnIgnoreRsn);
|
|
|
|
if ehIgnPointerDerefData in ehf then
|
|
exit;
|
|
|
|
g := AContext.WatchVal.Value;
|
|
i := pos(' ', g);
|
|
if i > 1 then
|
|
delete(g, 1, i)
|
|
else
|
|
if not (Expect.ExpSubResults[0].ExpResultKind in [rkChar, rkAnsiString, rkWideString, rkShortString]) then begin
|
|
TestTrue('nil pointer, but expecting data / internal test correctness', False, AContext, AnIgnoreRsn);
|
|
exit;
|
|
end
|
|
else
|
|
if pos('nil', g) > 0 then
|
|
g := '''''' // only pchar, ... / simulate empty string for nil pointer
|
|
else begin
|
|
TestTrue('pointer has data', False, AContext, AnIgnoreRsn);
|
|
exit;
|
|
end;
|
|
|
|
if Length(Expect.ExpSubResults) = 0 then begin
|
|
TestTrue('pointer has expectation / internal test correctness', False, AContext, AnIgnoreRsn);
|
|
exit;
|
|
end;
|
|
|
|
|
|
n := FTest.TestBaseName;
|
|
SubContext := AContext;
|
|
SubContext.WatchVal.Value := g;
|
|
FTest.TestBaseName := n + ' / deref value';
|
|
|
|
//SubContext.WatchExp.TstExpected := Expect.ExpSubResults[0];
|
|
SubContext.Expectation := Expect.ExpSubResults[0];
|
|
Result := CheckData(SubContext, AnIgnoreRsn);
|
|
|
|
FTest.TestBaseName := n;
|
|
//AContext.WatchVal.Value := v;
|
|
|
|
end;
|
|
end;
|
|
|
|
function TWatchExpectationList.CheckResultPointerAddr(
|
|
AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean;
|
|
var
|
|
Expect: TWatchExpectationResult;
|
|
e, tn: String;
|
|
ehf: TWatchExpErrorHandlingFlags;
|
|
begin
|
|
with AContext.WatchExp do begin
|
|
Result := True;
|
|
Expect := AContext.Expectation;
|
|
ehf := Expect.ExpErrorHandlingFlags[Compiler.SymbolType];
|
|
tn := QuoteRegExprMetaChars(Expect.ExpTypeName);
|
|
if ehIgnTypeNameInData in ehf then
|
|
tn := '.*';
|
|
|
|
if Expect.ExpPointerValue = nil then
|
|
e := 'nil'
|
|
else
|
|
e := '\$0*'+IntToHex(PtrUInt(Expect.ExpPointerValue), 8);
|
|
if tn <> '' then
|
|
e := tn+'\('+e+'\)';
|
|
e := '^'+e;
|
|
|
|
Result := TestMatches('Data', e, AContext.WatchVal.Value, AContext, AnIgnoreRsn);
|
|
end;
|
|
end;
|
|
|
|
function TWatchExpectationList.CheckResultArray(
|
|
AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean;
|
|
var
|
|
Expect: TWatchExpectationResult;
|
|
SubContext: TWatchExpTestCurrentData;
|
|
v, n: String;
|
|
parsed: array of String;
|
|
i, e: Integer;
|
|
begin
|
|
with AContext.WatchExp do begin
|
|
Result := True;
|
|
Expect := AContext.Expectation;
|
|
|
|
v := AContext.WatchVal.Value;
|
|
debugln([' expect ',Expect.ExpFullArrayLen,' got "',v,'"' ]);
|
|
|
|
if (LowerCase(v) = 'nil') then begin
|
|
Result := TestEquals('Length/nil', Expect.ExpFullArrayLen, 0, AContext, AnIgnoreRsn);
|
|
exit;
|
|
end;
|
|
|
|
if (v='') or (v[1] <> '(') or (v[length(v)] <> ')') then begin
|
|
Result := TestTrue('elements are in (...)', False, AContext, AnIgnoreRsn);
|
|
exit;
|
|
end;
|
|
delete(v, 1, 1);
|
|
delete(v, length(v), 1);
|
|
|
|
parsed := ParseCommaList(v, e, Expect.ExpFullArrayLen);
|
|
TestTrue('FieldParser len', e <= Length(parsed), AContext, AnIgnoreRsn);
|
|
|
|
if Expect.ExpFullArrayLen >= 0 then
|
|
Result := TestEquals('Length', Expect.ExpFullArrayLen, e, AContext, AnIgnoreRsn);
|
|
|
|
e := min(e, Length(parsed));
|
|
n := FTest.TestBaseName;
|
|
SubContext := AContext;
|
|
for i := 0 to min(e, length(Expect.ExpSubResults)) - 1 do begin
|
|
SubContext.WatchVal.Value := parsed[i];
|
|
FTest.TestBaseName := n + ' Idx='+IntToStr(i);
|
|
|
|
//SubContext.WatchExp.TstExpected := Expect.ExpSubResults[i];
|
|
SubContext.Expectation := Expect.ExpSubResults[i];
|
|
Result := CheckData(SubContext, AnIgnoreRsn);
|
|
end;
|
|
|
|
FTest.TestBaseName := n;
|
|
AContext.WatchVal.Value := v;
|
|
end;
|
|
|
|
end;
|
|
|
|
function TWatchExpectationList.CheckStructureFields(const AnIgnoreRsn: String;
|
|
var AContext: TWatchExpTestCurrentData): Boolean;
|
|
var
|
|
Expect: TWatchExpectationResult;
|
|
ehf: TWatchExpErrorHandlingFlags;
|
|
i, j, e, a: Integer;
|
|
parsed: TStringArray;
|
|
SubContext: TWatchExpTestCurrentData;
|
|
sr: TWatchExpectationResult;
|
|
n, v: String;
|
|
begin
|
|
Result := True;
|
|
with AContext.WatchExp do begin
|
|
Expect := AContext.Expectation;
|
|
ehf := Expect.ExpErrorHandlingFlags[Compiler.SymbolType];
|
|
|
|
v := Trim(AContext.WatchVal.Value);
|
|
delete(v, 1, pos('(', v));
|
|
delete(v, length(v), 1);
|
|
|
|
parsed := ParseCommaList(v, e, -1, ';');
|
|
TestTrue('FieldParser len', e <= Length(parsed), AContext, AnIgnoreRsn);
|
|
e := min(e, Length(parsed));
|
|
|
|
|
|
n := FTest.TestBaseName;
|
|
SubContext := AContext;
|
|
for i := 0 to length(Expect.ExpSubResults) - 1 do begin
|
|
sr := Expect.ExpSubResults[i];
|
|
if not TestTrue('field name ' + IntToStr(i), sr.ExpFieldName<>'', AContext, AnIgnoreRsn) then
|
|
Continue;
|
|
|
|
if AContext.WatchVal.TypeInfo <> nil then begin
|
|
a := AContext.WatchVal.TypeInfo.Fields.Count -1;
|
|
while (a >= 0) and (LowerCase(AContext.WatchVal.TypeInfo.Fields[a].Name) <> LowerCase(sr.ExpFieldName)) do
|
|
dec(a);
|
|
TestTrue('typeinfo has field '+sr.ExpFieldName, a >= 0, AContext, AnIgnoreRsn);
|
|
end;
|
|
|
|
if EvalCallResDBGType <> nil then begin
|
|
a := EvalCallResDBGType.Fields.Count -1;
|
|
while (a >= 0) and (LowerCase(EvalCallResDBGType.Fields[a].Name) <> LowerCase(sr.ExpFieldName)) do
|
|
dec(a);
|
|
TestTrue('EvalCallResDBGType has field '+sr.ExpFieldName, a >= 0, AContext, AnIgnoreRsn);
|
|
end;
|
|
|
|
j := parsed.IndexOfFieldName(sr.ExpFieldName, e);
|
|
if not TestTrue('field exists ' + IntToStr(i), j >= 0, AContext, AnIgnoreRsn) then
|
|
Continue;
|
|
if not(ehNoFieldOrder in ehf) then begin
|
|
if ehMissingFields in ehf then begin
|
|
dec(e, j);
|
|
parsed.delete(0, j);
|
|
j := 0;
|
|
end;
|
|
|
|
if not TestTrue('field in order ' + IntToStr(i) + ' ' + IntToStr(j), j = 0, AContext, AnIgnoreRsn) then
|
|
Continue;
|
|
end;
|
|
|
|
SubContext.WatchVal.Value := parsed.ValueOfFieldName(j);
|
|
FTest.TestBaseName := n + ' Idx=' + IntToStr(i);
|
|
|
|
dec(e);
|
|
parsed.delete(j, 1);
|
|
|
|
//SubContext.WatchExp.TstExpected := sr;
|
|
SubContext.Expectation := sr;
|
|
Result := CheckData(SubContext, AnIgnoreRsn);
|
|
end;
|
|
FTest.TestBaseName := n;
|
|
AContext.WatchVal.Value := v;
|
|
end;
|
|
end;
|
|
|
|
function TWatchExpectationList.CheckResultRecord(
|
|
AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean;
|
|
var
|
|
Expect: TWatchExpectationResult;
|
|
v, tn: String;
|
|
ehf: TWatchExpErrorHandlingFlags;
|
|
begin
|
|
with AContext.WatchExp do begin
|
|
Result := True;
|
|
Expect := AContext.Expectation;
|
|
ehf := Expect.ExpErrorHandlingFlags[Compiler.SymbolType];
|
|
|
|
v := Trim(AContext.WatchVal.Value);
|
|
debugln([' expect ',Expect.ExpFullArrayLen,' got "',v,'"' ]);
|
|
//if (LowerCase(v) = 'nil') then
|
|
|
|
//if not TestMatches('Is record', '^record .* end$', v, False, AContext, AnIgnoreRsn) then
|
|
// exit;
|
|
//delete(v, 1, 7);
|
|
//delete(v, length(v)-2, 3);
|
|
|
|
tn := QuoteRegExprMetaChars(Expect.ExpTypeName);
|
|
if ehIgnTypeNameInData in ehf then
|
|
tn := '[a-z0-9_]*';
|
|
if not TestMatches('Is record', '^'+tn+' *\(.*\)$', v, False, AContext, AnIgnoreRsn) then
|
|
exit;
|
|
|
|
Result := CheckStructureFields(AnIgnoreRsn, AContext);
|
|
end;
|
|
end;
|
|
|
|
function TWatchExpectationList.CheckResultClass(
|
|
AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean;
|
|
var
|
|
v, tn: String;
|
|
ehf: TWatchExpErrorHandlingFlags;
|
|
Expect: TWatchExpectationResult;
|
|
begin
|
|
with AContext.WatchExp do begin
|
|
Result := True;
|
|
Expect := AContext.Expectation;
|
|
ehf := Expect.ExpErrorHandlingFlags[Compiler.SymbolType];
|
|
|
|
v := Trim(AContext.WatchVal.Value);
|
|
//if (LowerCase(v) = 'nil') then
|
|
|
|
tn := QuoteRegExprMetaChars(Expect.ExpTypeName);
|
|
if ehIgnTypeNameInData in ehf then
|
|
tn := '[a-z0-9_]*';
|
|
if not TestMatches('Is class ', '^'+tn+' *\(.*\)$', v, False, AContext, AnIgnoreRsn) then
|
|
exit;
|
|
|
|
Result := CheckStructureFields(AnIgnoreRsn, AContext);
|
|
end;
|
|
end;
|
|
|
|
function TWatchExpectationList.CheckResultObject(
|
|
AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean;
|
|
begin
|
|
Result := CheckResultRecord(AContext, AnIgnoreRsn);
|
|
end;
|
|
|
|
function TWatchExpectationList.CheckResultInstance(
|
|
AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean;
|
|
begin
|
|
Result := CheckResultClass(AContext, AnIgnoreRsn);
|
|
end;
|
|
|
|
constructor TWatchExpectationList.Create(ATest: TDBGTestCase);
|
|
begin
|
|
FTest := ATest;
|
|
FTypeNameAliases := TStringList.Create;
|
|
inherited Create;
|
|
end;
|
|
|
|
destructor TWatchExpectationList.Destroy;
|
|
begin
|
|
Clear;
|
|
FTypeNameAliases.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TWatchExpectationList.AddWithoutExpect(ATestName: String;
|
|
AnExpr: string; AStackFrame: Integer; AMinFpc: Integer; AMinDbg: Integer
|
|
): PWatchExpectation;
|
|
var
|
|
i: Integer;
|
|
w: TTestWatch;
|
|
begin
|
|
i := Length(FList);
|
|
SetLength(FList, i+1);
|
|
|
|
w := TTestWatch.Create(Debugger.Watches.Watches);
|
|
w.Expression := AnExpr;
|
|
w.Enabled := True;
|
|
|
|
FList[i].TstTestName := ATestName;
|
|
FList[i].TstWatch := w;
|
|
FList[i].TstStackFrame := AStackFrame;
|
|
FList[i].TstMinFpc := AMinFpc;
|
|
FList[i].TstMinDbg := AMinDbg;
|
|
|
|
Result := @FList[i];
|
|
end;
|
|
|
|
function TWatchExpectationList.Add(ATestName: String; AnExpr: string;
|
|
AnExpect: TWatchExpectationResult; AStackFrame: Integer; AMinFpc: Integer;
|
|
AMinDbg: Integer): PWatchExpectation;
|
|
var
|
|
i: Integer;
|
|
w: TTestWatch;
|
|
begin
|
|
i := Length(FList);
|
|
SetLength(FList, i+1);
|
|
|
|
w := TTestWatch.Create(Debugger.Watches.Watches);
|
|
w.Expression := AnExpr;
|
|
w.Enabled := True;
|
|
|
|
FList[i].TstTestName := ATestName;
|
|
FList[i].TstWatch := w;
|
|
FList[i].TstExpected := AnExpect;
|
|
FList[i].TstStackFrame := AStackFrame;
|
|
FList[i].TstMinFpc := AMinFpc;
|
|
FList[i].TstMinDbg := AMinDbg;
|
|
|
|
Result := @FList[i];
|
|
end;
|
|
|
|
function TWatchExpectationList.Add(AnExpr: string;
|
|
AnExpect: TWatchExpectationResult; AStackFrame: Integer; AMinFpc: Integer;
|
|
AMinDbg: Integer): PWatchExpectation;
|
|
begin
|
|
Result := Add('', AnExpr, AnExpect, AStackFrame, AMinFpc, AMinDbg);
|
|
end;
|
|
|
|
procedure TWatchExpectationList.AddIndexFromPrevious(
|
|
IndexNames: array of string; ValueIndex: array of integer;
|
|
AnPreviousOffset: Integer);
|
|
var
|
|
prev: TWatchExpectation;
|
|
i: Integer;
|
|
t: PWatchExpectation;
|
|
st: TSymbolType;
|
|
begin
|
|
prev := FList[Count-1-AnPreviousOffset];
|
|
for i := 0 to high(IndexNames) do begin
|
|
t := Add(Prev.TstTestName + ' ['+IndexNames[i]+']',
|
|
prev.TstWatch.Expression+ '['+IndexNames[i]+']',
|
|
prev.TstExpected.ExpSubResults[ValueIndex[i]],
|
|
prev.TstStackFrame, prev.TstMinFpc, prev.TstMinDbg
|
|
);
|
|
t^.TstExpected.MakeCopy;
|
|
// copy flags from expectation for whole array
|
|
for st := low(TSymbolTypes) to high(TSymbolTypes) do
|
|
t^.AddFlag(prev.TstExpected.ExpErrorHandlingFlags[st], [st]);
|
|
end;
|
|
end;
|
|
|
|
procedure TWatchExpectationList.AddTypeNameAlias(ATypeName, AnAliases: String);
|
|
begin
|
|
ATypeName := UpperCase(ATypeName);
|
|
if FTypeNameAliases.Values[ATypeName] <> '' then
|
|
AnAliases := FTypeNameAliases.Values[ATypeName] + '|' + FTypeNameAliases.Values[ATypeName];
|
|
FTypeNameAliases.Values[ATypeName] := AnAliases;
|
|
end;
|
|
|
|
procedure TWatchExpectationList.Clear;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to Length(FList)-1 do begin
|
|
FList[i].TstWatch.Free;
|
|
FList[i].EvalCallResDBGType.Free;
|
|
end;
|
|
FList := nil;
|
|
end;
|
|
|
|
function TWatchExpectationList.Count: Integer;
|
|
begin
|
|
Result := Length(FList);
|
|
end;
|
|
|
|
procedure TWatchExpectationList.EvaluateWatches;
|
|
var
|
|
i, t: Integer;
|
|
begin
|
|
t := LazDebugger.Threads.CurrentThreads.CurrentThreadId;
|
|
for i := 0 to Length(FList)-1 do begin
|
|
EvaluateWatch(@FList[i], t);
|
|
if (i mod 16) = 0 then TestLogger.DbgOut('.');
|
|
end;
|
|
TestLogger.DebugLn('');
|
|
end;
|
|
|
|
procedure TWatchExpectationList.CheckResults;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to Length(FList)-1 do
|
|
CheckResult(FList[i]);
|
|
end;
|
|
|
|
end.
|
|
|