mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-14 17:39:23 +02:00
FpDebug: more tests
git-svn-id: trunk@61778 -
This commit is contained in:
martin
parent
94eaca854f
commit
530e705ee9
@ -81,6 +81,7 @@
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<DebugInfoType Value="dsDwarf2Set"/>
|
||||
<UseHeaptrc Value="True"/>
|
||||
</Debugging>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
|
||||
@ -578,7 +578,7 @@ end;
|
||||
procedure TTestWatches.TestWatchesValue;
|
||||
|
||||
type
|
||||
TTestLoc = (tlAny, tlConst, tlParam, tlArrayWrap, tlPointer);
|
||||
TTestLoc = (tlAny, tlConst, tlParam, tlArrayWrap, tlPointer, tlPointerAny);
|
||||
|
||||
procedure AddWatches(t: TWatchExpectationList; AName: String; APrefix: String; AOffs: Integer; AChr1: Char;
|
||||
ALoc: TTestLoc = tlAny; APostFix: String = '');
|
||||
@ -620,14 +620,16 @@ procedure TTestWatches.TestWatchesValue;
|
||||
t.Add(AName, p+'Double'+e, weDouble(1000.125+n, 'Double' ));
|
||||
t.Add(AName, p+'Extended'+e, weFloat(10000.175+n, '' )); // Double ?
|
||||
//t.Add(p+'Comp'+e, weInteger(150.125+n, 'Comp' ));
|
||||
t.Add(AName, p+'Currency'+e, weFloat(125.123+n, 'Currency' ))^.AddFlag([ehNotImplementedData]);
|
||||
t.Add(AName, p+'Currency'+e, weFloat(125.123+n, 'Currency' ))^.AddFlag([ehNotImplementedData])
|
||||
.SkipIf(ALoc = tlPointerAny);
|
||||
|
||||
t.Add(AName, p+'Real_2'+e, weFloat(-50.25+n, 'Real' ));
|
||||
t.Add(AName, p+'Single_2'+e, weSingle(-100.125+n, 'Single' ));
|
||||
t.Add(AName, p+'Double_2'+e, weDouble(-1000.125+n, 'Double' ));
|
||||
t.Add(AName, p+'Extended_2'+e, weFloat(-10000.175+n, '' )); // Double ?
|
||||
//t.Add(p+'Comp_2'+e, weFloat(-150.125+n, 'Comp' ));
|
||||
t.Add(AName, p+'Currency_2'+e, weFloat(-125.123+n, 'Currency' ))^.AddFlag([ehNotImplementedData]);
|
||||
t.Add(AName, p+'Currency_2'+e, weFloat(-125.123+n, 'Currency' ))^.AddFlag([ehNotImplementedData])
|
||||
.SkipIf(ALoc = tlPointerAny);
|
||||
|
||||
t.Add(AName, p+'Ptr1'+e, wePointerAddr(nil, 'Pointer'));
|
||||
t.Add(AName, p+'Ptr2'+e, wePointerAddr(Pointer(1000+n), 'Pointer'));
|
||||
@ -713,7 +715,8 @@ for i := StartIdx to t.Count-1 do
|
||||
|
||||
|
||||
// TODO
|
||||
t.Add(AName, p+'ShortRec'+e, weMatch(''''+AChr1+''', *''b'', *'''+AChr1+'''', skRecord));
|
||||
t.Add(AName, p+'ShortRec'+e, weMatch(''''+AChr1+''', *''b'', *'''+AChr1+'''', skRecord))
|
||||
.SkipIf(ALoc = tlPointerAny);
|
||||
|
||||
|
||||
t.add(AName, p+'CharDynArray'+e, weDynArray([] )).SkipIf(ALoc in [tlPointer]);
|
||||
@ -799,7 +802,34 @@ t.Add(AName, p+'FiveDynArray'+e+'[0]', weMatch('.*',skRecord));
|
||||
for i := StartIdx to t.Count-1 do
|
||||
t.Tests[i].SkipIf(ALoc = tlConst);
|
||||
|
||||
t.Add(AName, p+'FiveRec'+e, weMatch('a *=.*b *= *44',skRecord));
|
||||
t.Add(AName, p+'FiveRec'+e, weMatch('a *=.*b *= *44',skRecord))
|
||||
.SkipIf(ALoc = tlPointerAny);
|
||||
t.Add(AName, p+'FiveRec'+e, weRecord([weInteger(-22-n).N('a'), weInteger(44).N('b')], 'TRecordFive'))
|
||||
.SkipIf(ALoc = tlPointerAny);
|
||||
|
||||
// FDynInt // nil for tlconst
|
||||
t.Add(AName, p+'Instance1'+e, weClass([weInteger(22+n).N('FInt'), weAnsiStr(AChr1+'T').N('FAnsi')], 'TClass1'))
|
||||
.AddFlag(ehMissingFields)
|
||||
.SkipIf(ALoc in [tlConst, tlPointerAny]);
|
||||
|
||||
t.Add(AName, p+'Obj3'+e, weObject([weInteger(-22).N('a'), weInteger(44).N('b'), weInteger(4000+n).N('c')],
|
||||
'TObject3Int64'))
|
||||
.Skip(stDwarf3Up)
|
||||
.SkipIf(ALoc = tlPointerAny);
|
||||
t.Add(AName, p+'Obj3Ex'+e, weObject([weInteger(-22).N('a'), weInteger(44).N('b'), weInteger(4100+n).N('c'), weInteger(555).N('d')],
|
||||
'TObject3Int64Ex'))
|
||||
.Skip(stDwarf3Up)
|
||||
.SkipIf(ALoc = tlPointerAny);
|
||||
t.Add(AName, p+'Obj3C'+e, weObject([weInteger(22).N('a'), weInteger(44).N('b'), weInteger(4200+n).N('c')],
|
||||
'TObjectCreate3Int64'))
|
||||
.AddFlag(ehMissingFields)
|
||||
.Skip(stDwarf3Up)
|
||||
.SkipIf(ALoc in [tlConst, tlPointerAny]);
|
||||
t.Add(AName, p+'Obj3ExC'+e, weObject([weInteger(22).N('a'), weInteger(44).N('b'), weInteger(4300+n).N('c'), weInteger(655).N('d')],
|
||||
'TObjectCreate3Int64Ex'))
|
||||
.AddFlag(ehMissingFields)
|
||||
.Skip(stDwarf3Up)
|
||||
.SkipIf(ALoc in [tlConst, tlPointerAny]);
|
||||
|
||||
|
||||
t.Add(AName, p+'CharStatArray'+e, weStatArray(weChar([AChr1, 'b', AChr1, 'B', 'c']) ))
|
||||
@ -895,7 +925,7 @@ StartIdx := t.Count; // tlConst => Only eval the watch. No tests
|
||||
t.Add(AName, p+'SomeMeth1Ref'+e, weMatch('TMeth1.*Proc *= *\$[0-9A-F]+ *= *TMyBaseClass\.SomeMeth1.*: *TMeth1;[\s\r\n]*Self.*=.*', skRecord) );
|
||||
t.Add(AName, p+'SomeMeth1Ref'+e+'.Proc', weMatch('\$[0-9A-F]+ = TMyBaseClass\.SomeMeth1: *function *\(.*AVal.*\): *BOOLEAN', skFunctionRef) );
|
||||
for i := StartIdx to t.Count-1 do
|
||||
t.Tests[i].SkipIf(ALoc = tlConst);
|
||||
t.Tests[i].SkipIf(ALoc in [tlConst, tlPointerAny])
|
||||
|
||||
end;
|
||||
|
||||
@ -905,6 +935,7 @@ var
|
||||
Src: TCommonSource;
|
||||
BrkPrg, BrkFooBegin, BrkFoo, BrkFooVar, BrkFooVarBegin,
|
||||
BrkFooConstRef: TDBGBreakPoint;
|
||||
c, i: Integer;
|
||||
begin
|
||||
if SkipTest then exit;
|
||||
if not TestControlCanTest(ControlTestWatchValue) then exit;
|
||||
@ -973,6 +1004,15 @@ begin
|
||||
AddWatches(t, 'glob var dyn array of [0]', 'gva', 005, 'K', tlArrayWrap, '[0]' );
|
||||
AddWatches(t, 'glob var dyn array of [1]', 'gva', 006, 'L', tlArrayWrap, '[1]');
|
||||
AddWatches(t, 'glob var pointer', 'gvp_', 001, 'B', tlPointer, '^'); // pointer
|
||||
AddWatches(t, 'glob var named pointer', 'gvpt_', 001, 'B', tlPointer, '^'); // pointer
|
||||
|
||||
// type names do not match....
|
||||
c := t.Count;
|
||||
AddWatches(t, 'glob var TYPED pointer', 'gvptt_', 007, 'N', tlPointerAny, '^'); // pointer
|
||||
AddWatches(t, 'glob var TYPED ALIAS ', 'gvtt_', 007, 'N', tlPointerAny, '');
|
||||
for i := c to t.Count-1 do
|
||||
t.Tests[i].IgnTypeName.AddFlag(ehIgnTypeNameInData);
|
||||
|
||||
t.EvaluateWatches;
|
||||
t.CheckResults;
|
||||
|
||||
@ -1497,10 +1537,10 @@ StartIdx := t.Count; // tlConst => Only eval the watch. No tests
|
||||
t.Add(AName+' TClass1', 'TClass1(Pointer('+val+'))', weMatch('FAnsi *=[ $0-9A-F()]*'''+AChr1+'T', skClass));
|
||||
|
||||
val := t2.Tests[1]^.TstWatch.Values[Thread, 0].Value;
|
||||
t.Add(AName+' PxInstance1', 'PxInstance1(@'+p+'Instance1'+e+')^', weMatch('FAnsi *=[ $0-9A-F()]*'''+AChr1+'T', skClass));
|
||||
t.Add(AName+' PxInstance1', 'PxInstance1('+val+')^', weMatch('FAnsi *=[ $0-9A-F()]*'''+AChr1+'T', skClass));
|
||||
t.Add(AName+' PxInstance1', 'PxInstance1(Pointer(@'+p+'Instance1'+e+'))^', weMatch('FAnsi *=[ $0-9A-F()]*'''+AChr1+'T', skClass));
|
||||
t.Add(AName+' PxInstance1', 'PxInstance1(Pointer('+val+'))^', weMatch('FAnsi *=[ $0-9A-F()]*'''+AChr1+'T', skClass));
|
||||
t.Add(AName+' PTxInstance1', 'PTxInstance1(@'+p+'Instance1'+e+')^', weMatch('FAnsi *=[ $0-9A-F()]*'''+AChr1+'T', skClass));
|
||||
t.Add(AName+' PTxInstance1', 'PTxInstance1('+val+')^', weMatch('FAnsi *=[ $0-9A-F()]*'''+AChr1+'T', skClass));
|
||||
t.Add(AName+' PTxInstance1', 'PTxInstance1(Pointer(@'+p+'Instance1'+e+'))^', weMatch('FAnsi *=[ $0-9A-F()]*'''+AChr1+'T', skClass));
|
||||
t.Add(AName+' PTxInstance1', 'PTxInstance1(Pointer('+val+'))^', weMatch('FAnsi *=[ $0-9A-F()]*'''+AChr1+'T', skClass));
|
||||
|
||||
|
||||
val := t2.Tests[2]^.TstWatch.Values[Thread, 0].Value;
|
||||
@ -1522,36 +1562,36 @@ StartIdx := t.Count; // tlConst => Only eval the watch. No tests
|
||||
t.Add(AName, 'TIntDynArray(PtrUint('+val+'))', weDynArray(weInteger([12, 30+AOffs, 60]), 'TIntDynArray'));
|
||||
|
||||
val := t2.Tests[4]^.TstWatch.Values[Thread, 0].Value;
|
||||
t.Add(AName, 'PxIntDynArray4(@'+p+'IntDynArray4'+e+')^', weDynArray(weInteger([12, 30+AOffs, 60]), 'TxIntDynArray4'));
|
||||
t.Add(AName, 'PxIntDynArray4('+val+')^', weDynArray(weInteger([12, 30+AOffs, 60]), 'TxIntDynArray4'));
|
||||
t.Add(AName, 'PxIntDynArray4(Pointer(@'+p+'IntDynArray4'+e+'))^', weDynArray(weInteger([12, 30+AOffs, 60]), 'TxIntDynArray4'));
|
||||
t.Add(AName, 'PxIntDynArray4(Pointer('+val+'))^', weDynArray(weInteger([12, 30+AOffs, 60]), 'TxIntDynArray4'));
|
||||
t.Add(AName, 'PxIntDynArray4(PtrUint(@'+p+'IntDynArray4'+e+'))^', weDynArray(weInteger([12, 30+AOffs, 60]), 'TxIntDynArray4'));
|
||||
t.Add(AName, 'PxIntDynArray4(PtrUint('+val+'))^', weDynArray(weInteger([12, 30+AOffs, 60]), 'TxIntDynArray4'));
|
||||
t.Add(AName, 'PTxIntDynArray4(@'+p+'IntDynArray4'+e+')^', weDynArray(weInteger([12, 30+AOffs, 60]), 'TxIntDynArray4'));
|
||||
t.Add(AName, 'PTxIntDynArray4('+val+')^', weDynArray(weInteger([12, 30+AOffs, 60]), 'TxIntDynArray4'));
|
||||
t.Add(AName, 'PTxIntDynArray4(Pointer(@'+p+'IntDynArray4'+e+'))^', weDynArray(weInteger([12, 30+AOffs, 60]), 'TxIntDynArray4'));
|
||||
t.Add(AName, 'PTxIntDynArray4(Pointer('+val+'))^', weDynArray(weInteger([12, 30+AOffs, 60]), 'TxIntDynArray4'));
|
||||
t.Add(AName, 'PTxIntDynArray4(PtrUint(@'+p+'IntDynArray4'+e+'))^', weDynArray(weInteger([12, 30+AOffs, 60]), 'TxIntDynArray4'));
|
||||
t.Add(AName, 'PTxIntDynArray4(PtrUint('+val+'))^', weDynArray(weInteger([12, 30+AOffs, 60]), 'TxIntDynArray4'));
|
||||
|
||||
t.Add(AName, 'TIntDynArray(PxIntDynArray4('+val+')^)', weDynArray(weInteger([12, 30+AOffs, 60]), 'TIntDynArray'));
|
||||
|
||||
|
||||
|
||||
val := t2.Tests[5]^.TstWatch.Values[Thread, 0].Value;
|
||||
t.Add(AName, 'PxWord(@'+p+'Word'+e+')^', weCardinal(100+n, 'TxWord', 2));
|
||||
t.Add(AName, 'PxWord('+val+')^', weCardinal(100+n, 'TxWord', 2));
|
||||
t.Add(AName, 'PxWord(Pointer(@'+p+'Word'+e+'))^', weCardinal(100+n, 'TxWord', 2));
|
||||
t.Add(AName, 'PxWord(Pointer('+val+'))^', weCardinal(100+n, 'TxWord', 2));
|
||||
t.Add(AName, 'PxWord(PtrUInt(@'+p+'Word'+e+'))^', weCardinal(100+n, 'TxWord', 2));
|
||||
t.Add(AName, 'PxWord(PtrUInt('+val+'))^', weCardinal(100+n, 'TxWord', 2));
|
||||
t.Add(AName, 'PTxWord(@'+p+'Word'+e+')^', weCardinal(100+n, 'TxWord', 2));
|
||||
t.Add(AName, 'PTxWord('+val+')^', weCardinal(100+n, 'TxWord', 2));
|
||||
t.Add(AName, 'PTxWord(Pointer(@'+p+'Word'+e+'))^', weCardinal(100+n, 'TxWord', 2));
|
||||
t.Add(AName, 'PTxWord(Pointer('+val+'))^', weCardinal(100+n, 'TxWord', 2));
|
||||
t.Add(AName, 'PTxWord(PtrUInt(@'+p+'Word'+e+'))^', weCardinal(100+n, 'TxWord', 2));
|
||||
t.Add(AName, 'PTxWord(PtrUInt('+val+'))^', weCardinal(100+n, 'TxWord', 2));
|
||||
if p='gv' then
|
||||
t.Add(AName, 'PxWord(gvp_'+'Word'+e+')^', weCardinal(100+n, 'TxWord', 2));
|
||||
t.Add(AName, 'PTxWord(gvp_'+'Word'+e+')^', weCardinal(100+n, 'TxWord', 2));
|
||||
|
||||
val := t2.Tests[6]^.TstWatch.Values[Thread, 0].Value;
|
||||
t.Add(AName, 'PxFiveRec(@'+p+'FiveRec'+e+')^', weMatch('a *=.*b *= *44',skRecord));
|
||||
t.Add(AName, 'PxFiveRec('+val+')^', weMatch('a *=.*b *= *44',skRecord));
|
||||
t.Add(AName, 'PxFiveRec(Pointer(@'+p+'FiveRec'+e+'))^', weMatch('a *=.*b *= *44',skRecord));
|
||||
t.Add(AName, 'PxFiveRec(Pointer('+val+'))^', weMatch('a *=.*b *= *44',skRecord));
|
||||
t.Add(AName, 'PxFiveRec(PtrUInt(@'+p+'FiveRec'+e+'))^', weMatch('a *=.*b *= *44',skRecord));
|
||||
t.Add(AName, 'PxFiveRec(PtrUInt('+val+'))^', weMatch('a *=.*b *= *44',skRecord));
|
||||
t.Add(AName, 'PTxFiveRec(@'+p+'FiveRec'+e+')^', weMatch('a *=.*b *= *44',skRecord));
|
||||
t.Add(AName, 'PTxFiveRec('+val+')^', weMatch('a *=.*b *= *44',skRecord));
|
||||
t.Add(AName, 'PTxFiveRec(Pointer(@'+p+'FiveRec'+e+'))^', weMatch('a *=.*b *= *44',skRecord));
|
||||
t.Add(AName, 'PTxFiveRec(Pointer('+val+'))^', weMatch('a *=.*b *= *44',skRecord));
|
||||
t.Add(AName, 'PTxFiveRec(PtrUInt(@'+p+'FiveRec'+e+'))^', weMatch('a *=.*b *= *44',skRecord));
|
||||
t.Add(AName, 'PTxFiveRec(PtrUInt('+val+'))^', weMatch('a *=.*b *= *44',skRecord));
|
||||
if p='gv' then
|
||||
t.Add(AName, 'PxFiveRec(gvp_'+'FiveRec'+e+')^', weMatch('a *=.*b *= *44',skRecord));
|
||||
t.Add(AName, 'PTxFiveRec(gvp_'+'FiveRec'+e+')^', weMatch('a *=.*b *= *44',skRecord));
|
||||
|
||||
for i := StartIdx to t.Count-1 do
|
||||
t.Tests[i].SkipIf(ALoc = tlConst);
|
||||
|
||||
@ -73,6 +73,19 @@ type
|
||||
|
||||
TRecord3Int64 = record a,b,c: Int64; end;
|
||||
TRecord3QWord = record a,b,c: QWord; end;
|
||||
//PRecord3Int64 = ^TRecord3Int64;
|
||||
|
||||
TObject3Int64 = object a,b,c: Int64; end;
|
||||
TObject3Int64Ex = object(TObject3Int64) d: QWord; end;
|
||||
//PObject3Int64 = ^TObject3Int64;
|
||||
//PObject3Int64Ex = ^TObject3Int64Ex;
|
||||
|
||||
TObjectCreate3Int64 = object a,b,c: Int64; public constructor Create; destructor Destroy; procedure Foo; virtual; end;
|
||||
TObjectCreate3Int64Ex = object(TObjectCreate3Int64) d: QWord; end;
|
||||
//PObjectCreate3Int64 = ^TObjectCreate3Int64;
|
||||
//PObjectCreate3Int64Ex = ^TObjectCreate3Int64Ex;
|
||||
|
||||
//PIUnknown = ^IUnknown;
|
||||
|
||||
TFiveDynArray = array of record a:longint; b: byte end;
|
||||
TFiveDynArrayPack = packed array of record a:longint; b: byte end;
|
||||
@ -99,6 +112,8 @@ type
|
||||
FAnsi: AnsiString;
|
||||
end;
|
||||
|
||||
PClass1 = ^TClass1;
|
||||
|
||||
TEnum = (EnVal1, EnVal2, EnVal3, EnVal4);
|
||||
TEnumSub = EnVal1..EnVal2;
|
||||
TEnum2 = (EnVal21= 3, EnVal22=4, EnVal23=7, EnVal24=10, EnVal25=30);
|
||||
@ -115,8 +130,10 @@ type
|
||||
|
||||
type
|
||||
(* LOCATION: TYPE *)
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=Tx, "_OP_== type ", (=;//, "_O2_= = type", _EQ_=, _BLOCK_=TestVar )
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc,pre__=Px, _OP_={, _O2_={, _pre3_=^Tx, "//@@=} = ", _BLOCK_=TestVar) //}
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=Tx, "_OP_== type ", (=;//, "_O2_= = type", _EQ_=, _BLOCK_=TestVar, _BLOCK2_=TestType )
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc,pre__=PTx, _OP_={, _O2_={, _pre3_=^Tx, "//@@=} = ", _BLOCK_=TestVar, _BLOCK2_=TestType ) //}
|
||||
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc,pre__=Px, "_OP_==^", "_O2_==^", "(=;//", _EQ_=, _BLOCK_=TestVar, _BLOCK2_=TestPointer ) //}
|
||||
|
||||
(* LOCATION: field in baseclass *)
|
||||
TMyBaseClass = class
|
||||
@ -150,6 +167,22 @@ var
|
||||
(* LOCATION: global var pointer <each type> *)
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=gvp_, "_OP_=: ^", (=;//, "_O2_=: ^", _EQ_=, _BLOCK_=TestVar, _BLOCK2_=TestPointer )
|
||||
|
||||
(* LOCATION: global var TYPE alias // NO PRE-ASSIGNED VALUE *)
|
||||
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 *)
|
||||
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 *)
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=gvptt_, "_OP_={", "_O2_={", "//@@=} :", _pre3_=PTx, _BLOCK_=TestVar, _BLOCK2_=TestType ) // }
|
||||
|
||||
constructor TObjectCreate3Int64.Create;
|
||||
begin end;
|
||||
destructor TObjectCreate3Int64.Destroy;
|
||||
begin end;
|
||||
procedure TObjectCreate3Int64.Foo;
|
||||
begin end;
|
||||
|
||||
function TMyBaseClass.SomeMeth1(SomeValue: Integer): Boolean;
|
||||
begin result := SomeValue = 0; end;
|
||||
|
||||
@ -232,6 +265,15 @@ begin
|
||||
(* INIT: global var *)
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc,pre__=gv, ADD=1, CHR1='B', _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 ) // }
|
||||
|
||||
(* 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)
|
||||
|
||||
(* 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: field in class / baseclass *)
|
||||
MyClass1 := TMyClass.Create;
|
||||
MyClass1.SomeMeth1(1);
|
||||
|
||||
@ -33,14 +33,30 @@
|
||||
pre__Double{e} _OP_ Double (1000.125 + ADD); //@@ _pre3_Double;
|
||||
pre__Extended{e} _OP_ Extended (10000.175 + ADD); //@@ _pre3_Extended;
|
||||
//pre__Comp{e} _OP_ Comp (50.125 + ADD); //@@ //_pre3_Comp;
|
||||
{$IFDEF TestAssign}
|
||||
{$IFDEF TestType}
|
||||
// pre__Currency{e} _OP_ TxCurrency (125.123 + ADD); //@@ _pre3_Currency;
|
||||
{$ELSE}
|
||||
pre__Currency{e} _OP_ Currency (125.123 + ADD); //@@ _pre3_Currency;
|
||||
{$ENDIF}
|
||||
{$ELSE}
|
||||
pre__Currency{e} _OP_ Currency (-125.123 + ADD); //@@ _pre3_Currency;
|
||||
{$ENDIF}
|
||||
|
||||
pre__Real_2{e} _OP_ Real (-50.25 + ADD); //@@ _pre3_Real_2;
|
||||
pre__Single_2{e} _OP_ Single (-100.125 + ADD); //@@ _pre3_Single_2;
|
||||
pre__Double_2{e} _OP_ Double (-1000.125 + ADD); //@@ _pre3_Double_2;
|
||||
pre__Extended_2{e} _OP_ Extended (-10000.175 + ADD); //@@ _pre3_Extended_2;
|
||||
//pre__Comp_2{e} _OP_ Comp (-150.125 + ADD); //@@ //_pre3_Comp_2;
|
||||
{$IFDEF TestAssign}
|
||||
{$IFDEF TestType}
|
||||
// pre__Currency_2{e} _OP_ TxCurrency_2 (-125.123 + ADD); //@@ _pre3_Currency_2;
|
||||
{$ELSE}
|
||||
pre__Currency_2{e} _OP_ Currency (-125.123 + ADD); //@@ _pre3_Currency_2;
|
||||
{$ENDIF}
|
||||
{$ELSE}
|
||||
pre__Currency_2{e} _OP_ Currency (-125.123 + ADD); //@@ _pre3_Currency_2;
|
||||
{$ENDIF}
|
||||
|
||||
pre__Ptr1{e} _OP_ Pointer (0 ); //@@ _pre3_Ptr1;
|
||||
pre__Ptr2{e} _OP_ Pointer (1000 + ADD); //@@ _pre3_Ptr2;
|
||||
@ -103,8 +119,12 @@
|
||||
{$IFnDEF TestAssign}
|
||||
pre__ShortRec{e} _O2_ TShortRec _EQ_ (length: 5; st: (CHR1, 'b',CHR1, 'b','c')); //@@ _pre3_ShortRec;
|
||||
{$ELSE}
|
||||
{$IFDEF TestType} // incomplete values
|
||||
pre__ShortRec{e} := pre__ShortRec; pre__ShortRec{e}.st[1] := CHR1; pre__ShortRec{e}.st[3] := CHR1; //@@ _pre3_ShortRec; // }}
|
||||
{$ELSE}
|
||||
pre__ShortRec{e} := _pre2_ShortRec; pre__ShortRec{e}.st[1] := CHR1; pre__ShortRec{e}.st[3] := CHR1; //@@ _pre3_ShortRec; // }}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
// **** ARRAY ****
|
||||
// **** Dyn ARRAY ****
|
||||
@ -354,20 +374,55 @@
|
||||
|
||||
|
||||
{$IFnDEF TestAssign}
|
||||
pre__FiveRec{e} _O2_ TRecordFive _EQ_ (a:-22-ADD;b:44); //@@ _pre3_FiveRec;
|
||||
pre__Rec3S{e} _O2_ TRecord3Int64 _EQ_ (a:-22;b:44;c:1000+ADD); //@@ _pre3_Rec3S;
|
||||
pre__Rec3U{e} _O2_ TRecord3QWord _EQ_ (a:111;b:44;c:1000+ADD); //@@ _pre3_Rec3U;
|
||||
{$ELSE}
|
||||
pre__FiveRec{e} := _pre2_FiveRec; pre__FiveRec{e}.a := -22-ADD; //@@ _pre3_FiveRec; // }}}
|
||||
pre__Rec3S{e} := _pre2_Rec3S; pre__Rec3S{e}.c := 1000+ADD; //@@ _pre3_Rec3S; // }}}
|
||||
pre__Rec3U{e} := _pre2_Rec3U; pre__Rec3U{e}.c := 1000+ADD; //@@ _pre3_Rec3U; // }}}
|
||||
pre__FiveRec{e} _O2_ TRecordFive _EQ_ (a:-22-ADD;b:44); //@@ _pre3_FiveRec;
|
||||
pre__Rec3S{e} _O2_ TRecord3Int64 _EQ_ (a:-22;b:44;c:1000+ADD); //@@ _pre3_Rec3S;
|
||||
pre__Rec3U{e} _O2_ TRecord3QWord _EQ_ (a:111;b:44;c:1000+ADD); //@@ _pre3_Rec3U;
|
||||
|
||||
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
|
||||
pre__Obj3C{e} _O2_ TObjectCreate3Int64 ; //@@ _pre3_Obj3C; // }}}
|
||||
pre__Obj3ExC{e} _O2_ TObjectCreate3Int64Ex ; //@@ _pre3_Obj3ExC; // }}}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
{$ELSE} // TestAssign
|
||||
{$IFDEF TestType} // incomplete values
|
||||
pre__FiveRec{e} := pre__FiveRec; pre__FiveRec{e}.a := -22-ADD; //@@ _pre3_FiveRec; // }}}
|
||||
pre__Rec3S{e} := pre__Rec3S; pre__Rec3S{e}.c := 1000+ADD; //@@ _pre3_Rec3S; // }}}
|
||||
pre__Rec3U{e} := pre__Rec3U; pre__Rec3U{e}.c := 1000+ADD; //@@ _pre3_Rec3U; // }}}
|
||||
|
||||
pre__Obj3{e} := pre__Obj3; pre__Obj3{e}.c := 4000+ADD; //@@ _pre3_Obj3; // }}}
|
||||
pre__Obj3Ex{e} := pre__Obj3Ex; pre__Obj3Ex{e}.c := 4100+ADD; //@@ _pre3_Obj3Ex; // }}}
|
||||
{$ELSE}
|
||||
pre__FiveRec{e} := _pre2_FiveRec; pre__FiveRec{e}.a := -22-ADD; //@@ _pre3_FiveRec; // }}}
|
||||
pre__Rec3S{e} := _pre2_Rec3S; pre__Rec3S{e}.c := 1000+ADD; //@@ _pre3_Rec3S; // }}}
|
||||
pre__Rec3U{e} := _pre2_Rec3U; pre__Rec3U{e}.c := 1000+ADD; //@@ _pre3_Rec3U; // }}}
|
||||
|
||||
pre__Obj3{e} := _pre2_Obj3; pre__Obj3{e}.c := 4000+ADD; //@@ _pre3_Obj3; // }}}
|
||||
pre__Obj3Ex{e} := _pre2_Obj3Ex; pre__Obj3Ex{e}.c := 4100+ADD; //@@ _pre3_Obj3Ex; // }}}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFnDEF TestConst}
|
||||
{$IFnDEF TestType} // will work in fpc 3.2.0 upwards
|
||||
pre__Obj3C{e}.Create; pre__Obj3C{e}.a := 22; pre__Obj3C{e}.b := 44; pre__Obj3C{e}.c := 4200+ADD; //@@ _pre3_Obj3C; // }}}}}
|
||||
pre__Obj3ExC{e}.Create; pre__Obj3ExC{e}.a := 22; pre__Obj3ExC{e}.b := 44; pre__Obj3ExC{e}.c := 4300+ADD; pre__Obj3ExC{e}.d := 655; //@@ _pre3_Obj3ExC; // }}}}}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
pre__Instance1{e} _O2_ TClass1 _EQ_ (nil); //@@ _pre3_Instance1;
|
||||
pre__Instance1_Int{e} _O2_ PtrUInt _EQ_ (0); //@@ _pre3_Instance1_Int;
|
||||
{$IFDEF TestAssign}
|
||||
{$IFDEF TestType}
|
||||
pre__Instance1{e} := TxInstance1.Create; //@@
|
||||
{$ELSE}
|
||||
pre__Instance1{e} := TClass1.Create; //@@
|
||||
{$ENDIF}
|
||||
pre__Instance1{e}.FInt _OP_ 22+ADD; //@@
|
||||
pre__Instance1{e}.FAnsi _OP_ CHR1+'T'; //@@
|
||||
pre__Instance1_Int{e} _OP_ PtrUInt(pre__Instance1{e}); //@@ //}}
|
||||
@ -385,12 +440,10 @@
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
// interface
|
||||
// interface / object vs class / record
|
||||
// array dyn/stat / nested of record/class/char/num ... bitpacked
|
||||
// record
|
||||
// object
|
||||
// class
|
||||
// class of
|
||||
// class/record helper
|
||||
// type
|
||||
|
||||
// pointer / deref for all above
|
||||
|
||||
@ -15,7 +15,7 @@ type
|
||||
TWatchExpectationResultKind = (
|
||||
rkMatch, rkInteger, rkCardinal, rkFloat, rkEnum, rkSet,
|
||||
rkChar, rkAnsiString, rkShortString, rkWideString, rkPointer, rkPointerAddr,
|
||||
rkClass, rkObject, rkRecord, rkField,
|
||||
rkClass, rkObject, rkRecord, rkInterface, rkField,
|
||||
rkStatArray, rkDynArray
|
||||
);
|
||||
|
||||
@ -28,10 +28,13 @@ type
|
||||
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 ?)
|
||||
@ -60,9 +63,13 @@ type
|
||||
|
||||
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;
|
||||
|
||||
@ -139,8 +146,10 @@ type
|
||||
{ TWatchExpectationHelper }
|
||||
|
||||
TWatchExpectationHelper = type helper for PWatchExpectation
|
||||
function AddFlag(AFlag: TWatchExpErrorHandlingFlag; ASymTypes: TSymbolTypes = []): PWatchExpectation;
|
||||
function AddFlag(AFlags: TWatchExpErrorHandlingFlags; ASymTypes: TSymbolTypes = []): 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;
|
||||
@ -161,9 +170,6 @@ type
|
||||
function NotImplementedData(ASymTypes: TSymbolTypes = []; ACond: Boolean = True): PWatchExpectation;
|
||||
end;
|
||||
|
||||
//TWatchExpectationResultHelper = type helper for TWatchExpectationResult
|
||||
//end;
|
||||
|
||||
TWatchExpectationResultArrayHelper = type helper for TWatchExpectationResultArray
|
||||
end;
|
||||
|
||||
@ -188,7 +194,7 @@ type
|
||||
function GetLazDebugger: TDebuggerIntf;
|
||||
function GetTests(Index: Integer): PWatchExpectation;
|
||||
function ParseCommaList(AVal: String; out AFoundCount: Integer;
|
||||
AMaxLen: Integer = -1): TStringArray;
|
||||
AMaxLen: Integer = -1; AComma: char = ','): TStringArray;
|
||||
protected
|
||||
function EvaluateWatch(AWatchExp: TWatchExpectation; AThreadId: Integer): Boolean; virtual;
|
||||
procedure WaitWhileEval; virtual;
|
||||
@ -218,6 +224,10 @@ 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 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;
|
||||
@ -295,8 +305,11 @@ function weShortStr(const AExpVal: array of string; ATypeName: String=#1): TWatc
|
||||
|
||||
|
||||
|
||||
function weClass(AExpClass: String; AExpFields: array of TWatchExpectationResult; ATypeName: String=#1): TWatchExpectationResult;
|
||||
function weField(AExpName: String; AExpVal: TWatchExpectationResult; ATypeName: String=#1): TWatchExpectationResult;
|
||||
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;
|
||||
@ -321,6 +334,51 @@ 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
|
||||
@ -602,19 +660,64 @@ begin
|
||||
Result[i] := weShortStr(AExpVal[i], ATypeName);
|
||||
end;
|
||||
|
||||
function weClass(AExpClass: String;
|
||||
AExpFields: array of TWatchExpectationResult; ATypeName: String
|
||||
): TWatchExpectationResult;
|
||||
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 weField(AExpName: String; AExpVal: TWatchExpectationResult;
|
||||
ATypeName: String): TWatchExpectationResult;
|
||||
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 }
|
||||
@ -643,6 +746,12 @@ begin
|
||||
Result := Self;
|
||||
end;
|
||||
|
||||
function TWatchExpectationResult.N(AFieldName: String): TWatchExpectationResult;
|
||||
begin
|
||||
Self.ExpFieldName := AFieldName;
|
||||
Result := Self;
|
||||
end;
|
||||
|
||||
function TWatchExpectationResult.Skip(ASymTypes: TSymbolTypes
|
||||
): TWatchExpectationResult;
|
||||
begin
|
||||
@ -737,15 +846,39 @@ end;
|
||||
{ TWatchExpectationHelper }
|
||||
|
||||
function TWatchExpectationHelper.AddFlag(AFlag: TWatchExpErrorHandlingFlag;
|
||||
ASymTypes: TSymbolTypes): PWatchExpectation;
|
||||
ASymTypes: TSymbolTypes; ACond: Boolean): PWatchExpectation;
|
||||
begin
|
||||
Result := Self^.AddFlag(AFlag, ASymTypes);
|
||||
if ACond then
|
||||
Result := Self^.AddFlag(AFlag, ASymTypes)
|
||||
else
|
||||
Result := Self;
|
||||
end;
|
||||
|
||||
function TWatchExpectationHelper.AddFlag(AFlags: TWatchExpErrorHandlingFlags;
|
||||
ASymTypes: TSymbolTypes): PWatchExpectation;
|
||||
ASymTypes: TSymbolTypes; ACond: Boolean): PWatchExpectation;
|
||||
begin
|
||||
Result := Self^.AddFlag(AFlags, ASymTypes);
|
||||
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
|
||||
@ -878,7 +1011,8 @@ begin
|
||||
Result := @FList[Index];
|
||||
end;
|
||||
|
||||
function TWatchExpectationList.ParseCommaList(AVal: String; out AFoundCount: Integer; AMaxLen: Integer = -1): TStringArray;
|
||||
function TWatchExpectationList.ParseCommaList(AVal: String; out
|
||||
AFoundCount: Integer; AMaxLen: Integer; AComma: char): TStringArray;
|
||||
var
|
||||
i, BracketLvl: Integer;
|
||||
InQuote: Boolean;
|
||||
@ -894,7 +1028,7 @@ begin
|
||||
InQuote := false;
|
||||
while length(AVal) > 0 do begin
|
||||
while (i <= length(AVal)) and (
|
||||
(AVal[i] <> ',') or (BracketLvl > 0) or InQuote
|
||||
(AVal[i] <> AComma) or (BracketLvl > 0) or InQuote
|
||||
)
|
||||
do begin
|
||||
case AVal[i] of
|
||||
@ -1083,10 +1217,10 @@ begin
|
||||
rkShortString: Result := CheckResultShortStr(AContext, AnIgnoreRsn);
|
||||
rkPointer: Result := CheckResultPointer(AContext, AnIgnoreRsn);
|
||||
rkPointerAddr: Result := CheckResultPointerAddr(AContext, AnIgnoreRsn);
|
||||
rkClass: ;
|
||||
rkObject: ;
|
||||
rkRecord: ;
|
||||
rkField: ;
|
||||
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;
|
||||
@ -1131,6 +1265,11 @@ begin
|
||||
s2 := 'skSimple';
|
||||
end;
|
||||
|
||||
if (t in [skRecord, skClass]) and (Expect.ExpSymKind = skObject) then begin
|
||||
n := ' (skObject for '+s1+')';
|
||||
s1 := 'skObject';
|
||||
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;
|
||||
@ -1281,6 +1420,7 @@ begin
|
||||
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);
|
||||
|
||||
@ -1325,24 +1465,29 @@ function TWatchExpectationList.CheckResultAnsiStr(
|
||||
AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean;
|
||||
var
|
||||
Expect: TWatchExpectationResult;
|
||||
v, e: String;
|
||||
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
|
||||
if (Expect.ExpTypeName <> '') then begin
|
||||
tn := QuoteRegExprMetaChars(Expect.ExpTypeName);
|
||||
if ehIgnTypeNameInData in ehf then
|
||||
tn := '.*';
|
||||
if (tn <> '') then begin
|
||||
if (Expect.ExpTextData = '') and
|
||||
FTest.Matches('^'+Expect.ExpTypeName+'\(nil\)', v)
|
||||
FTest.Matches('^'+tn+'\(nil\)', v)
|
||||
then
|
||||
v := ''''''
|
||||
else
|
||||
if FTest.Matches('^'+Expect.ExpTypeName+'\(\$[0-9a-fA-F]+\) ', v) then
|
||||
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
|
||||
@ -1382,22 +1527,27 @@ function TWatchExpectationList.CheckResultPointer(
|
||||
AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean;
|
||||
var
|
||||
Expect: TWatchExpectationResult;
|
||||
g, e, n: String;
|
||||
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 Expect.ExpTypeName <> '' then
|
||||
e := QuoteRegExprMetaChars(Expect.ExpTypeName)+'\('+e+'\)';
|
||||
if tn <> '' then
|
||||
e := tn+'\('+e+'\)';
|
||||
e := '^'+e;
|
||||
|
||||
Result := TestMatches('Data', e, AContext.WatchVal.Value, AContext, AnIgnoreRsn);
|
||||
|
||||
if ehIgnPointerDerefData in Expect.ExpErrorHandlingFlags[Compiler.SymbolType] then
|
||||
if ehIgnPointerDerefData in ehf then
|
||||
exit;
|
||||
|
||||
g := AContext.WatchVal.Value;
|
||||
@ -1442,18 +1592,23 @@ function TWatchExpectationList.CheckResultPointerAddr(
|
||||
AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean;
|
||||
var
|
||||
Expect: TWatchExpectationResult;
|
||||
e: String;
|
||||
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 Expect.ExpTypeName <> '' then
|
||||
e := Expect.ExpTypeName+'\('+e+'\)';
|
||||
if tn <> '' then
|
||||
e := tn+'\('+e+'\)';
|
||||
e := '^'+e;
|
||||
|
||||
Result := TestMatches('Data', e, AContext.WatchVal.Value, AContext, AnIgnoreRsn);
|
||||
@ -1489,6 +1644,7 @@ debugln([' expect ',Expect.ExpFullArrayLen,' got "',v,'"' ]);
|
||||
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);
|
||||
@ -1511,6 +1667,162 @@ debugln([' expect ',Expect.ExpFullArrayLen,' got "',v,'"' ]);
|
||||
|
||||
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;
|
||||
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;
|
||||
|
||||
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;
|
||||
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;
|
||||
ehf: TWatchExpErrorHandlingFlags;
|
||||
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;
|
||||
|
||||
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;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TWatchExpectationList.CheckResultObject(
|
||||
AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean;
|
||||
begin
|
||||
CheckResultRecord(AContext, AnIgnoreRsn);
|
||||
end;
|
||||
|
||||
function TWatchExpectationList.CheckResultInstance(
|
||||
AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean;
|
||||
begin
|
||||
CheckResultClass(AContext, AnIgnoreRsn);
|
||||
end;
|
||||
|
||||
constructor TWatchExpectationList.Create(ATest: TDBGTestCase);
|
||||
begin
|
||||
FTest := ATest;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user