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

DBG: Test

Browse Source 
git-svn-id: trunk@32218 -
This commit is contained in:
martin 2011-09-07 22:05:59 +00:00
parent 53990c23d4
commit 4727f900a6
3 changed files with 239 additions and 130 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

102
debugger/test/Gdbmi/rungdbmiform.lfm
View File

@ -2,23 +2,23 @@ object Form1: TForm1
Left = 493 Left = 493
Height = 519 Height = 519
Top = 232 Top = 232
Width = 731 Width = 717
Caption = 'Form1' Caption = 'Form1'
ClientHeight = 519 ClientHeight = 519
ClientWidth = 731 ClientWidth = 717
OnCreate = FormCreate OnCreate = FormCreate
LCLVersion = '0.9.31' LCLVersion = '0.9.31'
object Panel1: TPanel object Panel1: TPanel
Left = 6 Left = 6
Height = 81 Height = 110
Top = 6 Top = 6
Width = 719 Width = 705
Align = alTop Align = alTop
AutoSize = True AutoSize = True
BorderSpacing.Around = 6 BorderSpacing.Around = 6
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 81 ClientHeight = 110
ClientWidth = 719 ClientWidth = 705
TabOrder = 0 TabOrder = 0
object edBreakFile: TEdit object edBreakFile: TEdit
AnchorSideLeft.Control = Label1 AnchorSideLeft.Control = Label1
@ -28,7 +28,7 @@ object Form1: TForm1
Left = 36 Left = 36
Height = 23 Height = 23
Top = 58 Top = 58
Width = 214 Width = 222
BorderSpacing.Left = 6 BorderSpacing.Left = 6
BorderSpacing.Top = 6 BorderSpacing.Top = 6
OnChange = edPasFileChange OnChange = edPasFileChange
@ -38,7 +38,7 @@ object Form1: TForm1
AnchorSideLeft.Control = Label2 AnchorSideLeft.Control = Label2
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = edBreakFile AnchorSideTop.Control = edBreakFile
Left = 285 Left = 293
Height = 23 Height = 23
Top = 58 Top = 58
Width = 115 Width = 115
@ -52,9 +52,9 @@ object Form1: TForm1
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Panel1 AnchorSideBottom.Control = Panel1
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 611 Left = 597
Height = 25 Height = 25
Top = 56 Top = 85
Width = 108 Width = 108
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
Caption = 'Run' Caption = 'Run'
@ -77,7 +77,7 @@ object Form1: TForm1
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = edBreakFile AnchorSideTop.Control = edBreakFile
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 256 Left = 264
Height = 16 Height = 16
Top = 61 Top = 61
Width = 23 Width = 23
@ -149,7 +149,7 @@ object Form1: TForm1
AnchorSideTop.Control = Panel1 AnchorSideTop.Control = Panel1
AnchorSideRight.Control = Panel1 AnchorSideRight.Control = Panel1
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 611 Left = 597
Height = 19 Height = 19
Top = 0 Top = 0
Width = 108 Width = 108
@ -163,7 +163,7 @@ object Form1: TForm1
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Panel1 AnchorSideRight.Control = Panel1
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 611 Left = 597
Height = 19 Height = 19
Top = 21 Top = 21
Width = 108 Width = 108
@ -172,30 +172,76 @@ object Form1: TForm1
Caption = 'CSF' Caption = 'CSF'
TabOrder = 7 TabOrder = 7
end end
object edUses: TEdit
AnchorSideLeft.Control = edBreakFile
AnchorSideTop.Control = edBreakFile
AnchorSideTop.Side = asrBottom
Left = 36
Height = 23
Top = 87
Width = 216
BorderSpacing.Top = 6
TabOrder = 8
end
object Label4: TLabel
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = edUses
AnchorSideTop.Side = asrCenter
Left = 0
Height = 16
Top = 90
Width = 25
Caption = 'Uses'
ParentColor = False
end
object Label5: TLabel
AnchorSideLeft.Control = edUses
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = edUses
AnchorSideTop.Side = asrCenter
Left = 262
Height = 16
Top = 90
Width = 35
BorderSpacing.Left = 10
Caption = 'Define'
ParentColor = False
end
object EdDefine: TEdit
AnchorSideLeft.Control = Label5
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = edUses
Left = 301
Height = 23
Top = 87
Width = 80
BorderSpacing.Left = 4
TabOrder = 9
end
end end
object Panel2: TPanel object Panel2: TPanel
Left = 175 Left = 175
Height = 426 Height = 397
Top = 93 Top = 122
Width = 556 Width = 542
Align = alClient Align = alClient
ClientHeight = 426 ClientHeight = 397
ClientWidth = 556 ClientWidth = 542
TabOrder = 1 TabOrder = 1
object Memo1: TMemo object Memo1: TMemo
Left = 1 Left = 1
Height = 125 Height = 125
Top = 4 Top = 4
Width = 554 Width = 540
Align = alTop Align = alTop
ScrollBars = ssAutoBoth ScrollBars = ssAutoBoth
TabOrder = 0 TabOrder = 0
end end
object Memo2: TMemo object Memo2: TMemo
Left = 1 Left = 1
Height = 296 Height = 267
Top = 129 Top = 129
Width = 554 Width = 540
Align = alClient Align = alClient
ScrollBars = ssAutoBoth ScrollBars = ssAutoBoth
TabOrder = 1 TabOrder = 1
@ -205,18 +251,18 @@ object Form1: TForm1
Left = 1 Left = 1
Height = 3 Height = 3
Top = 1 Top = 1
Width = 554 Width = 540
Align = alTop Align = alTop
ResizeAnchor = akTop ResizeAnchor = akTop
end end
end end
object Panel3: TPanel object Panel3: TPanel
Left = 5 Left = 5
Height = 426 Height = 397
Top = 93 Top = 122
Width = 170 Width = 170
Align = alLeft Align = alLeft
ClientHeight = 426 ClientHeight = 397
ClientWidth = 170 ClientWidth = 170
TabOrder = 2 TabOrder = 2
object CheckListBox1: TCheckListBox object CheckListBox1: TCheckListBox
@ -239,7 +285,7 @@ object Form1: TForm1
end end
object CheckListBox2: TCheckListBox object CheckListBox2: TCheckListBox
Left = 1 Left = 1
Height = 243 Height = 214
Top = 182 Top = 182
Width = 168 Width = 168
Align = alClient Align = alClient
@ -249,8 +295,8 @@ object Form1: TForm1
end end
object Splitter3: TSplitter object Splitter3: TSplitter
Left = 0 Left = 0
Height = 426 Height = 397
Top = 93 Top = 122
Width = 5 Width = 5
end end
object OpenDialog1: TOpenDialog object OpenDialog1: TOpenDialog

