paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-23 01:39:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

DBG: Test

Browse Source 
git-svn-id: trunk@32206 -
This commit is contained in:
martin 2011-09-07 10:59:42 +00:00
parent 50521088ff
commit ce19a79765
11 changed files with 433 additions and 173 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
debugger/test/Gdbmi/TestApps/WatchesPrg.pas
View File

@ -5,7 +5,7 @@
program WatchesPrg;
type
{$DEFINE Global_Types}
{$DEFINE Global_Type}
{$DEFINE Global_Implementation}
@ -13,15 +13,15 @@
type
{$DEFINE FooFunc_LocalType}
var
{$DEFINE FooFunc_Local}
{$DEFINE FooFunc_LocalVar}
function SubFoo()():Integer;
type
{$DEFINE SubFooFunc_LocalType}
{$DEFINE Sub_FooFunc_LocalType}
var
{$DEFINE SubFooFunc_Local}
{$DEFINE Sub_FooFunc_LocalVar}
begin
{$DEFINE SubFooFunc_Body}
{$DEFINE Sub_FooFunc_Body}
end;
begin
@ -46,7 +46,7 @@ program WatchesPrg;
uses sysutils, variants, Classes {$IFDEF USE_W1} , unitw1 {$ENDIF};
type
{$DEFINE Global_Types}
{$DEFINE Global_Type}
{ class/record/object }
{$I WatchesPrgStruct.inc}
@ -64,7 +64,7 @@ type
{$I WatchesPrgProc.inc}
{$UNDEF Global_Types}
{$UNDEF Global_Type}
{$DEFINE Global_Implementation}
{ class/record/object }
@ -128,7 +128,7 @@ type
var
(*** local var ***)
{$DEFINE FooFunc_Local}
{$DEFINE FooFunc_LocalVar}
{ class/record/object }
{$I WatchesPrgStruct.inc}
{ strings }
@ -144,12 +144,12 @@ var
{ procedure/function/method }
{$I WatchesPrgProc.inc}
{$UNDEF FooFunc_Local}
{$UNDEF FooFunc_LocalVar}
function SubFoo(var AVal1: Integer; AVal2: Integer) : Integer;
type
(*** local type ***)
{$DEFINE SubFooFunc_LocalType}
{$DEFINE Sub_FooFunc_LocalType}
{ class/record/object }
{$I WatchesPrgStruct.inc}
{ strings }
@ -165,11 +165,11 @@ var
{ procedure/function/method }
{$I WatchesPrgProc.inc}
DummySubFooType12345 = Integer;
{$UNDEF SubFooFunc_LocalType}
{$UNDEF Sub_FooFunc_LocalType}
var
(*** local var ***)
{$DEFINE SubFooFunc_Local}
{$DEFINE Sub_FooFunc_LocalVar}
{ class/record/object }
{$I WatchesPrgStruct.inc}
{ strings }
@ -185,9 +185,9 @@ var
{ procedure/function/method }
{$I WatchesPrgProc.inc}
DummySubFooVar12345: Integer;
{$UNDEF SubFooFunc_Local}
{$UNDEF Sub_FooFunc_LocalVar}
begin
{$DEFINE SubFooFunc_Body}
{$DEFINE Sub_FooFunc_Body}
{ class/record/object }
{$I WatchesPrgStruct.inc}
{ strings }
@ -202,7 +202,7 @@ var
{$I WatchesPrgVariant.inc}
{ procedure/function/method }
{$I WatchesPrgProc.inc}
{$UNDEF SubFooFunc_Body}
{$UNDEF Sub_FooFunc_Body}
writeln(1); // nested break
end;

4
debugger/test/Gdbmi/TestApps/WatchesPrgArray.inc
View File

@ -4,7 +4,7 @@
//procedure FooFunc(
{$ENDIF}
{$IFDEF FooFunc_Local}
{$IFDEF FooFunc_LocalVar}
//var
VarArrayHelperI: Integer;
@ -103,7 +103,7 @@
{%endregion FooFunc}
{%region GLOBAL}
{$IFDEF Global_Types}
{$IFDEF Global_Type}
//type
TObjectInArray = class public foo: Integer; end;
TRecordInArray = record foo: Integer; end;

4
debugger/test/Gdbmi/TestApps/WatchesPrgEnum.inc
View File

@ -7,7 +7,7 @@
ArgSet: TSet; var VArgSet: TSet;
{$ENDIF}
{$IFDEF FooFunc_Local}
{$IFDEF FooFunc_LocalVar}
//var
VarEnumA: (e1,e2,e3);
VarEnumSetA: set of TEnum;
@ -23,7 +23,7 @@
{%endregion FooFunc}
{%region GLOBAL}
{$IFDEF Global_Types}
{$IFDEF Global_Type}
//type
TEnum = (One, Two, Three);
TEnumSet = set of TEnum;

4
debugger/test/Gdbmi/TestApps/WatchesPrgProc.inc
View File

