paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-30 01:29:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

DBG: Tests

Browse Source 
git-svn-id: trunk@32650 -
This commit is contained in:
martin 2011-10-03 11:35:34 +00:00
parent 746a1deaa7
commit 9d45bfaa7e
10 changed files with 155 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -2824,6 +2824,8 @@ debugger/test/Gdbmi/TestApps/u1/unitw1.pas svneol=native#text/pascal
debugger/test/Gdbmi/TestGdbmi.lpi svneol=native#text/pascal
debugger/test/Gdbmi/TestGdbmi.lpr svneol=native#text/pascal
debugger/test/Gdbmi/compilehelpers.pas svneol=native#text/pascal
debugger/test/Gdbmi/fpclist.txt.sample svneol=native#text/plain
debugger/test/Gdbmi/gdblist.txt.sample svneol=native#text/plain
debugger/test/Gdbmi/rungdbmiform.lfm svneol=native#text/plain
debugger/test/Gdbmi/rungdbmiform.pas svneol=native#text/pascal
debugger/test/Gdbmi/testbase.pas svneol=native#text/pascal

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

@ -125,14 +125,36 @@
TDynIntArray2 = Array of TDynIntArray;
// dyn array with record
Record1 = record
a : integer;
b : integer;
end;
Record1Array = array of Record1;
Record2 = record
c : integer;
recs : Record1Array;
end;
PRecord2 = ^Record2;
{$ENDIF}
{$IFDEF Global_Var}
//var
// dyn array with record
myRec2 : PRecord2;
{$ENDIF}
{$IFDEF Global_Body}
//begin
new(myRec2);
myRec2^.c := 16;
SetLength(myRec2^.recs, 16);
myRec2^.recs[0].a := 10;
myRec2^.recs[0].b := 20;
myRec2^.recs[1].a := 11;
myRec2^.recs[1].b := 21;
{$ENDIF}
{$IFDEF Global_Body_NIL}

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

@ -31,6 +31,7 @@
{$IFDEF FooFunc_LocalVar}
//var
VarAnsiString: AnsiString;
VarTMyAnsiString: TMyAnsiString;
VarPMyAnsiString: PMyAnsiString;
VarPPMyAnsiString: PPMyAnsiString;
@ -65,6 +66,7 @@
{$IFDEF FooFunc_Body}
//begin
VarAnsiString := 'abcd';
VarTMyAnsiString := ArgTMyAnsiString + '-var';
VarPMyAnsiString := ArgPMyAnsiString;
VarPPMyAnsiString := ArgPPMyAnsiString;

15
debugger/test/Gdbmi/fpclist.txt.sample Normal file
View File

@ -0,0 +1,15 @@
// Comment
[fpc 2.4.2]
exe=c:\FPC\rel_2_4_2\bin\i386-win32\fpc.exe
symbols=gs,gw,gwset
//symbols=none,gs,gw,gwset
[fpc 2.4.4]
exe=c:\FPC\rel_2_4_4\bin\i386-win32\fpc.exe
symbols=gs,gw,gwset
[fpc trunk]
exe=c:\FPC\trunk\bin\i386-win32\fpc.exe
symbols=gs,gw,gwset,gw3

19
debugger/test/Gdbmi/gdblist.txt.sample Normal file
View File

@ -0,0 +1,19 @@
// Comment
// Version is 3 pairs of 2 digits
[gdb 6.7.50]
exe=C:\GDB\6.7.50\gdb.exe
version=060750
symbols=none,gs,gw,gwset
[gdb 7.0]
exe=C:\GDB\7.0\gdb.exe
version=070000
symbols=none,gs,gw,gwset
//symbols=none,gs,gw,gwset,gw3
[gdb 7.3-50 with patches]
exe=C:\GDB\7.3-50\gdb.exe
version=070350
symbols=none,gs,gw,gwset,gw3

3
debugger/test/Gdbmi/testbreakpoint.pas
View File

@ -75,6 +75,7 @@ var
dbg: TTestBrkGDBMIDebugger;
i: LongInt;
begin
if SkipTest then exit;
if not TestControlForm.CheckListBox1.Checked[TestControlForm.CheckListBox1.Items.IndexOf('TTestBreakPoint')] then exit;
ClearTestErrors;
FBrkErr := nil;
@ -94,7 +95,7 @@ begin
dbg.Run;
// hit breakpoint
dbg.FReplaceBreak := True;
FBrkErr := dbg.BreakPoints.Add('*200'+LineEnding+'#', 200);
FBrkErr := dbg.BreakPoints.Add(TDBGPtr(200));
with FBrkErr do begin
InitialEnabled := True;
Enabled := True;

