From 530e705ee93556db9efc16a15b29e19a01171d6b Mon Sep 17 00:00:00 2001 From: martin Date: Wed, 28 Aug 2019 15:36:17 +0000 Subject: [PATCH] FpDebug: more tests git-svn-id: trunk@61778 - --- .../lazdebuggerfp/test/LazDebFpTest.lpi | 1 + .../lazdebuggerfp/test/testwatches.pas | 100 +++-- .../testapps/WatchesValuePrg.pas | 46 ++- .../testapps/WatchesValuePrgIdent.inc | 75 +++- .../lazdebugtestbase/ttestwatchutilities.pas | 384 ++++++++++++++++-- 5 files changed, 527 insertions(+), 79 deletions(-) diff --git a/components/lazdebuggers/lazdebuggerfp/test/LazDebFpTest.lpi b/components/lazdebuggers/lazdebuggerfp/test/LazDebFpTest.lpi index 68223c6e15..78b091fba7 100644 --- a/components/lazdebuggers/lazdebuggerfp/test/LazDebFpTest.lpi +++ b/components/lazdebuggers/lazdebuggerfp/test/LazDebFpTest.lpi @@ -81,6 +81,7 @@ + diff --git a/components/lazdebuggers/lazdebuggerfp/test/testwatches.pas b/components/lazdebuggers/lazdebuggerfp/test/testwatches.pas index 08babf2069..b7cab350c5 100644 --- a/components/lazdebuggers/lazdebuggerfp/test/testwatches.pas +++ b/components/lazdebuggers/lazdebuggerfp/test/testwatches.pas @@ -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); diff --git a/components/lazdebuggers/lazdebugtestbase/testapps/WatchesValuePrg.pas b/components/lazdebuggers/lazdebugtestbase/testapps/WatchesValuePrg.pas index 13a958fcba..6bc482c0b2 100644 --- a/components/lazdebuggers/lazdebugtestbase/testapps/WatchesValuePrg.pas +++ b/components/lazdebuggers/lazdebugtestbase/testapps/WatchesValuePrg.pas @@ -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 *) 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 // NO PRE-ASSIGNED VALUE *) + TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=gvtt_, "_OP_={", "_O2_={", "//@@=} :", _pre3_=Tx, _BLOCK_=TestVar, _BLOCK2_=TestType ) // } + +(* LOCATION: global var NAMED pointer // 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 // 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 // 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); diff --git a/components/lazdebuggers/lazdebugtestbase/testapps/WatchesValuePrgIdent.inc b/components/lazdebuggers/lazdebugtestbase/testapps/WatchesValuePrgIdent.inc index 3a9f591c9f..10bac81f75 100644 --- a/components/lazdebuggers/lazdebugtestbase/testapps/WatchesValuePrgIdent.inc +++ b/components/lazdebuggers/lazdebugtestbase/testapps/WatchesValuePrgIdent.inc @@ -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 diff --git a/components/lazdebuggers/lazdebugtestbase/ttestwatchutilities.pas b/components/lazdebuggers/lazdebugtestbase/ttestwatchutilities.pas index 62e40b5582..7722e7fdcf 100644 --- a/components/lazdebuggers/lazdebugtestbase/ttestwatchutilities.pas +++ b/components/lazdebuggers/lazdebugtestbase/ttestwatchutilities.pas @@ -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;