@ -8,7 +8,7 @@
ArgObjFunction: TObjFunction; var VArgObjFunction: TObjFunction;
{$ENDIF}
{$IFDEF FooFunc_Local}
{$IFDEF FooFunc_LocalVar}
//var
VarProcedureA: procedure(a1: Integer; var a2: String);
VarFunctionA: function(a1: Integer; var a2: String): Integer;
@ -39,7 +39,7 @@
function TMethodHolderClass.FuncObjFuntion(a1: Integer; var a2: String): Integer; begin end;
{$ENDIF}
{$IFDEF Global_Types}
{$IFDEF Global_Type}
//type
TProcedure = procedure(a1: Integer; var a2: String);
TFunction = function(a1: Integer; var a2: String): Integer;

12
debugger/test/Gdbmi/TestApps/WatchesPrgSimple.inc
View File

@ -2,14 +2,14 @@
{* ******************** CACHE-TEST ******************** *}
{%region CACHE-TEST}
{%region TYPE}
{$IFDEF Global_Types}
{$IFDEF Global_Type}
TCacheTestType = class
public
CTVal: Integer;
end;
{$ENDIF}
{$IFDEF SubFooFunc_LocalType}
{$IFDEF Sub_FooFunc_LocalType}
TCacheTest = record
CTVal: Integer;
end;
@ -21,19 +21,19 @@
{%endregion TYPE}
{%region VARIABLES}
{$IFDEF SubFooFunc_Local}
{$IFDEF Sub_FooFunc_LocalVar}
VarCacheTest1: TCacheTest; // record
VarCacheTest2: Integer;
{$ENDIF}
{$IFDEF FooFunc_Local}
{$IFDEF FooFunc_LocalVar}
VarCacheTest1: TCacheTest; // class
VarCacheTest2: Integer;
{$ENDIF}
{%endregion VARIABLES}
{%region CODE (initilization)}
{$IFDEF SubFooFunc_Body}
{$IFDEF Sub_FooFunc_Body}
VarCacheTest1.CTVal := 101;
VarCacheTest2 := 102;
{$ENDIF}
@ -79,7 +79,7 @@
ArgExtended: Extended; var VArgExtended: Extended;
{$ENDIF}
{$IFDEF FooFunc_Local}
{$IFDEF FooFunc_LocalVar}
//var
VarByte: Byte;
VarWord: Word;

4
debugger/test/Gdbmi/TestApps/WatchesPrgString.inc
View File

@ -29,7 +29,7 @@
ArgPPMyString10: PPMyString10; var VArgPPMyString10: PPMyString10;
{$ENDIF}
{$IFDEF FooFunc_Local}
{$IFDEF FooFunc_LocalVar}
//var
VarTMyAnsiString: TMyAnsiString;
VarPMyAnsiString: PMyAnsiString;
@ -99,7 +99,7 @@
{%endregion FooFunc}
{%region GLOBAL}
{$IFDEF Global_Types}
{$IFDEF Global_Type}
//type
TMyAnsiString = AnsiString;
PMyAnsiString = ^TMyAnsiString;

267
debugger/test/Gdbmi/TestApps/WatchesPrgStruct.inc
View File