1
debugger/test/Gdbmi/testexception.pas
View File

@ -57,6 +57,7 @@ var
TestExeName, TstName: string;
dbg: TGDBMIDebugger;
begin
if SkipTest then exit;
if not TestControlForm.CheckListBox1.Checked[TestControlForm.CheckListBox1.Items.IndexOf('TTestExceptionOne')] then exit;
ClearTestErrors;

60
debugger/test/Gdbmi/testgdbmicontrol.lfm
View File

@ -1,12 +1,12 @@
object TestControlForm: TTestControlForm
Left = 1189
Height = 240
Top = 158
Width = 320
Left = 1214
Height = 353
Top = 104
Width = 439
BorderIcons = []
Caption = 'Test Control'
ClientHeight = 240
ClientWidth = 320
ClientHeight = 353
ClientWidth = 439
OnShow = FormShow
LCLVersion = '0.9.31'
Visible = True
@ -14,11 +14,11 @@ object TestControlForm: TTestControlForm
Left = 0
Height = 44
Top = 0
Width = 320
Width = 439
Align = alTop
AutoSize = True
ClientHeight = 44
ClientWidth = 320
ClientWidth = 439
TabOrder = 0
object CheckWriteLogs: TCheckBox
AnchorSideLeft.Control = Panel1
@ -28,7 +28,7 @@ object TestControlForm: TTestControlForm
Left = 1
Height = 19
Top = 1
Width = 318
Width = 437
Anchors = [akTop, akLeft, akRight]
Caption = 'Write Logs'
OnChange = CheckWriteLogsChange
@ -56,20 +56,52 @@ object TestControlForm: TTestControlForm
Left = 48
Height = 23
Top = 20
Width = 271
Width = 390
Anchors = [akTop, akLeft, akRight]
OnChange = EditLogDirChange
TabOrder = 1
Text = 'EditLogDir'
end
end
object CheckListBox1: TCheckListBox
object Panel2: TPanel
Left = 0
Height = 196
Height = 309
Top = 44
Width = 320
Width = 439
Align = alClient
ItemHeight = 0
BevelOuter = bvNone
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsHomogenousChildResize
ChildSizing.ShrinkVertical = crsHomogenousChildResize
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 3
ClientHeight = 309
ClientWidth = 439
TabOrder = 1
object CheckListBox1: TCheckListBox
Left = 0
Height = 309
Top = 0
Width = 147
ItemHeight = 0
TabOrder = 0
end
object chkFPC: TCheckListBox
Left = 147
Height = 309
Top = 0
Width = 147
ItemHeight = 0
TabOrder = 1
end
object chkGDB: TCheckListBox
Left = 294
Height = 309
Top = 0
Width = 145
ItemHeight = 0
TabOrder = 2
end
end
end

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

@ -14,10 +14,13 @@ type
TTestControlForm = class(TForm)
CheckListBox1: TCheckListBox;
chkGDB: TCheckListBox;
CheckWriteLogs: TCheckBox;
chkFPC: TCheckListBox;
EditLogDir: TEdit;
Label1: TLabel;
Panel1: TPanel;
Panel2: TPanel;
procedure CheckWriteLogsChange(Sender: TObject);
procedure EditLogDirChange(Sender: TObject);
procedure FormShow(Sender: TObject);
@ -39,7 +42,9 @@ uses GuiTestRunner, TestBase;
procedure TTestControlForm.FormShow(Sender: TObject);
var
j: Integer;
i, j: Integer;
d: TDebuggerList;
c: TCompilerList;
begin
OnShow := nil;
Top := TestRunner.Top;
@ -71,6 +76,16 @@ begin
j := CheckListBox1.Items.Add('TTestBreakPoint');
CheckListBox1.Checked[j] := True;
d := GetDebuggers;
for i := 0 to d.Count - 1 do begin
j := chkGDB.Items.Add(d.Name[i]);
chkGDB.Checked[j] := True;
end;
c := GetCompilers;
for i := 0 to c.Count - 1 do begin
j := chkFPC.Items.Add(c.Name[i]);
chkFPC.Checked[j] := True;
end;
end;
procedure TTestControlForm.EditLogDirChange(Sender: TObject);

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