241
debugger/test/Gdbmi/rungdbmiform.pas
View File

@ -20,6 +20,8 @@ type
chkStripEcho: TCheckBox; chkStripEcho: TCheckBox;
CheckListBox1: TCheckListBox; CheckListBox1: TCheckListBox;
CheckListBox2: TCheckListBox; CheckListBox2: TCheckListBox;
EdDefine: TEdit;
edUses: TEdit;
edPasFile: TEdit; edPasFile: TEdit;
edPasHistory: TComboBox; edPasHistory: TComboBox;
edBreakFile: TEdit; edBreakFile: TEdit;
@ -27,6 +29,8 @@ type
Label1: TLabel; Label1: TLabel;
Label2: TLabel; Label2: TLabel;
Label3: TLabel; Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Memo1: TMemo; Memo1: TMemo;
Memo2: TMemo; Memo2: TMemo;
OpenDialog1: TOpenDialog; OpenDialog1: TOpenDialog;
@ -116,106 +120,151 @@ end;
type THack = class(TCmdLineDebugger) end; type THack = class(TCmdLineDebugger) end;
procedure TRunner.DoRun; procedure TRunner.DoRun;
procedure DoOneRun(Name: String; UsesDirs: array of TUsesDir);
var
TestExeName: string;
dbg: TGDBMIDebugger;
i: Integer;
j: Integer;
begin
ClearTestErrors;
FTesting := False;
if Form1.chkCSF.Checked
then begin
Form1.MemoText := Form1.MemoText + LineEnding + '"' + EscQ(Parent.Parent.TestName) + ' ' + Name + '",';
Form1.Memo2.Text := Form1.MemoText;
end
else
Form1.Memo2.Lines.Add('***** '+ Parent.TestName + ' ' + Parent.Parent.TestName + ' ' + Name);
try
TestCompile(Form1.edPasFile.Text, TestExeName, UsesDirs, '', Form1.EdDefine.Text);
except
on e: Exception do
Form1.Memo2.Lines.Add('Compile error: ' + e.Message);
end;
try
dbg := StartGDB(AppDir, TestExeName);
dbg.OnDbgOutput := @DoDbgOut;
dbg.OnBreakPointHit := @dobrk;
(* Add breakpoints *)
with dbg.BreakPoints.Add(Form1.edBreakFile.Text, StrToInt(Form1.edBreakLine.Text)) do begin
InitialEnabled := True;
Enabled := True;
end;
(* Start debugging *)
//if dbg.State = dsError then begin
// Form1.Memo2.Lines.Add('Failed to start');
// exit;
//end;
dbg.Run;
//t:= GetTickCount;
if Form1.chkCSF.Checked then begin
Form1.MemoText := Form1.MemoText + '"';
end;
for i := 0 to Form1.Memo1.Lines.Count - 1 do begin
if Trim(Form1.Memo1.Lines[i])<> '' then begin
FTesting := True;
Form1.EchoText := Trim(Form1.Memo1.Lines[i]);
dbg.TestCmd(Form1.EchoText);
FTesting := False;
end;
if Form1.chkCSF.Checked then
Form1.MemoText := Form1.MemoText + '","';
end;
if Form1.chkCSF.Checked then begin
Form1.MemoText := Form1.MemoText + '"';
Form1.Memo2.Text := Form1.MemoText;
end;
dbg.Stop;
finally
dbg.Free;
CleanGdb;
end;
Form1.Memo2.Lines.Add(' ');
end;
var var
TestExeName: string; AUsesDir: TUsesDir;
dbg: TGDBMIDebugger;
i: Integer; i: Integer;
j: Integer;
//t: LongWord;
//S: String;
begin begin
i := Form1.CheckListBox1.Items.IndexOf(CompilerInfo.Name); i := Form1.CheckListBox1.Items.IndexOf(CompilerInfo.Name);
if not Form1.CheckListBox1.Checked[i] then exit; if not Form1.CheckListBox1.Checked[i] then exit;
i := Form1.CheckListBox2.Items.IndexOf(DebuggerInfo.Name); i := Form1.CheckListBox2.Items.IndexOf(DebuggerInfo.Name);
if not Form1.CheckListBox2.Checked[i] then exit; if not Form1.CheckListBox2.Checked[i] then exit;
ClearTestErrors; if Form1.edUses.Text <> '' then begin
FTesting := False;
if Form1.chkCSF.Checked with AUsesDir do begin
then begin DirName := Form1.edUses.Text;
Form1.MemoText := Form1.MemoText + LineEnding + '"' + EscQ(Parent.Parent.TestName) + '",'; ExeId:= '';
Form1.Memo2.Text := Form1.MemoText; SymbolType:= stNone;
ExtraOpts:= '';
NamePostFix:= ''
end;
DoOneRun('none', [AUsesDir]);
if (stStabs in CompilerInfo.SymbolTypes) and (stStabs in DebuggerInfo.SymbolTypes)
then begin
with AUsesDir do begin
DirName := Form1.edUses.Text;
ExeId:= '';
SymbolType:= stStabs;
ExtraOpts:= '';
NamePostFix:= ''
end;
DoOneRun('stabs', [AUsesDir]);
end;
if (stDwarf in CompilerInfo.SymbolTypes) and (stDwarf in DebuggerInfo.SymbolTypes)
then begin
with AUsesDir do begin
DirName := Form1.edUses.Text;
ExeId:= '';
SymbolType:= stDwarf;
ExtraOpts:= '';
NamePostFix:= ''
end;
DoOneRun('stDwarf', [AUsesDir]);
end;
if (stDwarfSet in CompilerInfo.SymbolTypes) and (stDwarfSet in DebuggerInfo.SymbolTypes)
then begin
with AUsesDir do begin
DirName := Form1.edUses.Text;
ExeId:= '';
SymbolType:= stDwarfSet;
ExtraOpts:= '';
NamePostFix:= ''
end;
DoOneRun('stabsSet', [AUsesDir]);
end;
if (stDwarf3 in CompilerInfo.SymbolTypes) and (stDwarf3 in DebuggerInfo.SymbolTypes)
then begin
with AUsesDir do begin
DirName := Form1.edUses.Text;
ExeId:= '';
SymbolType:= stDwarf3;
ExtraOpts:= '';
NamePostFix:= ''
end;
DoOneRun('stDwarf3', [AUsesDir]);
end;
end end
else else
Form1.Memo2.Lines.Add('***** '+ Parent.TestName + ' ' + Parent.Parent.TestName); DoOneRun('', []);
try
TestCompile(Form1.edPasFile.Text, TestExeName);
except
on e: Exception do
Form1.Memo2.Lines.Add('Compile error: ' + e.Message);
end;
try
dbg := StartGDB(AppDir, TestExeName);
dbg.OnDbgOutput := @DoDbgOut;
dbg.OnBreakPointHit := @dobrk;
(* Add breakpoints *)
with dbg.BreakPoints.Add(Form1.edBreakFile.Text, StrToInt(Form1.edBreakLine.Text)) do begin
InitialEnabled := True;
Enabled := True;
end;
(* Start debugging *)
//if dbg.State = dsError then begin
// Form1.Memo2.Lines.Add('Failed to start');
// exit;
//end;
dbg.Run;
//t:= GetTickCount;
if Form1.chkCSF.Checked then begin
Form1.MemoText := Form1.MemoText + '"';
end;
for i := 0 to Form1.Memo1.Lines.Count - 1 do begin
if Trim(Form1.Memo1.Lines[i])<> '' then begin
FTesting := True;
Form1.EchoText := Trim(Form1.Memo1.Lines[i]);
dbg.TestCmd(Form1.EchoText);
FTesting := False;
end;
if Form1.chkCSF.Checked then
Form1.MemoText := Form1.MemoText + '","';
end;
if Form1.chkCSF.Checked then begin
Form1.MemoText := Form1.MemoText + '"';
Form1.Memo2.Text := Form1.MemoText;
end;
//t := GetTickCount - t;
//Form1.Memo2.Lines.Add('many '+IntToStr(t));
//j:=0;
//t:= GetTickCount;
//for i := 0 to Form1.Memo1.Lines.Count - 1 do begin
// if Trim(Form1.Memo1.Lines[i]) = '' then Continue;
// FTesting := True;
// THack(dbg).sendcmdLn(Form1.Memo1.Lines[i]);
// inc(j);
//
// //dbg.TestCmd(Trim(Form1.Memo1.Lines[i]));
// FTesting := False;
//end;
//while j > 0 do begin
// S := THack(dbg).ReadLine;
// Form1.Memo2.Lines.Add(s);
// if S = '(gdb) ' then dec(j);
//end;
//t := GetTickCount - t;
//Form1.Memo2.Lines.Add('one '+IntToStr(t));
dbg.Stop;
finally
dbg.Free;
CleanGdb;
end;
Form1.Memo2.Lines.Add(' ');
end; end;
{ TForm1 } { TForm1 }
@ -226,7 +275,7 @@ var
i: Integer; i: Integer;
begin begin
edPasHistory.AddHistoryItem edPasHistory.AddHistoryItem
(edPasFile.Text + '*' + edBreakFile.Text + '*' + edBreakLine.Text, (edPasFile.Text + '*' + edBreakFile.Text + '*' + edBreakLine.Text + '*' + edUses.Text + '*' + EdDefine.Text,
15, True, False); 15, True, False);
edPasHistory.Items.SaveToFile(AppendPathDelim(ExtractFilePath(Paramstr(0))) + 'run_gdbmi_cmds.txt'); edPasHistory.Items.SaveToFile(AppendPathDelim(ExtractFilePath(Paramstr(0))) + 'run_gdbmi_cmds.txt');
@ -277,7 +326,17 @@ begin
edBreakFile.Text := copy(t, 1, i); edBreakFile.Text := copy(t, 1, i);
delete(t,1,i+1); delete(t,1,i+1);
i := pos('*', t)-1;
if i <= 0 then i := length(t);
edBreakLine.Text := copy(t, 1, i); edBreakLine.Text := copy(t, 1, i);
delete(t,1,i+1);
i := pos('*', t)-1;
if i <= 0 then i := length(t);
edUses.Text := copy(t, 1, i);
delete(t,1,i+1);
EdDefine.Text := copy(t, 1, i);
end; end;
procedure TForm1.FormCreate(Sender: TObject); procedure TForm1.FormCreate(Sender: TObject);

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

