FpDebug: tests

git-svn-id: trunk@61784 -

components/lazdebuggers/lazdebuggerfp/test/testwatches.pas

@@ -21,13 +21,15 @@ type
     procedure TestWatchesValue;
     procedure TestWatchesAddressOf;
     procedure TestWatchesTypeCast;
+    procedure TestWatchesExpression;
   end;
 
 implementation
 
 var
   ControlTestWatch, ControlTestWatchScope, ControlTestWatchValue,
-  ControlTestWatchAddressOf, ControlTestWatchTypeCast: Pointer;
+  ControlTestWatchAddressOf, ControlTestWatchTypeCast,
+  ControlTestExpression: Pointer;
 
 procedure TTestWatches.RunToPause(var ABrk: TDBGBreakPoint);
 begin
@@ -615,6 +617,9 @@ procedure TTestWatches.TestWatchesValue;
     t.Add(AName, p+'Longint_3'+e,  weInteger(-20123456+n,            'Longint',  4));
     t.Add(AName, p+'Int64_3'+e,    weInteger(-9123372036854775801+n, 'Int64',    8));
 
+    t.Add(AName, p+'Bool1'+e,      weBool(False   ));
+    t.Add(AName, p+'Bool2'+e,      weBool(True    ));
+
     t.Add(AName, p+'Real'+e,       weFloat(50.25+n,                 'Real'       ));
     t.Add(AName, p+'Single'+e,     weSingle(100.125+n,              'Single'     ));
     t.Add(AName, p+'Double'+e,     weDouble(1000.125+n,             'Double'     ));
@@ -915,7 +920,9 @@ for i := StartIdx to t.Count-1 do
 
     t.Add(AName, p+'Set'+e, weSet(['EnVal2', 'EnVal4'], 'TSet')).Skip([stDwarf]);
 
-    t.Add(AName, p+'IntfUnknown'+e, weMatch('.?', skInterface)).Skip(); // only run eval / do not crash
+    t.Add(AName, p+'IntfUnknown1'+e, weMatch('.?', skInterface)) //.Skip(); // only run eval / do not crash
+      .SkipIf(ALoc = tlPointerAny);
+    t.Add(AName, p+'IntfUnknown'+e, weMatch('nil', skInterface)); //.Skip(); // only run eval / do not crash
 
 
 StartIdx := t.Count; // tlConst => Only eval the watch. No tests
@@ -948,7 +955,9 @@ begin
 
   try
     t := TWatchExpectationList.Create(Self);
-    t.AcceptSkSimple := [skInteger, skCardinal, skBoolean, skChar, skFloat, skString, skAnsiString, skCurrency, skVariant, skWideString];
+    t.AcceptSkSimple := [skInteger, skCardinal, skBoolean, skChar, skFloat,
+      skString, skAnsiString, skCurrency, skVariant, skWideString,
+      skInterface];
     t.AddTypeNameAlias('integer', 'integer|longint');
     t.AddTypeNameAlias('ShortStr255', 'ShortStr255|ShortString');
     t.AddTypeNameAlias('TEnumSub', 'TEnum|TEnumSub');
@@ -1623,7 +1632,9 @@ begin
   try
     t := TWatchExpectationList.Create(Self);
     t2 := TWatchExpectationList.Create(Self);
-    t.AcceptSkSimple := [skInteger, skCardinal, skBoolean, skChar, skFloat, skString, skAnsiString, skCurrency, skVariant, skWideString];
+    t.AcceptSkSimple := [skInteger, skCardinal, skBoolean, skChar, skFloat,
+      skString, skAnsiString, skCurrency, skVariant, skWideString,
+      skInterface];
     t.AddTypeNameAlias('integer', 'integer|longint');
     t.AddTypeNameAlias('ShortStr255', 'ShortStr255|ShortString');
     t.AddTypeNameAlias('TEnumSub', 'TEnum|TEnumSub');
@@ -1686,6 +1697,125 @@ begin
   end;
 end;
 
