mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-19 22:29:37 +01:00
FpDebug: tests
git-svn-id: trunk@61901 -
This commit is contained in:
martin
parent
e2590a7c19
commit
0ea8345dd4
@ -1518,6 +1518,7 @@ procedure TTestWatches.TestWatchesTypeCast;
|
||||
var
|
||||
p, e, val: String;
|
||||
Thread, n, StartIdx, i: Integer;
|
||||
we: PWatchExpectation;
|
||||
begin
|
||||
p := APrefix;
|
||||
n := AOffs;
|
||||
@ -1606,6 +1607,46 @@ for i := StartIdx to t.Count-1 do
|
||||
t.Tests[i].SkipIf(ALoc = tlConst);
|
||||
|
||||
|
||||
if p='gv' then begin
|
||||
|
||||
we:= t.Add(AName, '^TRecordClass1(gv_aptr_Class1Rec[0])^.Foo', weClass([weInteger(22+n).N('FInt'), weAnsiStr(AChr1+'T').N('FAnsi')], 'TClass1') )
|
||||
.AddFlag(ehMissingFields);
|
||||
we^.EvalCallTestFlags := [defFullTypeInfo];
|
||||
we:= t.Add(AName, '^TRecordClass1(gv_aptr_Class1Rec[1])^.Foo', weClass([weInteger(22+n+2).N('FInt'), weAnsiStr('D'+'T').N('FAnsi')], 'TClass1') )
|
||||
.AddFlag(ehMissingFields);
|
||||
we^.EvalCallTestFlags := [defFullTypeInfo];
|
||||
|
||||
|
||||
|
||||
|
||||
we:= t.Add(AName, '^TRecordFive(gv_ptr_FiveRec)^.a', weInteger(-22-n));
|
||||
we^.EvalCallTestFlags := [defFullTypeInfo];
|
||||
|
||||
t.Add(AName, '^TRecordFive(gv_aptr_FiveRec[0])^.a', weInteger(-22-n));
|
||||
t.Add(AName, '^TRecordFive(gv_aptr_FiveRec[1])^.a', weInteger(-22-(n+2)));
|
||||
|
||||
t.Add(AName, 'PTxFiveRec(gv_aptr_FiveRec[0])^.a', weInteger(-22-n));
|
||||
t.Add(AName, 'PTxFiveRec(gv_aptr_FiveRec[1])^.a', weInteger(-22-(n+2)));
|
||||
|
||||
we:= t.Add(AName, '^TRecordFive(gv_ptrlist_FiveRec^[0])^.a', weInteger(-22-n));
|
||||
we^.TstWatch.EvaluateFlags := [defFullTypeInfo];
|
||||
we^.EvalCallTestFlags := [defFullTypeInfo];
|
||||
we:= t.Add(AName, '^TRecordFive(gv_ptrlist_FiveRec^[1])^.a', weInteger(-22-(n+2)));
|
||||
we^.TstWatch.EvaluateFlags := [defFullTypeInfo];
|
||||
we^.EvalCallTestFlags := [defFullTypeInfo];
|
||||
|
||||
we:= t.Add(AName, 'PTxFiveRec(gv_ptrlist_FiveRec^[0])^.a', weInteger(-22-n));
|
||||
we^.TstWatch.EvaluateFlags := [defFullTypeInfo];
|
||||
we^.EvalCallTestFlags := [defFullTypeInfo];
|
||||
we:= t.Add(AName, 'PTxFiveRec(gv_ptrlist_FiveRec^[1])^.a', weInteger(-22-(n+2)));
|
||||
we^.TstWatch.EvaluateFlags := [defFullTypeInfo];
|
||||
we^.EvalCallTestFlags := [defFullTypeInfo];
|
||||
|
||||
t.Add(AName, 'PTxFiveRec('+val+')^.a', weInteger(-22-n));
|
||||
t.Add(AName, '^TRecordFive('+val+')^.a', weInteger(-22-n));
|
||||
end;
|
||||
|
||||
|
||||
t.Add(AName+' Cardinal', 'Cardinal('+p+'Rec3S'+e+')', weMatch('.', skSimple)).ExpectError();
|
||||
t.Add(AName+' QWord', 'QWord('+p+'Rec3S'+e+')', weMatch('.', skSimple)).ExpectError();
|
||||
|
||||
@ -1648,6 +1689,11 @@ begin
|
||||
(* ************ Nested Functions ************* *)
|
||||
|
||||
RunToPause(BrkPrg);
|
||||
//t.Clear;
|
||||
//t.Add('', '^TRecordClass1(gv_aptr_Class1Rec[0])^.Foo', weClass([weInteger(22+1).N('FInt'), weAnsiStr('T').N('FAnsi')], 'TClass1') ).AddFlag(ehMissingFields)
|
||||
//^.EvalCallTestFlags := [defFullTypeInfo];
|
||||
//t.EvaluateWatches;
|
||||
//t.CheckResults;
|
||||
|
||||
t.Clear;
|
||||
AddWatchesConv(t, 'glob const', 'gc', 000, 'A', tlConst);
|
||||
|
||||
@ -16,6 +16,9 @@ begin result := SomeValue = 0; end;
|
||||
procedure SomeProc1();
|
||||
begin SomeFunc1(2,2,2,2); end;
|
||||
|
||||
const
|
||||
MaxListSize = high(longword) div 16;
|
||||
|
||||
type
|
||||
{$ifdef CPU64}
|
||||
PtrUInt = type QWord;
|
||||
@ -25,12 +28,17 @@ type
|
||||
PtrUInt = type DWord;
|
||||
{$endif CPU32}
|
||||
|
||||
PPointerList = ^TPointerList;
|
||||
TPointerList = array[0..MaxListSize - 1] of Pointer;
|
||||
|
||||
var
|
||||
BreakDummy: PtrUInt;
|
||||
p: Pointer;
|
||||
InterfacedObject, InterfacedObject2: TInterfacedObject;
|
||||
|
||||
type
|
||||
TClass1 = class;
|
||||
|
||||
TIntRange = -300..300;
|
||||
TCardinalRange = 1..300;
|
||||
|
||||
@ -106,6 +114,8 @@ type
|
||||
TRecFivePackStatArray = array [2..4] of TRecordFivePack;
|
||||
TRecFivePackStatPackArray = packed array [2..4] of TRecordFivePack;
|
||||
|
||||
TRecordClass1 = record Foo: TClass1; end;
|
||||
|
||||
TClass1 = class
|
||||
public
|
||||
FInt: integer;
|
||||
@ -131,22 +141,28 @@ type
|
||||
|
||||
type
|
||||
(* LOCATION: TYPE *)
|
||||
// type TxByte: type Byte;
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=Tx, "_OP_== type ", (=;//, "_O2_= = type", _EQ_=, _BLOCK_=TestVar, _BLOCK2_=TestType )
|
||||
// type PTxByte: ^TxByte;
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc,pre__=PTx, _OP_={, _O2_={, _pre3_=^Tx, "//@@=} = ", _BLOCK_=TestVar, _BLOCK2_=TestType ) //}
|
||||
|
||||
// type PxByte: ^Byte;
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc,pre__=Px, "_OP_==^", "_O2_==^", "(=;//", _EQ_=, _BLOCK_=TestVar, _BLOCK2_=TestPointer ) //}
|
||||
|
||||
|
||||
(* LOCATION: field in baseclass *)
|
||||
TMyBaseClass = class
|
||||
public
|
||||
function SomeMeth1(SomeValue: Integer): Boolean;
|
||||
public
|
||||
// mbcByte: Byte;
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=mbc, _OP_=:, (=;//, _O2_=:, _EQ_=, _BLOCK_=TestVar )
|
||||
end;
|
||||
|
||||
(* LOCATION: field in class *)
|
||||
TMyClass = class(TMyBaseClass)
|
||||
public
|
||||
// mcByte: Byte;
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=mc, _OP_=:, (=;//, _O2_=:, _EQ_=, _BLOCK_=TestVar )
|
||||
end;
|
||||
|
||||
@ -154,29 +170,51 @@ var
|
||||
MyClass1: TMyClass;
|
||||
MyClass2: TMyBaseClass; (* LOCATION: field, requires typecast of containing class *)
|
||||
|
||||
|
||||
const
|
||||
(* LOCATION: global const *)
|
||||
// gcByte = Byte( 1 + add );
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=gc, ADD=0, CHR1='A', _OP_==, _O2_=:, _EQ_==,"(nil)=nil", _BLOCK_=TestConst)
|
||||
|
||||
var
|
||||
(* LOCATION: global var *)
|
||||
// gvByte: Byte = (1 + add);
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=gv, _OP_=:, (=;//, _O2_=:, _EQ_=, _BLOCK_=TestVar )
|
||||
// gv2_Byte: Byte = (1 + add);
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=gv2_, _OP_=:, (=;//, _O2_=:, _EQ_=, _BLOCK_=TestVar )
|
||||
|
||||
(* LOCATION: global var ARRAY OF <each type> *)
|
||||
// gvaByte: array of Byte;
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=gva, "_OP_=: array of", (=;//, "_O2_=: array of", _EQ_=, _BLOCK_=TestVar )
|
||||
|
||||
(* LOCATION: global var pointer <each type> *)
|
||||
// gvp_Byte: ^Byte;
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=gvp_, "_OP_=: ^", (=;//, "_O2_=: ^", _EQ_=, _BLOCK_=TestVar, _BLOCK2_=TestPointer )
|
||||
|
||||
(* LOCATION: global var TYPE alias // NO PRE-ASSIGNED VALUE *)
|
||||
// gvp_Byte: PxByte;
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=gvpt_, "_OP_={", "_O2_={", "//@@=} :", _pre3_=Px, _BLOCK_=TestVar, _BLOCK2_=TestPointer ) // }
|
||||
|
||||
(* LOCATION: global var NAMED pointer <each type> // NO PRE-ASSIGNED VALUE *)
|
||||
// gvtt_Byte: TxByte;
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=gvtt_, "_OP_={", "_O2_={", "//@@=} :", _pre3_=Tx, _BLOCK_=TestVar, _BLOCK2_=TestType ) // }
|
||||
|
||||
(* LOCATION: global var NAMED pointer <each TYPE ALIAS> // NO PRE-ASSIGNED VALUE *)
|
||||
// gvptt_Byte: PTxByte;
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=gvptt_, "_OP_={", "_O2_={", "//@@=} :", _pre3_=PTx, _BLOCK_=TestVar, _BLOCK2_=TestType ) // }
|
||||
|
||||
|
||||
(* LOCATION: global var untyped pointer // NO PRE-ASSIGNED VALUE *)
|
||||
// gv_ptr_Byte: pointer;
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=gv_ptr_, "_OP_=:pointer;//", "_O2_=:pointer;//" )
|
||||
// gv_aptr_Byte: array [0..2] of pointer;
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=gv_aptr_, "_OP_=:array [0..2] of pointer;//", "_O2_=:array [0..2] of pointer;//" )
|
||||
|
||||
(* LOCATION: global var untyped PPointerList // NO PRE-ASSIGNED VALUE *)
|
||||
// gv_ptrlist_Byte: pointer;
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=gv_ptrlist_, "_OP_=:PPointerList;//", "_O2_=:PPointerList;//" )
|
||||
|
||||
|
||||
constructor TObjectCreate3Int64.Create;
|
||||
begin end;
|
||||
destructor TObjectCreate3Int64.Destroy;
|
||||
@ -266,17 +304,32 @@ begin
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc,pre__=gv, {e}={, "//@@=} :=", _pre3_=gc, _BLOCK_=TestAssignGC)
|
||||
|
||||
(* INIT: global var *)
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc,pre__=gv, ADD=1, CHR1='B', _OP_=:=, _O2_={, _EQ_=}:=, _pre2_=gc, _BLOCK_=TestAssign)
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc,pre__=gv, ADD=1, CHR1='B', _OP_=:=, _O2_={, _EQ_=}:=, _pre2_=gc, _BLOCK_=TestAssign)
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc,pre__=gv2_, ADD=3, CHR1='D', _OP_=:=, _O2_={, _EQ_=}:=, _pre2_=gc, _BLOCK_=TestAssign)
|
||||
|
||||
(* INIT: global var TYPE alias // NO PRE-ASSIGNED VALUE *)
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=gvpt_, "_OP_= {", "_O2_={ ", "//@@=} :=", _pre3_=@gv, _BLOCK_=TestVar, _BLOCK2_=TestPointer ) // }
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc,pre__=gvtt_, ADD=7, CHR1='N', _OP_=:=, _O2_={, _EQ_=}:=, _pre2_=gc, _BLOCK_=TestAssign, _BLOCK2_=TestType)
|
||||
|
||||
(* INIT: global var NAMED pointer <each type> // NO PRE-ASSIGNED VALUE *)
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc,pre__=gvtt_, ADD=7, CHR1='N', _OP_=:=, _O2_={, _EQ_=}:=, _pre2_=gc, _BLOCK_=TestAssign, _BLOCK2_=TestType)
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=gvpt_, "_OP_= {", "_O2_={ ", "//@@=} :=", _pre3_=@gv, _BLOCK_=TestVar, _BLOCK2_=TestPointer ) // }
|
||||
|
||||
(* INIT: global var NAMED pointer <each TYPE ALIAS> // NO PRE-ASSIGNED VALUE *)
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=gvptt_, "_OP_= {", "_O2_={ ", "//@@=} :=", _pre3_=@gvtt_, _BLOCK_=TestVar, _BLOCK2_=TestType ) // }
|
||||
|
||||
|
||||
(* INIT: global var untyped NAMED pointer // NO PRE-ASSIGNED VALUE *)
|
||||
// gv_ptr_Byte := @gvByte; // ADD=1, CHR1='B'
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=gv_ptr_, "_OP_= {", "_O2_={ ", "//@@=} :=", _pre3_=@gv ) // }
|
||||
// gv_aptr_Byte[0] := @gvByte; // ADD=1, CHR1='B'
|
||||
// gv_aptr_Byte[1] := @gv2_Byte; // ADD=3, CHR1='D'
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=gv_aptr_, "{e}=[0]", "_OP_= {", "_O2_={ ", "//@@=} :=", _pre3_=@gv ) // }
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=gv_aptr_, "{e}=[1]", "_OP_= {", "_O2_={ ", "//@@=} :=", _pre3_=@gv2_ ) // }
|
||||
|
||||
(* INIT: global var untyped PPointerList // NO PRE-ASSIGNED VALUE *)
|
||||
// gv_ptrlist_Byte := @gv_aptr_Byte;
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=gv_ptrlist_, "_OP_= {", "_O2_={ ", "//@@=} :=", _pre3_=@gv_aptr_ ) // }
|
||||
|
||||
|
||||
(* INIT: field in class / baseclass *)
|
||||
MyClass1 := TMyClass.Create;
|
||||
MyClass1.SomeMeth1(1);
|
||||
|
||||
@ -383,7 +383,6 @@
|
||||
|
||||
pre__Obj3{e} _O2_ TObject3Int64 _EQ_ (a:-22;b:44;c:4000+ADD); //@@ _pre3_Obj3;
|
||||
pre__Obj3Ex{e} _O2_ TObject3Int64Ex _EQ_ (a:-22;b:44;c:4100+ADD; d: 555); //@@ _pre3_Obj3Ex;
|
||||
|
||||
{$IFnDEF TestConst}
|
||||
{$IFnDEF TestAssignGC}
|
||||
{$IFnDEF TestType} // will work in fpc 3.2.0 upwards
|
||||
@ -443,6 +442,14 @@
|
||||
{$ENDIF}{$ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFnDEF TestType}
|
||||
{$IFnDEF TestAssign}
|
||||
pre__Class1Rec{e} _O2_ TRecordClass1 _EQ_ (Foo: nil); //@@ _pre3_Class1Rec;
|
||||
{$ELSE}
|
||||
pre__Class1Rec{e}.Foo := pre__Instance1{e}; //@@ _pre3_Class1Rec; // }}}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
pre__SomeFunc1Ref{e} _O2_ TFunc1 _EQ_ (nil); //@@ _pre3_SomeFunc1Ref;
|
||||
pre__SomeProc1Ref{e} _O2_ TProc1 _EQ_ (nil); //@@ _pre3_SomeProc1Ref;
|
||||
|
||||
@ -130,6 +130,12 @@ type
|
||||
TstTestName: String;
|
||||
TstWatch: TTestWatch;
|
||||
|
||||
EvalCallTestFlags: TDBGEvaluateFlags;
|
||||
EvalCallResReceived: Boolean;
|
||||
EvalCallResSuccess: Boolean;
|
||||
EvalCallResText: String;
|
||||
EvalCallResDBGType: TDBGType;
|
||||
|
||||
//TstDspFormat: TWatchDisplayFormat;
|
||||
//TstRepeatCount: Integer;
|
||||
//TstEvaluateFlags: TDBGEvaluateFlags;
|
||||
@ -192,6 +198,10 @@ type
|
||||
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;
|
||||
@ -199,7 +209,7 @@ type
|
||||
function ParseCommaList(AVal: String; out AFoundCount: Integer;
|
||||
AMaxLen: Integer = -1; AComma: char = ','): TStringArray;
|
||||
protected
|
||||
function EvaluateWatch(AWatchExp: TWatchExpectation; AThreadId: Integer): Boolean; virtual;
|
||||
function EvaluateWatch(AWatchExp: PWatchExpectation; AThreadId: Integer): Boolean; virtual;
|
||||
procedure WaitWhileEval; virtual;
|
||||
|
||||
function TestMatches(Name: string; Expected, Got: string; AContext: TWatchExpTestCurrentData; AIgnoreReason: String): Boolean;
|
||||
@ -228,6 +238,7 @@ type
|
||||
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;
|
||||
@ -1071,25 +1082,57 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TWatchExpectationList.EvaluateWatch(AWatchExp: TWatchExpectation;
|
||||
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 +
|
||||
FTest.LogText('###### ' + AWatchExp^.TstTestName + ' // ' + AWatchExp^.TstWatch.Expression +
|
||||
' (AT '+ SrcFile + ':' + IntToStr(SrcLine) +')' +
|
||||
'###### '+LineEnding);
|
||||
AWatchExp.TstWatch.Values[AThreadId, AWatchExp.TstStackFrame].Value;
|
||||
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;
|
||||
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 );
|
||||
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;
|
||||
@ -1201,6 +1244,12 @@ begin
|
||||
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);
|
||||
|
||||
@ -1308,7 +1357,7 @@ begin
|
||||
Result := True;
|
||||
Expect := AContext.Expectation;
|
||||
|
||||
if (Expect.ExpTypeName = '') or (not AContext.HasTypeInfo) then
|
||||
if (Expect.ExpTypeName = '') or (Expect.ExpTypeName = #1) or (not AContext.HasTypeInfo) then
|
||||
exit;
|
||||
|
||||
ehf := Expect.ExpErrorHandlingFlags[Compiler.SymbolType];
|
||||
@ -1703,14 +1752,86 @@ debugln([' expect ',Expect.ExpFullArrayLen,' got "',v,'"' ]);
|
||||
|
||||
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, sr: TWatchExpectationResult;
|
||||
SubContext: TWatchExpTestCurrentData;
|
||||
v, n, tn: String;
|
||||
parsed: TStringArray;
|
||||
i, e, j: Integer;
|
||||
Expect: TWatchExpectationResult;
|
||||
v, tn: String;
|
||||
ehf: TWatchExpErrorHandlingFlags;
|
||||
begin
|
||||
with AContext.WatchExp do begin
|
||||
@ -1733,60 +1854,16 @@ debugln([' expect ',Expect.ExpFullArrayLen,' got "',v,'"' ]);
|
||||
if not TestMatches('Is record', '^'+tn+' *\(.*\)$', v, False, AContext, AnIgnoreRsn) then
|
||||
exit;
|
||||
|
||||
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;
|
||||
|
||||
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), 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;
|
||||
Result := CheckStructureFields(AnIgnoreRsn, AContext);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TWatchExpectationList.CheckResultClass(
|
||||
AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean;
|
||||
var
|
||||
Expect, sr: TWatchExpectationResult;
|
||||
SubContext: TWatchExpTestCurrentData;
|
||||
v, n, tn: String;
|
||||
parsed: TStringArray;
|
||||
i, e, j: Integer;
|
||||
v, tn: String;
|
||||
ehf: TWatchExpErrorHandlingFlags;
|
||||
Expect: TWatchExpectationResult;
|
||||
begin
|
||||
with AContext.WatchExp do begin
|
||||
Result := True;
|
||||
@ -1802,61 +1879,20 @@ begin
|
||||
if not TestMatches('Is class ', '^'+tn+' *\(.*\)$', v, False, AContext, AnIgnoreRsn) then
|
||||
exit;
|
||||
|
||||
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;
|
||||
|
||||
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;
|
||||
Result := CheckStructureFields(AnIgnoreRsn, AContext);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TWatchExpectationList.CheckResultObject(
|
||||
AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean;
|
||||
begin
|
||||
CheckResultRecord(AContext, AnIgnoreRsn);
|
||||
Result := CheckResultRecord(AContext, AnIgnoreRsn);
|
||||
end;
|
||||
|
||||
function TWatchExpectationList.CheckResultInstance(
|
||||
AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean;
|
||||
begin
|
||||
CheckResultClass(AContext, AnIgnoreRsn);
|
||||
Result := CheckResultClass(AContext, AnIgnoreRsn);
|
||||
end;
|
||||
|
||||
constructor TWatchExpectationList.Create(ATest: TDBGTestCase);
|
||||
@ -1962,8 +1998,10 @@ procedure TWatchExpectationList.Clear;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 0 to Length(FList)-1 do
|
||||
for i := 0 to Length(FList)-1 do begin
|
||||
FList[i].TstWatch.Free;
|
||||
FList[i].EvalCallResDBGType.Free;
|
||||
end;
|
||||
FList := nil;
|
||||
end;
|
||||
|
||||
@ -1978,7 +2016,7 @@ var
|
||||
begin
|
||||
t := LazDebugger.Threads.CurrentThreads.CurrentThreadId;
|
||||
for i := 0 to Length(FList)-1 do begin
|
||||
EvaluateWatch(FList[i], t);
|
||||
EvaluateWatch(@FList[i], t);
|
||||
if (i mod 16) = 0 then TestLogger.DbgOut('.');
|
||||
end;
|
||||
TestLogger.DebugLn('');
|
||||
|
||||
Loading…
Reference in New Issue
Block a user