@ -141,7 +141,7 @@ procedure TTestWatches.ClearAllTestArrays;
begin begin
SetLength(ExpectBreakFooGdb, 0); SetLength(ExpectBreakFooGdb, 0);
SetLength(ExpectBreakSubFoo, 0); SetLength(ExpectBreakSubFoo, 0);
SetLength(ExpectBreakFoo, Length(ExpectBreakFoo)+1); SetLength(ExpectBreakFoo, 0);
end; end;
procedure TTestWatches.AddTo(var ExpArray: TWatchExpectationArray; AnExpr: string; procedure TTestWatches.AddTo(var ExpArray: TWatchExpectationArray; AnExpr: string;
@ -592,12 +592,15 @@ procedure TTestWatches.AddExpectBreakFooMixInfo;
begin begin
AddTo(ExpectBreakFoo, AName, AnExpr, AFmt, AMtch, AKind, ATpNm, AFlgs ) AddTo(ExpectBreakFoo, AName, AnExpr, AFmt, AMtch, AKind, ATpNm, AFlgs )
end; end;
procedure AddTC(AVar, ATCast: string; AExpClass: String = ''; AFlgs: TWatchExpectationFlags = []); procedure AddTC(AVar, ATCast: string; AExpClass: String = ''; AFlgs: TWatchExpectationFlags = [];
AIntMember: String = ''; AIntValue: integer = 0);
begin begin
if AExpClass = '' then AExpClass := ATCast; if AExpClass = '' then AExpClass := ATCast;
If ATCast <> '' If ATCast <> ''
then Add('',ATCast+'('+AVar+')', wdfDefault, MatchClass(AExpClass, ''), skClass, AExpClass, AFlgs) then Add('',ATCast+'('+AVar+')', wdfDefault, MatchClass(AExpClass, ''), skClass, AExpClass, AFlgs)
else Add('',AVar, wdfDefault, MatchClass(AExpClass, ''), skClass, AExpClass, AFlgs); else Add('',AVar, wdfDefault, MatchClass(AExpClass, ''), skClass, AExpClass, AFlgs);
if AIntMember <> '' then
Add('', ATCast+'('+AVar+').'+AIntMember, wdfDefault, IntToStr(AIntValue), skSimple, M_Int, [fTpMtch]);
end; end;
procedure AddTCN(AVar, ATCast: string; AExpClass: String = ''; AFlgs: TWatchExpectationFlags = []); procedure AddTCN(AVar, ATCast: string; AExpClass: String = ''; AFlgs: TWatchExpectationFlags = []);
begin begin
@ -612,8 +615,8 @@ begin
// Type Casting objects with mixed symbol type // Type Casting objects with mixed symbol type
AddTC('VarOTestTCast', '', 'TObject'); AddTC('VarOTestTCast', '', 'TObject');
AddTC('VarOTestTCast', 'TObject', ''); AddTC('VarOTestTCast', 'TObject', '');
AddTC('VarOTestTCast', 'TClassTCast', ''); AddTC('VarOTestTCast', 'TClassTCast', '', [], 'b', 0);
AddTC('VarOTestTCast', 'TClassTCast3', 'TClassTCast(3)?', [fTpMtch]); AddTC('VarOTestTCast', 'TClassTCast3', 'TClassTCast(3)?', [fTpMtch], 'b', 0);
AddTC('VarOTestTCastObj', '', 'TObject'); AddTC('VarOTestTCastObj', '', 'TObject');
AddTC('VarOTestTCastObj', 'TObject', ''); AddTC('VarOTestTCastObj', 'TObject', '');
@ -622,12 +625,12 @@ begin
AddTC('VarOTestTCastComp', '', 'TObject'); AddTC('VarOTestTCastComp', '', 'TObject');
AddTC('VarOTestTCastComp', 'TObject', ''); AddTC('VarOTestTCastComp', 'TObject', '');
AddTC('VarOTestTCastComp', 'TComponent', ''); AddTC('VarOTestTCastComp', 'TComponent', '');
AddTC('VarOTestTCastComp', 'TClassTCastComponent', ''); AddTC('VarOTestTCastComp', 'TClassTCastComponent', '', [], 'b', 0);
AddTC('VarOTestTCast2', '', 'TObject'); AddTC('VarOTestTCast2', '', 'TObject');
AddTC('VarOTestTCast2', 'TObject', ''); AddTC('VarOTestTCast2', 'TObject', '');
AddTC('VarOTestTCast2', 'TClassTCast', ''); AddTC('VarOTestTCast2', 'TClassTCast', '', [], 'b', 0);
AddTC('VarOTestTCast2', 'TClassTCast2', ''); AddTC('VarOTestTCast2', 'TClassTCast2', '', [], 'b', 0);
AddTC('VarOTestTCastUW1', '', 'TObject'); AddTC('VarOTestTCastUW1', '', 'TObject');
AddTC('VarOTestTCastUW1', 'TObject', ''); AddTC('VarOTestTCastUW1', 'TObject', '');
@ -699,13 +702,14 @@ begin
AddTCN('VarNOTestTCast', '', 'TObject'); //AddTCN('VarNOTestTCast', '', 'TObject');
AddTCN('VarNOTestTCast', 'TObject', ''); //AddTCN('VarNOTestTCast', 'TObject', '');
AddTCN('VarNOTestTCast', 'TClassTCast', ''); //AddTCN('VarNOTestTCast', 'TClassTCast', '');
AddTCN('VarNOTestTCast', 'TClassTCast3', 'TClassTCast(3)?', [fTpMtch]); //AddTCN('VarNOTestTCast', 'TClassTCast3', 'TClassTCast(3)?', [fTpMtch]);
// MIXED symbol info types // MIXED symbol info types
if not( (pos('2.4.', CompilerInfo.Name) > 0) and (DebuggerInfo.Version = 70000) ) then
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', skSimple, 'TStatIntArray',
[]); []);