@ -463,8 +463,8 @@ begin
Add('ArgDouble', wdfDefault, '1\.123', skSimple, 'Double', []);
Add('VArgDouble', wdfDefault, '1\.123', skSimple, 'Double', []);
Add('ArgExtended', wdfDefault, '2\.345', skSimple, 'Extended', []);
Add('VArgExtended', wdfDefault, '2\.345', skSimple, 'Extended', []);
Add('ArgExtended', wdfDefault, '2\.345', skSimple, 'Extended|double', [fTpMtch]);
Add('VArgExtended', wdfDefault, '2\.345', skSimple, 'Extended|double', [fTpMtch]);
(*
Add('ArgPByte', wdfDefault, '', sk, 'PByte', []);
@ -805,13 +805,13 @@ procedure TTestWatches.RunTestWatches(NamePreFix: String; TestExeName, ExtraOpts
else
s := WatchValue;
if flag then begin
//if flag then begin
rx := TRegExpr.Create;
rx.ModifierI := true;
rx.Expression := Data.ExpMatch;
if Data.ExpMatch <> ''
then TestTrue(Name + ' Matches "'+Data.ExpMatch + '", but was "' + s + '"', rx.Exec(s));
end;
//end;
flag := (AWatch <> nil) and (Data.ExpTypeName <> '');
if flag then flag := TestTrue(Name + ' has typeinfo', WV.TypeInfo <> nil);
@ -889,32 +889,37 @@ begin
(* Start debugging *)
dbg.ShowConsole := True;
dbg.Run;
(* Hit first breakpoint: Test *)
(* SubFoo -- Called with none nil data *)
FDbgOutPutEnable := True;
for i := low(ExpectBreakFooGdb) to high(ExpectBreakFooGdb) do begin
if not SkipTest(ExpectBreakFooGdb[i]) then begin
FDbgOutPut := '';
dbg.TestCmd(ExpectBreakFooGdb[i].Expression);
TestWatch('Brk1 Direct Gdb '+IntToStr(i)+' ', nil, ExpectBreakFooGdb[i], FDbgOutPut);
if TestTrue('State=Pause', dbg.State = dsPause)
then begin
(* Hit first breakpoint: NESTED SubFoo -- (1st loop) Called with none nil data *)
for i := low(ExpectBreakSubFoo) to high(ExpectBreakSubFoo) do begin
if not SkipTest(ExpectBreakSubFoo[i]) then
TestWatch('Brk1 '+IntToStr(i)+' ', WListSub[i], ExpectBreakSubFoo[i]);
end;
end;
FDbgOutPutEnable := False;
for i := low(ExpectBreakSubFoo) to high(ExpectBreakSubFoo) do begin
if not SkipTest(ExpectBreakSubFoo[i]) then
TestWatch('Brk1 '+IntToStr(i)+' ', WListSub[i], ExpectBreakSubFoo[i]);
dbg.Run;
end;
dbg.Run;
if TestTrue('State=Pause', dbg.State = dsPause)
then begin
(* Hit 2nd breakpoint: Foo -- (1st loop) Called with none nil data *)
(* Hit second breakpoint: Test *)
(* Foo -- Called with none nil data *)
FDbgOutPutEnable := True;
for i := low(ExpectBreakFooGdb) to high(ExpectBreakFooGdb) do begin
if not SkipTest(ExpectBreakFooGdb[i]) then begin
FDbgOutPut := '';
dbg.TestCmd(ExpectBreakFooGdb[i].Expression);
TestWatch('Brk1 Direct Gdb '+IntToStr(i)+' ', nil, ExpectBreakFooGdb[i], FDbgOutPut);
end;
end;
FDbgOutPutEnable := False;
for i := low(ExpectBreakFoo) to high(ExpectBreakFoo) do begin
if not SkipTest(ExpectBreakFoo[i]) then
TestWatch('Brk1 '+IntToStr(i)+' ', WList[i], ExpectBreakFoo[i]);
for i := low(ExpectBreakFoo) to high(ExpectBreakFoo) do begin
if not SkipTest(ExpectBreakFoo[i]) then
TestWatch('Brk1 '+IntToStr(i)+' ', WList[i], ExpectBreakFoo[i]);
end;
dbg.Run;
end;
// TODO: 2nd round, with NIL data
@ -936,6 +941,7 @@ var
TestExeName: string;
UsedUnits: TUsesDir;
begin
if SkipTest then exit;
if not TestControlForm.CheckListBox1.Checked[TestControlForm.CheckListBox1.Items.IndexOf('TTestWatch')] then exit;
FDoStatIntArray := TestControlForm.CheckListBox1.Checked[TestControlForm.CheckListBox1.Items.IndexOf('TTestWatch.Unstable')];