+procedure TTestWatches.TestWatchesExpression;
+
+  type
+    TTestLoc = (tlAny, tlConst, tlParam, tlArrayWrap, tlPointer, tlPointerAny);
+
+  procedure AddWatches(t: TWatchExpectationList; AName: String;
+    APrefix: String;  AOffs: Integer;  AChr1: Char;  APostFix: String;  ALoc: TTestLoc;
+    APrefix2: String; AOffs2: Integer; AChr12: Char; APostFix2: String; ALoc2: TTestLoc
+  );
+  var
+    p, e, p2, e2: String;
+    n, StartIdx, i, n2: Integer;
+  begin
+    p := APrefix;
+    e := APostFix;
+    n := AOffs;
+    p2 := APrefix2;
+    e2 := APostFix2;
+    n2 := AOffs2;
+
+    t.Add(AName, p+'Byte'+e +'='+ IntToStr(1+n),    weBool(True) );
+    t.Add(AName, p+'Byte'+e +'='+ p2+'Byte'+e2,     weBool(n=n2) );
+    t.Add(AName, p+'Byte'+e +'='+ p2+'Byte_2'+e2,   weBool(n+1=n2+240) );
+
+
+    t.Add(AName, p+'IntfUnknown'+e  +'='+ 'nil',              weBool(True) );
+    t.Add(AName, p+'IntfUnknown1'+e +'='+ 'nil',              weBool(False) )
+      .skipIf((ALoc in [tlConst]));
+    t.Add(AName, 'nil' +'='+ p+'IntfUnknown'+e ,              weBool(True) );
+    t.Add(AName, 'nil' +'='+ p+'IntfUnknown1'+e,              weBool(False) )
+      .skipIf((ALoc in [tlConst]));
+
+    t.Add(AName, p+'IntfUnknown'+e  +'='+ p2+'IntfUnknown'+e2,   weBool(True) );
+    t.Add(AName, p+'IntfUnknown1'+e +'='+ p2+'IntfUnknown1'+e2,  weBool(True) )
+      .skipIf((ALoc in [tlConst]) or (ALoc2 in [tlConst]));
+
+    t.Add(AName, p+'IntfUnknown'+e  +'='+ p2+'IntfUnknown2'+e2,   weBool(False) )
+      .skipIf((ALoc2 in [tlConst]));
+    t.Add(AName, p+'IntfUnknown1'+e +'='+ p2+'IntfUnknown2'+e2,  weBool(False) )
+      .skipIf((ALoc in [tlConst]) or (ALoc2 in [tlConst]));
+    t.Add(AName, p+'IntfUnknown2'+e +'='+ p2+'IntfUnknown2b'+e2, weBool(True) )
+      .skipIf((ALoc in [tlConst]) or (ALoc2 in [tlConst]));
+
+
+    t.Add(AName, p+'Instance0'+e +'='+ 'nil',               weBool(True) );
+    t.Add(AName, p+'Instance1'+e +'='+ 'nil',               weBool(False) )
+      .skipIf((ALoc in [tlConst]));
+
+    t.Add(AName, p+'Instance0'+e +'='+ p2+'Instance0'+e2,   weBool(True) )
+      .skipIf((ALoc2 in [tlConst]));
+    t.Add(AName, p+'Instance1'+e +'='+ p2+'Instance1'+e2,   weBool(True) )
+      .skipIf((ALoc in [tlConst]) or (ALoc2 in [tlConst]));
+
+    t.Add(AName, p+'Instance0'+e +'='+ p2+'Instance2'+e2,   weBool(False) )
+      .skipIf((ALoc2 in [tlConst]));
+    t.Add(AName, p+'Instance1'+e +'='+ p2+'Instance2'+e2,   weBool(False) )
+      .skipIf((ALoc in [tlConst]) or (ALoc2 in [tlConst]));
+    t.Add(AName, p+'Instance2'+e +'='+ p2+'Instance2b'+e2,  weBool(True) )
+      .skipIf((ALoc in [tlConst]) or (ALoc2 in [tlConst]));
+
+
+
+    for i := 0 to t.Count-1 do
+      t.Tests[i].IgnTypeName();
+  end;
+
+var
+  ExeName: String;
+  t: TWatchExpectationList;
+  Src: TCommonSource;
+  BrkPrg, BrkFoo, BrkFooVar, BrkFooConstRef: TDBGBreakPoint;
+begin
+  if SkipTest then exit;
+  if not TestControlCanTest(ControlTestExpression) then exit;
+  t := nil;
+
+  Src := GetCommonSourceFor('WatchesValuePrg.Pas');
+  TestCompile(Src, ExeName);
+
+  AssertTrue('Start debugger', Debugger.StartDebugger(AppDir, ExeName));
+
+  try
+    t := TWatchExpectationList.Create(Self);
+    t.AcceptSkSimple := [skInteger, skCardinal, skBoolean, skChar, skFloat,
+      skString, skAnsiString, skCurrency, skVariant, skWideString,
+      skInterface];
+    t.AddTypeNameAlias('integer', 'integer|longint');
+    t.AddTypeNameAlias('ShortStr255', 'ShortStr255|ShortString');
+    t.AddTypeNameAlias('TEnumSub', 'TEnum|TEnumSub');
+
+    BrkPrg         := Debugger.SetBreakPoint(Src, 'Prg');
+    //BrkFoo         := Debugger.SetBreakPoint(Src, 'Foo');
+    //BrkFooVar      := Debugger.SetBreakPoint(Src, 'FooVar');
+    //BrkFooConstRef := Debugger.SetBreakPoint(Src, 'FooConstRef');
+    AssertDebuggerNotInErrorState;
+
+    (* ************ Nested Functions ************* *)
+
+    RunToPause(BrkPrg);
+
+    t.Clear;
+    AddWatches(t, 'glob',   'gv', 001, 'B', '', tlAny,     'gv', 001, 'B', '', tlAny);
+    AddWatches(t, 'glob',   'gc', 000, 'A', '', tlConst,   'gv', 001, 'B', '', tlAny);
+    AddWatches(t, 'glob',   'gv', 001, 'B', '', tlAny,     'gc', 000, 'A', '', tlConst);
+    t.EvaluateWatches;
+    t.CheckResults;
+
+
+
+
+  finally
+    t.Free;
+    Debugger.ClearDebuggerMonitors;
+    Debugger.FreeDebugger;
+
+    AssertTestErrors;
+  end;
+end;
+
 
 initialization
   RegisterDbgTest(TTestWatches);