@ -1,14 +1,14 @@
(* Struture
program WatchesPrg;
type
{$DEFINE Global_Types}
{$DEFINE Global_Type}
{$DEFINE Global_Implementation}
procedure FooFunc( {$DEFINE FooFunc_Param} }
type
{$DEFINE FooFunc_LocalType}
var
{$DEFINE FooFunc_Local}
{$DEFINE FooFunc_LocalVar}
function SubFoo()():Integer; begin end;
begin
{$DEFINE FooFunc_Body}
@ -27,7 +27,7 @@
//TODO: globla/local const
{$IFDEF Global_Types}
{$IFDEF Global_Type}
//type
TFoo = class;
{$ENDIF}
@ -37,7 +37,7 @@
{%region RECORD}
{%region TYPE}
{$IFDEF Global_Types}
{$IFDEF Global_Type}
//type
PRec = ^TRec;
PPRec = ^PRec;
@ -89,7 +89,7 @@
GlobTNewRec, GlobTNewRec,
{$ENDIF}
{$IFDEF FooFunc_Local}
{$IFDEF FooFunc_LocalVar}
//var
{ records }
VarTRec: TRec;
@ -176,28 +176,117 @@
{%endregion RECORD}
{* ******************** CLASSES ******************** *}
{%region CLASSES TypeCast }
{%region TYPE}
{$IFDEF Global_Type}
//type
TClassTCast = class public b: Integer; end;
TClassTCastObject = class(TObject) public b: Integer; end;
TClassTCastComponent = class(TComponent) public b: Integer; end;
{$IFDEF USE_W1}
TClassTCastUW1 = class(TClassUW1Base) public b: Integer; end;
TClassTCastUW1Object = class(TClassUW1BaseObject) public b: Integer; end;
TClassTCastUW1Component = class(TClassUW1BaseComponent) public b: Integer; end;
{$ENDIF}
TClassTCast2 = class(TClassTCast) public c: Integer; end;
TClassTCast3 = type TClassTCast;
{$ENDIF}
{$IFDEF FooFunc_LocalVar}
// VarO..., VarNO... : TObject; // cast to real class
VarOTestTCast, VarOTestTCastObj, VarOTestTCastComp, VarOTestTCast2: TObject;
VarNOTestTCast, VarNOTestTCastObj, VarNOTestTCastComp, VarNOTestTCast2: TObject; // nil
{$IFDEF USE_W1}
VarOTestTCastUW1, VarOTestTCastUW1Obj, VarOTestTCastUW1Comp: TObject;
VarNOTestTCastUW1, VarNOTestTCastUW1Obj, VarNOTestTCastUW1Comp: TObject; // nil
{$ENDIF}
// VarC..., VarNC...: TComponent; // cast to real class OR object
VarCTestTCastComp, VarNCTestTCastComp: TComponent;
{$IFDEF USE_W1}
VarCTestTCastUW1Comp, VarNCTestTCastUW1Comp: TComponent;
{$ENDIF}
// VarB.., VarBN...: TBase;
VarBTestTCast2, VarBNTestTCast2: TClassTCast;
// Var.., VarN...: TRealType; // cast to lower class
VarTestTCast, VarNTestTCast: TClassTCast;
VarTestTCastObj, VarNTestTCastObj: TClassTCastObject;
VarTestTCastComp, VarNTestTCastComp: TClassTCastComponent;
VarTestTCast2, VarNTestTCast2: TClassTCast2;
VarTestTCast3, VarNTestTCast3: TClassTCast3;
{$IFDEF USE_W1}
VarUTestTCastUW1, VarNUTestTCastUW1: TClassUW1Base;
VarUTestTCastUW1Obj, VarNUTestTCastUW1Obj: TClassUW1BaseObject;
VarUTestTCastUW1Comp, VarNUTestTCastUW1Comp: TClassUW1BaseComponent;
VarTestTCastUW1, VarNTestTCastUW1: TClassTCastUW1;
VarTestTCastUW1Obj, VarNTestTCastUW1Obj: TClassTCastUW1Object;
VarTestTCastUW1Comp, VarNTestTCastUW1Comp: TClassTCastUW1Component;
{$ENDIF}
{$ENDIF}
{$IFDEF FooFunc_Body}
VarOTestTCast := TClassTCast.Create;
VarOTestTCastObj := TClassTCastObject.Create;
VarOTestTCastComp := TClassTCastComponent.Create(nil);
VarOTestTCast2 := TClassTCast.Create;
VarNOTestTCast := nil;
VarNOTestTCastObj := nil;
VarNOTestTCastComp := nil;
VarNOTestTCast2 := nil;
{$IFDEF USE_W1}
VarOTestTCastUW1 := TClassTCastUW1.Create;
VarOTestTCastUW1Obj := TClassTCastUW1Object.Create;
VarOTestTCastUW1Comp := TClassTCastUW1Component.Create(nil);
VarNOTestTCastUW1 := nil;
VarNOTestTCastUW1Obj := nil;
VarNOTestTCastUW1Comp := nil;
{$ENDIF}
VarCTestTCastComp := TClassTCastComponent.Create(nil);
VarNCTestTCastComp := nil;
{$IFDEF USE_W1}
VarCTestTCastUW1Comp := TClassTCastUW1Component.Create(nil);
VarNCTestTCastUW1Comp := nil;
{$ENDIF}
VarBTestTCast2 := TClassTCast2.Create;
VarBNTestTCast2 := nil;
VarTestTCast := TClassTCast.Create;
VarNTestTCast := nil;
VarTestTCastObj := TClassTCastObject.Create;
VarNTestTCastObj := nil;
VarTestTCastComp := TClassTCastComponent.Create(nil);
VarNTestTCastComp := nil;
VarTestTCast2 := TClassTCast2.Create;
VarNTestTCast2 := nil;
VarTestTCast3 := TClassTCast3.Create;
VarNTestTCast3 := nil;
{$IFDEF USE_W1}
VarUTestTCastUW1 := TClassTCastUW1.Create;
VarNUTestTCastUW1 := nil;
VarUTestTCastUW1Obj := TClassTCastUW1Object.Create;
VarNUTestTCastUW1Obj := nil;
VarUTestTCastUW1Comp := TClassTCastUW1Component.Create(nil);
VarNUTestTCastUW1Comp := nil;
VarTestTCastUW1 := TClassTCastUW1.Create;
VarNTestTCastUW1 := nil;
VarTestTCastUW1Obj := TClassTCastUW1Object.Create;
VarNTestTCastUW1Obj := nil;
VarTestTCastUW1Comp := TClassTCastUW1Component.Create(nil);
VarNTestTCastUW1Comp := nil;
{$ENDIF}
{$ENDIF}
{%endregion CLASSES TypeCast}
{%region CLASSES}
{%region TYPE}
{$IFDEF Global_Types}
//type
{ Classes }
TFooComp = class(TComponent)
public
ValueInt: Integer;
end;
{$IFDEF USE_W1}
TFooCompOtherBase = class(TFooTestTestBase)
{$ELSE}
TFooCompOtherBase = class(TObject)
{$ENDIF}
public
ValueInt: Integer;
end;
{ TFoo }
{$IFDEF Global_Type}
TFoo = class
private
function GetValueInt: Integer;
@ -226,6 +315,20 @@
PNewFoo = ^TNewFoo;
{$ENDIF}
{$IFDEF Global_Implementation}
{ TFoo }
function TFoo.GetValueInt: Integer;
begin
Result := PropInt;
end;
procedure TFoo.SetValueInt(AValue: Integer);
begin
PropInt := AValue;
end;
{$ENDIF}
{$IFDEF FooFunc_LocalType}
//type
{$ENDIF}
@ -233,6 +336,16 @@
{%region VARIABLES}
{$IFDEF FooFunc_Param}
{ Classes }
ArgTFoo: TFoo; var VArgTFoo: TFoo;
ArgPFoo: PFoo; var VArgPFoo: PFoo;
ArgPPFoo: PPFoo; var VArgPPFoo: PPFoo;
ArgTSamePFoo: TSamePFoo; var VArgTSamePFoo: TSamePFoo;
ArgTNewPFoo: TNewPFoo; var VArgTNewPFoo: TNewPFoo;
ArgTSameFoo: TSameFoo; var VArgTSameFoo: TSameFoo;
ArgTNewFoo: TNewFoo; var VArgTNewFoo: TNewFoo;
ArgPNewFoo: PNewFoo; var VArgPNewFoo: PNewFoo;
{$ENDIF}
{$IFDEF Global_Call_FooFunc}
//FooFunc(
@ -248,8 +361,23 @@
GlobPNewFoo, GlobPNewFoo,
{$ENDIF}
{$IFDEF FooFunc_Local}
//var
{$IFDEF FooFunc_LocalVar}
//var
{ Classes }
VarTFoo: TFoo;
VarPFoo: PFoo;
VarPPFoo: PPFoo;
VarTSamePFoo: TSamePFoo;
VarTNewPFoo: TNewPFoo;
VarTSameFoo: TSameFoo;
VarTNewFoo: TNewFoo;
VarPNewFoo: PNewFoo;
PVarTFoo: ^TFoo;
PVarPFoo: ^PFoo;
PVarTSamePFoo: ^TSamePFoo;
PVarTSameFoo: ^TSameFoo;
{$ENDIF}
{$IFDEF Global_Var}
@ -270,25 +398,26 @@
PGlobTSamePFoo: ^TSamePFoo;
PGlobTSameFoo: ^TSameFoo;
{$ENDIF}
{$IFDEF Global_Implementation}
{ TFoo }
function TFoo.GetValueInt: Integer;
begin
Result := PropInt;
end;
procedure TFoo.SetValueInt(AValue: Integer);
begin
PropInt := AValue;
end;
{$ENDIF}
{%endregion VARIABLES}
{%region CODE (initilization)}
{$IFDEF FooFunc_Body}
//begin
//begin
{ Classes }
VarTFoo := ArgTFoo;
VarPFoo := ArgPFoo;
VarPPFoo := ArgPPFoo;
VarTSamePFoo := ArgTSamePFoo;
VarTNewPFoo := ArgTNewPFoo;
VarTSameFoo := ArgTSameFoo;
VarTNewFoo := ArgTNewFoo;
VarPNewFoo := ArgPNewFoo;
PVarTFoo := @ArgTFoo;
PVarPFoo := @ArgPFoo;
PVarTSamePFoo := @ArgTSamePFoo;
PVarTSameFoo := @ArgTSameFoo;
{$ENDIF}
{$IFDEF Global_Body}
@ -344,17 +473,6 @@
{%region FooFunc}
{$IFDEF FooFunc_Param}
//procedure FooFunc(
{ Classes }
ArgTFoo: TFoo; var VArgTFoo: TFoo;
ArgPFoo: PFoo; var VArgPFoo: PFoo;
ArgPPFoo: PPFoo; var VArgPPFoo: PPFoo;
ArgTSamePFoo: TSamePFoo; var VArgTSamePFoo: TSamePFoo;
ArgTNewPFoo: TNewPFoo; var VArgTNewPFoo: TNewPFoo;
ArgTSameFoo: TSameFoo; var VArgTSameFoo: TSameFoo;
ArgTNewFoo: TNewFoo; var VArgTNewFoo: TNewFoo;
ArgPNewFoo: PNewFoo; var VArgPNewFoo: PNewFoo;
{ ClassesTyps }
ArgTFooClass: TFooClass; var VArgTFooClass: TFooClass;
ArgPFooClass: PFooClass; var VArgPFooClass: PFooClass;
@ -363,24 +481,8 @@
ArgPNewFooClass: PNewFooClass; var VArgPNewFooClass: PNewFooClass;
{$ENDIF}
{$IFDEF FooFunc_Local}
{$IFDEF FooFunc_LocalVar}
//var
{ Classes }
VarTFoo: TFoo;
VarPFoo: PFoo;
VarPPFoo: PPFoo;
VarTSamePFoo: TSamePFoo;
VarTNewPFoo: TNewPFoo;
VarTSameFoo: TSameFoo;
VarTNewFoo: TNewFoo;
VarPNewFoo: PNewFoo;
PVarTFoo: ^TFoo;
PVarPFoo: ^PFoo;
PVarTSamePFoo: ^TSamePFoo;
PVarTSameFoo: ^TSameFoo;
{ ClassesTyps }
VarTFooClass: TFooClass;
VarPFooClass: PFooClass;
@ -390,31 +492,12 @@
PVarTFooClass: ^TFooClass;
VarFooComp, VarFooComp1: TObject; // TFooComp;
VarFooOther, VarFooOther1: TObject; // TFooCompOtherBase;
{ OBJECT }
VarOldObject: TOldObject;
{$ENDIF}
{$IFDEF FooFunc_Body}
//begin
{ Classes }
VarTFoo := ArgTFoo;
VarPFoo := ArgPFoo;
VarPPFoo := ArgPPFoo;
VarTSamePFoo := ArgTSamePFoo;
VarTNewPFoo := ArgTNewPFoo;
VarTSameFoo := ArgTSameFoo;
VarTNewFoo := ArgTNewFoo;
VarPNewFoo := ArgPNewFoo;
PVarTFoo := @ArgTFoo;
PVarPFoo := @ArgPFoo;
PVarTSamePFoo := @ArgTSamePFoo;
PVarTSameFoo := @ArgTSameFoo;
{ ClassesTypes }
VarTFooClass := ArgTFooClass;
VarPFooClass := ArgPFooClass;
@ -426,18 +509,12 @@
{ OBJECT }
VarOldObject.OldVal := 1;
VarFooComp := TFooComp.Create(nil);
VarFooComp1 := nil;
VarFooOther := TFooCompOtherBase.Create;
VarFooOther1 := nil;
{$ENDIF}
{%endregion FooFunc}
{%region GLOBAL}
{$IFDEF Global_Types}
{$IFDEF Global_Type}
{ ClassesTypes }
TFooClass = Class of TFoo;
PFooClass = ^TFooClass;

4
debugger/test/Gdbmi/TestApps/WatchesPrgVariant.inc
View File

@ -6,7 +6,7 @@
ArgVariantString: Variant; var VArgVariantString: Variant;
{$ENDIF}
{$IFDEF FooFunc_Local}
{$IFDEF FooFunc_LocalVar}
//var
{$ENDIF}
@ -16,7 +16,7 @@
{%endregion FooFunc}
{%region GLOBAL}
{$IFDEF Global_Types}
{$IFDEF Global_Type}
//type
{$ENDIF}

15
debugger/test/Gdbmi/TestApps/u1/unitw1.pas
View File

@ -4,8 +4,21 @@ unit unitw1;
interface
uses classes;
type
TFooTestTestBase = class
TClassUW1Base = class
public
a: integer;
end;
TClassUW1BaseObject = class(TObject)
public
a: integer;
end;
TClassUW1BaseComponent = class(TComponent)
public
a: integer;
end;

8
debugger/test/Gdbmi/testgdbmicontrol.pas
View File

@ -56,6 +56,14 @@ begin
CheckListBox1.Checked[j] := True;
j := CheckListBox1.Items.Add('TTestWatch');
CheckListBox1.Checked[j] := True;
j := CheckListBox1.Items.Add('TTestWatch.Gdb');
CheckListBox1.Checked[j] := True;
j := CheckListBox1.Items.Add('TTestWatch.All');
CheckListBox1.Checked[j] := True;
j := CheckListBox1.Items.Add('TTestWatch.Mix');
CheckListBox1.Checked[j] := True;
j := CheckListBox1.Items.Add('TTestWatch.Cache');
CheckListBox1.Checked[j] := True;
j := CheckListBox1.Items.Add('TTestBreakPoint');
CheckListBox1.Checked[j] := True;

254
debugger/test/Gdbmi/testwatches.pas
View File

@ -38,6 +38,7 @@ type
TWatchExpectationFlags = set of TWatchExpectationFlag;
TWatchExpectation = record
TestName: String;
Expression: string;
DspFormat: TWatchDisplayFormat;
StackFrame: Integer;
@ -70,6 +71,12 @@ type
AFlgs: TWatchExpectationFlags = [];
AStackFrame: Integer = 0
);
procedure AddTo(var ExpArray: TWatchExpectationArray; ATestName: String;
AnExpr: string; AFmt: TWatchDisplayFormat;
AMtch: string; AKind: TDBGSymbolKind; ATpNm: string;
AFlgs: TWatchExpectationFlags = [];
AStackFrame: Integer = 0
);
procedure AddExpectBreakFooGdb;
procedure AddExpectBreakFooAll;
@ -118,6 +125,16 @@ begin
If AValFoo <> '' then Result := Result + ',.* valfoo = '+AValFoo;
end;
function MatchClass(TypeName: String; AContent: String = ''): String;
begin
Result := '<'+TypeName+'> = \{.*(vptr\$|<TObject>).+'+AContent;
end;
function MatchClassNil(TypeName: String): String;
begin
Result := '<'+TypeName+'> = nil';
end;
{ TTestWatches }
procedure TTestWatches.ClearAllTestArrays;
@ -133,6 +150,24 @@ procedure TTestWatches.AddTo(var ExpArray: TWatchExpectationArray; AnExpr: strin
begin
SetLength(ExpArray, Length(ExpArray)+1);
with ExpArray[Length(ExpArray)-1] do begin
TestName := AnExpr;
Expression := AnExpr;
DspFormat := AFmt;
ExpMatch := AMtch;
ExpKind := AKind;
ExpTypeName := ATpNm;
Flgs := AFlgs;
StackFrame := AStackFrame;
end;
end;
procedure TTestWatches.AddTo(var ExpArray: TWatchExpectationArray; ATestName: String;
AnExpr: string; AFmt: TWatchDisplayFormat; AMtch: string; AKind: TDBGSymbolKind;
ATpNm: string; AFlgs: TWatchExpectationFlags; AStackFrame: Integer);
begin
SetLength(ExpArray, Length(ExpArray)+1);
with ExpArray[Length(ExpArray)-1] do begin
TestName := ATestName;
Expression := AnExpr;
DspFormat := AFmt;
ExpMatch := AMtch;
@ -150,6 +185,7 @@ procedure TTestWatches.AddExpectBreakFooGdb;
AddTo(ExpectBreakFooGdb,AnExpr, AFmt, AMtch, AKind, ATpNm, AFlgs )
end;
begin
if not TestControlForm.CheckListBox1.Checked[TestControlForm.CheckListBox1.Items.IndexOf('TTestWatch.Gdb')] then exit;
Add('ptype ArgTFoo', wdfDefault, 'type = \^TFoo = class : PUBLIC TObject', skClass, '', []);
Add('ptype ArgTFoo^', wdfDefault, 'type = TFoo = class : PUBLIC TObject', skClass, '', []);
@ -168,7 +204,14 @@ procedure TTestWatches.AddExpectBreakFooAll;
begin
AddTo(ExpectBreakFoo, AnExpr, AFmt, AMtch, AKind, ATpNm, AFlgs )
end;
var
NoStatIntArray: Boolean;
begin
if not TestControlForm.CheckListBox1.Checked[TestControlForm.CheckListBox1.Items.IndexOf('TTestWatch.All')] then exit;
// GDB 7.0 with fpc 2.4.x has issues with "array of int"
NoStatIntArray := (pos('2.4.', CompilerInfo.Name) > 0) and (DebuggerInfo.Version = 70000);
{%region * records * }
// Foo(var XXX: PRecord); DWARF has problems with the implicit pointer for "var"
@ -458,6 +501,7 @@ begin
skSimple, 'TDynIntArray',
[]);
//TODO add () around list
if not NoStatIntArray then
Add('VarStatIntArray', wdfDefault, '10,[\s\r\n]+12,[\s\r\n]+14,[\s\r\n]+16,[\s\r\n]+18',
skSimple, 'TStatIntArray',
[]);
@ -470,6 +514,7 @@ begin
Add('VarDynIntArrayA', wdfDefault, Match_Pointer+'|\{\}|0,[\s\r\n]+2',
skSimple, '',
[]);
if not NoStatIntArray then
Add('VarStatIntArrayA', wdfDefault, '10,[\s\r\n]+12,[\s\r\n]+14,[\s\r\n]+16,[\s\r\n]+18',
skSimple, '',
[]);
@ -542,16 +587,126 @@ begin
end;
procedure TTestWatches.AddExpectBreakFooMixInfo;
procedure Add(AnExpr: string; AFmt: TWatchDisplayFormat;
procedure Add(AName, AnExpr: string; AFmt: TWatchDisplayFormat;
AMtch: string; AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags);
begin
AddTo(ExpectBreakFoo, AnExpr, AFmt, AMtch, AKind, ATpNm, AFlgs )
AddTo(ExpectBreakFoo, AName, AnExpr, AFmt, AMtch, AKind, ATpNm, AFlgs )
end;
procedure AddTC(AVar, ATCast: string; AExpClass: String = ''; AFlgs: TWatchExpectationFlags = []);
begin
if AExpClass = '' then AExpClass := ATCast;
If ATCast <> ''
then Add('',ATCast+'('+AVar+')', wdfDefault, MatchClass(AExpClass, ''), skClass, AExpClass, AFlgs)
else Add('',AVar, wdfDefault, MatchClass(AExpClass, ''), skClass, AExpClass, AFlgs);
end;
procedure AddTCN(AVar, ATCast: string; AExpClass: String = ''; AFlgs: TWatchExpectationFlags = []);
begin
if AExpClass = '' then AExpClass := ATCast;
If ATCast <> ''
then Add('',ATCast+'('+AVar+')', wdfDefault, MatchClassNil(AExpClass), skClass, AExpClass, AFlgs)
else Add('',AVar, wdfDefault, MatchClassNil(AExpClass), skClass, AExpClass, AFlgs);
end;
begin
if not TestControlForm.CheckListBox1.Checked[TestControlForm.CheckListBox1.Items.IndexOf('TTestWatch.Mix')] then exit;
// Type Casting objects with mixed symbol type
AddTC('VarOTestTCast', '', 'TObject');
AddTC('VarOTestTCast', 'TObject', '');
AddTC('VarOTestTCast', 'TClassTCast', '');
AddTC('VarOTestTCast', 'TClassTCast3', 'TClassTCast(3)?', [fTpMtch]);
AddTC('VarOTestTCastObj', '', 'TObject');
AddTC('VarOTestTCastObj', 'TObject', '');
AddTC('VarOTestTCastObj', 'TClassTCastObject', '');
AddTC('VarOTestTCastComp', '', 'TObject');
AddTC('VarOTestTCastComp', 'TObject', '');
AddTC('VarOTestTCastComp', 'TComponent', '');
AddTC('VarOTestTCastComp', 'TClassTCastComponent', '');
AddTC('VarOTestTCast2', '', 'TObject');
AddTC('VarOTestTCast2', 'TObject', '');
AddTC('VarOTestTCast2', 'TClassTCast', '');
AddTC('VarOTestTCast2', 'TClassTCast2', '');
AddTC('VarOTestTCastUW1', '', 'TObject');
AddTC('VarOTestTCastUW1', 'TObject', '');
AddTC('VarOTestTCastUW1', 'TClassUW1Base', '');
AddTC('VarOTestTCastUW1', 'TClassTCastUW1', '');
AddTC('VarOTestTCastUW1Obj', '', 'TObject');
AddTC('VarOTestTCastUW1Obj', 'TObject', '');
AddTC('VarOTestTCastUW1Obj', 'TClassUW1BaseObject', '');
AddTC('VarOTestTCastUW1Obj', 'TClassTCastUW1Object', '');
AddTC('VarOTestTCastUW1Comp', '', 'TObject');
AddTC('VarOTestTCastUW1Comp', 'TObject', '');
AddTC('VarOTestTCastUW1Comp', 'TComponent', '');
AddTC('VarOTestTCastUW1Comp', 'TClassUW1BaseComponent', '');
AddTC('VarOTestTCastUW1Comp', 'TClassTCastUW1Component', '');
AddTC('VarCTestTCastComp', '', 'TComponent');
AddTC('VarCTestTCastComp', 'TObject', '');
AddTC('VarCTestTCastComp', 'TComponent', '');
AddTC('VarCTestTCastComp', 'TClassTCast', '');
AddTC('VarCTestTCastUW1Comp', '', 'TComponent');
AddTC('VarCTestTCastUW1Comp', 'TObject', '');
AddTC('VarCTestTCastUW1Comp', 'TComponent', '');
AddTC('VarCTestTCastUW1Comp', 'TClassUW1BaseComponent', '');
AddTC('VarCTestTCastUW1Comp', 'TClassTCastUW1Component', '');
AddTC('VarTestTCast', '', 'TClassTCast');
AddTC('VarTestTCast', 'TObject', '');
AddTC('VarTestTCast', 'TClassTCast', '');
AddTC('VarTestTCast', 'TClassTCast3', 'TClassTCast(3)?', [fTpMtch]);
AddTC('VarTestTCastObj', '', 'TClassTCastObject');
AddTC('VarTestTCastObj', 'TObject', '');
AddTC('VarTestTCastObj', 'TClassTCastObject', '');
AddTC('VarTestTCastComp', '', 'TClassTCastComponent');
AddTC('VarTestTCastComp', 'TObject', '');
AddTC('VarTestTCastComp', 'TComponent', '');
AddTC('VarTestTCastComp', 'TClassTCastComponent', '');
AddTC('VarTestTCast2', '', 'TClassTCast2');
AddTC('VarTestTCast2', 'TObject', '');
AddTC('VarTestTCast2', 'TClassTCast', '');
AddTC('VarTestTCast2', 'TClassTCast2', '');
AddTC('VarTestTCast3', '', 'TClassTCast(3)?', [fTpMtch]);
AddTC('VarTestTCast3', 'TObject', '');
AddTC('VarTestTCast3', 'TClassTCast', '');
AddTC('VarTestTCastUW1', '', 'TClassTCastUW1');
AddTC('VarTestTCastUW1', 'TObject', '');
AddTC('VarTestTCastUW1', 'TClassUW1Base', '');
AddTC('VarTestTCastUW1', 'TClassTCastUW1', '');
AddTC('VarTestTCastUW1Obj', '', 'TClassTCastUW1Object');
AddTC('VarTestTCastUW1Obj', 'TObject', '');
AddTC('VarTestTCastUW1Obj', 'TClassUW1BaseObject', '');
AddTC('VarTestTCastUW1Obj', 'TClassTCastUW1Object', '');
AddTC('VarTestTCastUW1Comp', '', 'TClassTCastUW1Component');
AddTC('VarTestTCastUW1Comp', 'TObject', '');
AddTC('VarTestTCastUW1Comp', 'TComponent', '');
AddTC('VarTestTCastUW1Comp', 'TClassUW1BaseComponent', '');
AddTC('VarTestTCastUW1Comp', 'TClassTCastUW1Component', '');
AddTCN('VarNOTestTCast', '', 'TObject');
AddTCN('VarNOTestTCast', 'TObject', '');
AddTCN('VarNOTestTCast', 'TClassTCast', '');
AddTCN('VarNOTestTCast', 'TClassTCast3', 'TClassTCast(3)?', [fTpMtch]);
// MIXED symbol info types
Add('VarFooOther', wdfDefault, '<TObject>', skClass, 'TObject', []);
Add('TFooTestTestBase(VarFooOther)', wdfDefault, '<TFooTestTestBase>', skClass, 'TFooTestTestBase', []);
Add('VarStatIntArray', wdfDefault, '10,[\s\r\n]+12,[\s\r\n]+14,[\s\r\n]+16,[\s\r\n]+18',
Add('', 'VarStatIntArray', wdfDefault, '10,[\s\r\n]+12,[\s\r\n]+14,[\s\r\n]+16,[\s\r\n]+18',
skSimple, 'TStatIntArray',
[]);
end;
@ -570,6 +725,7 @@ procedure TTestWatches.AddExpectBreakFooAndSubFoo;
AddTo(ExpectBreakSubFoo, AnExpr, AFmt, AMtch, AKind, ATpNm, AFlgs, AStackFrame)
end;
begin
if not TestControlForm.CheckListBox1.Checked[TestControlForm.CheckListBox1.Items.IndexOf('TTestWatch.Cache')] then exit;
AddS('VarCacheTest1', wdfDefault, MatchRecord('TCacheTest', 'CTVal = 101'),
skRecord, 'TCacheTest', []);
AddF('VarCacheTest1', wdfDefault, '<TCacheTest(Type)?> = \{.*(<|vptr\$)TObject>?.+CTVal = 201',
@ -622,11 +778,14 @@ procedure TTestWatches.RunTestWatches(NamePreFix: String; TestExeName, ExtraOpts
flag: Boolean;
WV: TWatchValue;
Stack: Integer;
n: String;
begin
rx := nil;
Stack := Data.StackFrame;
Name := Name + ' ' + Data.Expression + ' (' + TWatchDisplayFormatNames[Data.DspFormat] + ')';
n := Data.TestName;
if n = '' then n := Data.Expression + ' (' + TWatchDisplayFormatNames[Data.DspFormat] + ')';
Name := Name + ' ' + n;
flag := AWatch <> nil;
if flag then begin;
WV := AWatch.Values[1, Stack];// trigger read
@ -777,60 +936,63 @@ begin
AddExpectBreakFooAndSubFoo;
RunTestWatches('', TestExeName, '', []);
ClearAllTestArrays;
AddExpectBreakFooMixInfo;
with UsedUnits do begin
DirName:= AppDir + 'u1\unitw1.pas';
ExeId:= '';
SymbolType:= stNone;
ExtraOpts:= '';
NamePostFix:= ''
end;
RunTestWatches('unitw1=none', TestExeName, '-dUSE_W1', [UsedUnits]);
if (stStabs in CompilerInfo.SymbolTypes) and (stStabs in DebuggerInfo.SymbolTypes)
if TestControlForm.CheckListBox1.Checked[TestControlForm.CheckListBox1.Items.IndexOf('TTestWatch.Mix')]
then begin
ClearAllTestArrays;
AddExpectBreakFooMixInfo;
with UsedUnits do begin
DirName:= AppDir + 'u1\unitw1.pas';
ExeId:= '';
SymbolType:= stStabs;
SymbolType:= stNone;
ExtraOpts:= '';
NamePostFix:= ''
end;
RunTestWatches('unitw1=stabs', TestExeName, '-dUSE_W1', [UsedUnits]);
end;
RunTestWatches('unitw1=none', TestExeName, '-dUSE_W1', [UsedUnits]);
if (stDwarf in CompilerInfo.SymbolTypes) and (stDwarf in DebuggerInfo.SymbolTypes)
then begin
ClearAllTestArrays;
AddExpectBreakFooMixInfo;
with UsedUnits do begin
DirName:= AppDir + 'u1\unitw1.pas';
ExeId:= '';
SymbolType:= stDwarf;
ExtraOpts:= '';
NamePostFix:= ''
if (stStabs in CompilerInfo.SymbolTypes) and (stStabs in DebuggerInfo.SymbolTypes)
then begin
ClearAllTestArrays;
AddExpectBreakFooMixInfo;
with UsedUnits do begin
DirName:= AppDir + 'u1\unitw1.pas';
ExeId:= '';
SymbolType:= stStabs;
ExtraOpts:= '';
NamePostFix:= ''
end;
RunTestWatches('unitw1=stabs', TestExeName, '-dUSE_W1', [UsedUnits]);
end;
RunTestWatches('unitw1=dwarf', TestExeName, '-dUSE_W1', [UsedUnits]);
end;
if (stDwarf3 in CompilerInfo.SymbolTypes) and (stDwarf3 in DebuggerInfo.SymbolTypes)
then begin
ClearAllTestArrays;
AddExpectBreakFooMixInfo;
with UsedUnits do begin
DirName:= AppDir + 'u1\unitw1.pas';
ExeId:= '';
SymbolType:= stDwarf3;
ExtraOpts:= '';
NamePostFix:= ''
if (stDwarf in CompilerInfo.SymbolTypes) and (stDwarf in DebuggerInfo.SymbolTypes)
then begin
ClearAllTestArrays;
AddExpectBreakFooMixInfo;
with UsedUnits do begin
DirName:= AppDir + 'u1\unitw1.pas';
ExeId:= '';
SymbolType:= stDwarf;
ExtraOpts:= '';
NamePostFix:= ''
end;
RunTestWatches('unitw1=dwarf', TestExeName, '-dUSE_W1', [UsedUnits]);
end;
RunTestWatches('unitw1=dwarf_3', TestExeName, '-dUSE_W1', [UsedUnits]);
end;
if (stDwarf3 in CompilerInfo.SymbolTypes) and (stDwarf3 in DebuggerInfo.SymbolTypes)
then begin
ClearAllTestArrays;
AddExpectBreakFooMixInfo;
with UsedUnits do begin
DirName:= AppDir + 'u1\unitw1.pas';
ExeId:= '';
SymbolType:= stDwarf3;
ExtraOpts:= '';
NamePostFix:= ''
end;
RunTestWatches('unitw1=dwarf_3', TestExeName, '-dUSE_W1', [UsedUnits]);
end;
end;
AssertTestErrors;
end;