paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-02 02:32:36 +02:00
Code Issues Packages Projects Releases Wiki Activity

FpDebug: tests

Browse Source 
git-svn-id: trunk@61784 -
This commit is contained in:
martin 2019-08-29 15:12:47 +00:00
parent a8ec28c709
commit 6cabb6cc74
4 changed files with 211 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

139
components/lazdebuggers/lazdebuggerfp/test/testwatches.pas
View File

@ -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.

7
components/lazdebuggers/lazdebugtestbase/testapps/WatchesValuePrg.pas
View File

@ -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;

31
components/lazdebuggers/lazdebugtestbase/testapps/WatchesValuePrgIdent.inc
View File

@ -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_}

46
components/lazdebuggers/lazdebugtestbase/ttestwatchutilities.pas
View File

@ -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
n := ' (skObject for '+s1+')';
s1 := 'skObject';
end;
//if (t in [skRecord, skClass]) and (Expect.ExpSymKind = skObject) then begin
// n := ' (skObject for '+s1+')';
// s1 := 'skObject';
//end;
//if (t in [skClass]) and (Expect.ExpSymKind = skInterface) then begin
// n := ' (skInterface for '+s1+')';
// s1 := 'skInterface';
//end;
Result := TestEquals('SymbolType'+n, s2, s1, AContext, AnIgnoreRsn);
//if ((s2='skClass') and (s = 'skRecord')) or ((s='skClass') and (s2 = 'skRecord')) then begin
@ -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