@@ -1694,6 +1824,7 @@ initialization
   ControlTestWatchValue     := TestControlRegisterTest('Value', ControlTestWatch);
   ControlTestWatchAddressOf := TestControlRegisterTest('AddressOf', ControlTestWatch);
   ControlTestWatchTypeCast  := TestControlRegisterTest('TypeCast', ControlTestWatch);
+  ControlTestExpression     := TestControlRegisterTest('Expression', ControlTestWatch);
 
 end.
 

components/lazdebuggers/lazdebugtestbase/testapps/WatchesValuePrg.pas

@@ -28,6 +28,7 @@ type
 var
   BreakDummy: PtrUInt;
   p: Pointer;
+  InterfacedObject, InterfacedObject2: TInterfacedObject;
 
 type
   TIntRange = -300..300;
@@ -210,7 +211,7 @@ begin  // TEST_BREAKPOINT=FooBegin
 
 (* INIT: local var  pointer <each type> *)
   TEST_PREPOCESS(WatchesValuePrgIdent.inc,pre__=fooloc_pl_, _OP_={, _O2_={, _pre3_=@fooloc, "//@@=} :=", _BLOCK_=TestVar, _BLOCK2_=TestPointer) //}
-  TEST_PREPOCESS(WatchesValuePrgIdent.inc,pre__=fooloc_pa_, _OP_={, _O2_={, _pre3_=@arg, "//@@=} :=", _BLOCK_=TestVar, _BLOCK2_=TestPointer) //}
+  TEST_PREPOCESS(WatchesValuePrgIdent.inc,pre__=fooloc_pa_, _OP_={, _O2_={, _pre3_=@arg, "//@@=} :=", _BLOCK_=TestArg, _BLOCK2_=TestPointer) //}
 
   BreakDummy:= 1; // TEST_BREAKPOINT=Foo
 end;
@@ -228,7 +229,7 @@ var
   TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=fooloc_pv_, "_OP_=: ^", (=;//, "_O2_=: ^", _EQ_=, _BLOCK_=TestVar, _BLOCK2_=TestPointer )
 begin // TEST_BREAKPOINT=FooVarBegin
 (* INIT: local var  pointer <each type> *)
-  TEST_PREPOCESS(WatchesValuePrgIdent.inc,pre__=fooloc_pv_, _OP_={, _O2_={, _pre3_=@argvar, "//@@=} :=", _BLOCK_=TestVar, _BLOCK2_=TestPointer) //}
+  TEST_PREPOCESS(WatchesValuePrgIdent.inc,pre__=fooloc_pv_, _OP_={, _O2_={, _pre3_=@argvar, "//@@=} :=", _BLOCK_=TestPointer, _BLOCK2_=TestArg) //}
 
   BreakDummy:= 1;
   BreakDummy:= 1; // TEST_BREAKPOINT=FooVar
@@ -253,6 +254,8 @@ end;
 begin
   // access constant that are not passed as function arg
   // so every constant is accessed, and they can not be optimized away
+  InterfacedObject:= TInterfacedObject.create;
+  InterfacedObject2:= TInterfacedObject.create;
   BreakDummy := ord(gcCharStatArray[1]);
   BreakDummy := ord(gcWCharStatArray[1]);
   p := nil;

components/lazdebuggers/lazdebugtestbase/testapps/WatchesValuePrgIdent.inc

@@ -28,6 +28,9 @@
   pre__Longint_3{e}     _OP_ Longint     (-20123456            + ADD);          //@@ _pre3_Longint_3;
   pre__Int64_3{e}       _OP_ Int64       (-9123372036854775801 + ADD);          //@@ _pre3_Int64_3;
 
+  pre__Bool1{e}         _OP_ Boolean     (False);          //@@ _pre3_Bool1;
+  pre__Bool2{e}         _OP_ Boolean     (True);           //@@ _pre3_Bool2;
+
   pre__Real{e}          _OP_ Real        (50.25                + ADD);          //@@ _pre3_Real;
   pre__Single{e}        _OP_ Single      (100.125              + ADD);          //@@ _pre3_Single;
   pre__Double{e}        _OP_ Double      (1000.125             + ADD);          //@@ _pre3_Double;
@@ -415,6 +418,7 @@
   {$ENDIF}
 
 
+  pre__Instance0{e} _O2_ TClass1 _EQ_ (nil);  //@@ _pre3_Instance0;
   pre__Instance1{e} _O2_ TClass1 _EQ_ (nil);  //@@ _pre3_Instance1;
   pre__Instance1_Int{e} _O2_ PtrUInt _EQ_ (0);    //@@ _pre3_Instance1_Int;
   {$IFDEF TestAssign}
@@ -428,6 +432,17 @@
   pre__Instance1_Int{e} _OP_ PtrUInt(pre__Instance1{e});    //@@ //}}
   {$ENDIF}
 
+  {$IFnDEF TestType}
+  {$IFnDEF TestArg}{$IFnDEF TestParam}
+  pre__Instance2{e} _O2_ TClass1 _EQ_ (nil);  //@@ _pre3_Instance2;
+  pre__Instance2b{e} _O2_ TClass1 _EQ_ (nil);  //@@ _pre3_Instance2b;
+  {$IFDEF TestAssign}
+  pre__Instance2{e} := TClass1.Create;    //@@
+  pre__Instance2b{e} := pre__Instance2{e};    //@@  // }}
+  {$ENDIF}
+  {$ENDIF}{$ENDIF}
+  {$ENDIF}
+
 
   pre__SomeFunc1Ref{e}    _O2_ TFunc1                 _EQ_      (nil); //@@ _pre3_SomeFunc1Ref;
   pre__SomeProc1Ref{e}    _O2_ TProc1                 _EQ_      (nil); //@@ _pre3_SomeProc1Ref;
@@ -439,7 +454,7 @@
   //pre__SomeMeth1Ref{e}    := @TMyBaseClass(nil).SomeMeth1; //@@
   {$ENDIF}
 
-
+// short bool ....
 // interface / object vs class / record
 // array dyn/stat / nested of record/class/char/num ... bitpacked
 // class of
@@ -451,6 +466,20 @@
 // self in instance / class
 
   pre__IntfUnknown{e} _OP_ IUnknown ( nil );          //@@ _pre3_IntfUnknown;
+  {$IFnDEF TestType}
+  pre__IntfUnknown1{e} _OP_ IUnknown ( nil );          //@@ _pre3_IntfUnknown1;
+  {$IFDEF TestAssign}
+  pre__IntfUnknown1{e}    := InterfacedObject as IUnknown; //@@
+  {$ENDIF}
+  {$IFnDEF TestArg}{$IFnDEF TestParam}  // reduce count of param...
+  pre__IntfUnknown2{e} _OP_ IUnknown ( nil );          //@@ _pre3_IntfUnknown2;
+  pre__IntfUnknown2b{e} _OP_ IUnknown ( nil );          //@@ _pre3_IntfUnknown2b;
+  {$IFDEF TestAssign}
+  pre__IntfUnknown2{e}    := InterfacedObject2 as IUnknown; //@@
+  pre__IntfUnknown2b{e}   := InterfacedObject2 as IUnknown; //@@
+  {$ENDIF}
+  {$ENDIF}{$ENDIF}
+  {$ENDIF}
 
 {$UNDEF _BLOCK_}
 {$UNDEF _BLOCK2_}

components/lazdebuggers/lazdebugtestbase/ttestwatchutilities.pas

@@ -13,7 +13,7 @@ uses
 
 type
   TWatchExpectationResultKind = (
-    rkMatch, rkInteger, rkCardinal, rkFloat, rkEnum, rkSet,
+    rkMatch, rkInteger, rkCardinal, rkFloat, rkBool, rkEnum, rkSet,
     rkChar, rkAnsiString, rkShortString, rkWideString, rkPointer, rkPointerAddr,
     rkClass, rkObject, rkRecord, rkInterface, rkField,
     rkStatArray, rkDynArray
@@ -104,6 +104,9 @@ type
       rkFloat: (
         ExpFloatValue: Extended;
       );
+      rkBool: (
+        ExpBoolValue: Boolean;
+      );
       rkPointerAddr: (
         ExpPointerValue: Pointer;
       );
@@ -215,6 +218,7 @@ type
 
     function CheckResultMatch(AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean; virtual;
     function CheckResultNum(AContext: TWatchExpTestCurrentData; IsCardinal: Boolean; AnIgnoreRsn: String): Boolean; virtual;
+    function CheckResultBool(AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean; virtual;
     function CheckResultFloat(AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean; virtual;
     function CheckResultEnum(AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean; virtual;
     function CheckResultSet(AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean; virtual;
@@ -277,6 +281,7 @@ function weSingle(AExpVal: Extended; ATypeName: String=#1): TWatchExpectationRes
 function weDouble(AExpVal: Extended; ATypeName: String=#1): TWatchExpectationResult;
 function weFloat(AExpVal: Extended; ATypeName: String=''): TWatchExpectationResult;
 
+function weBool(AExpVal: Boolean; ATypeName: String=#1): TWatchExpectationResult;
 function weEnum(AExpVal: string; ATypeName: String=#1): TWatchExpectationResult;
 function weSet(const AExpVal: Array of string; ATypeName: String=#1): TWatchExpectationResult;
 
@@ -435,6 +440,16 @@ begin
   Result.ExpFloatValue := AExpVal;
 end;
 
+function weBool(AExpVal: Boolean; ATypeName: String): TWatchExpectationResult;
+begin
+  Result := Default(TWatchExpectationResult);
+  if ATypeName = #1 then ATypeName := 'Boolean';
+  Result.ExpResultKind := rkBool;
+  Result.ExpSymKind := skBoolean;
+  Result.ExpTypeName := ATypeName;
+  Result.ExpBoolValue := AExpVal;
+end;
+
 function weEnum(AExpVal: string; ATypeName: String): TWatchExpectationResult;
 begin
   Result := Default(TWatchExpectationResult);
@@ -1208,6 +1223,7 @@ begin
     rkMatch:       Result := CheckResultMatch(AContext, AnIgnoreRsn);
     rkInteger:     Result := CheckResultNum(AContext, False, AnIgnoreRsn);
     rkCardinal:    Result := CheckResultNum(AContext, True, AnIgnoreRsn);
+    rkBool:        Result := CheckResultBool(AContext, AnIgnoreRsn);
     rkFloat:       Result := CheckResultFloat(AContext, AnIgnoreRsn);
     rkEnum:        Result := CheckResultEnum(AContext, AnIgnoreRsn);
     rkSet:         Result := CheckResultSet(AContext, AnIgnoreRsn);
@@ -1265,10 +1281,14 @@ begin
       s2 := 'skSimple';
     end;
 
-    if (t in [skRecord, skClass]) and (Expect.ExpSymKind = skObject) then begin
+    //if (t in [skRecord, skClass]) and (Expect.ExpSymKind = skObject) then begin
-      n := ' (skObject for '+s1+')';
+    //  n := ' (skObject for '+s1+')';
-      s1 := 'skObject';
+    //  s1 := 'skObject';
-    end;
+    //end;
+    //if (t in [skClass]) and (Expect.ExpSymKind = skInterface) then begin
+    //  n := ' (skInterface for '+s1+')';
+    //  s1 := 'skInterface';
+    //end;
 
     Result := TestEquals('SymbolType'+n, s2, s1, AContext, AnIgnoreRsn);
     //if ((s2='skClass') and (s = 'skRecord')) or ((s='skClass') and (s2 = 'skRecord')) then begin
@@ -1372,6 +1392,22 @@ begin
   end;
 end;
 
+function TWatchExpectationList.CheckResultBool(
+  AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean;
+var
+  Expect: TWatchExpectationResult;
+  s: String;
+begin
+  with AContext.WatchExp do begin
+    Result := True;
+    Expect := AContext.Expectation;
+
+    WriteStr(s, Expect.ExpBoolValue);
+    Result := TestEquals('Data', s, AContext.WatchVal.Value, False, AContext, AnIgnoreRsn);
+
+  end;
+end;
+
 function TWatchExpectationList.CheckResultFloat(
   AContext: TWatchExpTestCurrentData; AnIgnoreRsn: String): Boolean;
 var