mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-05 18:53:00 +02:00
394 lines
9.3 KiB
ObjectPascal
394 lines
9.3 KiB
ObjectPascal
unit RunGdbmiForm;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, EditBtn, StdCtrls,
|
|
Buttons, CompileHelpers, TestBase, testregistry, fpcunit, GDBMIDebugger, LCLIntf, DbgIntfDebuggerBase,
|
|
CheckLst, Spin, CmdLineDebugger, strutils, math;
|
|
|
|
type
|
|
|
|
{ TForm1 }
|
|
|
|
TForm1 = class(TForm)
|
|
BitBtn1: TBitBtn;
|
|
BtnRun: TButton;
|
|
chkCSF: TCheckBox;
|
|
chkStripEcho: TCheckBox;
|
|
CheckListBox1: TCheckListBox;
|
|
CheckListBox2: TCheckListBox;
|
|
EdDefine: TEdit;
|
|
edUses: TEdit;
|
|
edPasFile: TEdit;
|
|
edPasHistory: TComboBox;
|
|
edBreakFile: TEdit;
|
|
edBreakLine: TEdit;
|
|
Label1: TLabel;
|
|
Label2: TLabel;
|
|
Label3: TLabel;
|
|
Label4: TLabel;
|
|
Label5: TLabel;
|
|
Label6: TLabel;
|
|
Memo1: TMemo;
|
|
Memo2: TMemo;
|
|
OpenDialog1: TOpenDialog;
|
|
Panel1: TPanel;
|
|
Panel2: TPanel;
|
|
Panel3: TPanel;
|
|
SpinHC: TSpinEdit;
|
|
Splitter1: TSplitter;
|
|
Splitter2: TSplitter;
|
|
Splitter3: TSplitter;
|
|
procedure BitBtn1Click(Sender: TObject);
|
|
procedure BtnRunClick(Sender: TObject);
|
|
procedure edPasFileChange(Sender: TObject);
|
|
procedure edPasHistoryChange(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
private
|
|
{ private declarations }
|
|
public
|
|
{ public declarations }
|
|
EchoText: string;
|
|
procedure AppendToMemo2(Txt: String);
|
|
end;
|
|
|
|
var
|
|
Form1: TForm1;
|
|
|
|
implementation
|
|
|
|
{$R *.lfm}
|
|
|
|
type
|
|
|
|
{ TRunner }
|
|
|
|
TRunner = class(TGDBTestCase)
|
|
private
|
|
FTesting: Boolean;
|
|
procedure dobrk(ADebugger: TDebuggerIntf; ABreakPoint: TBaseBreakPoint;
|
|
var ACanContinue: Boolean);
|
|
published
|
|
procedure DoDbgOut(Sender: TObject; const AText: String);
|
|
procedure DoRun;
|
|
end;
|
|
|
|
function EscQ(s: string): String;
|
|
begin
|
|
Result := AnsiReplaceStr(s, '"', '""');
|
|
end;
|
|
|
|
{ TRunner }
|
|
|
|
procedure TRunner.dobrk(ADebugger: TDebuggerIntf; ABreakPoint: TBaseBreakPoint;
|
|
var ACanContinue: Boolean);
|
|
begin
|
|
ACanContinue := False;
|
|
end;
|
|
|
|
procedure TRunner.DoDbgOut(Sender: TObject; const AText: String);
|
|
var s: string;
|
|
i: Integer;
|
|
begin
|
|
if not FTesting then exit;
|
|
|
|
if Form1.chkStripEcho.Checked then begin
|
|
s := trim(AText);
|
|
if (copy(AText, 1, 1) = '&') then exit;
|
|
if (Form1.EchoText <> '') and ('<'+Form1.EchoText+'>' = s) then exit;
|
|
if (s = '(gdb)') or (s = '^done') then exit;
|
|
end;
|
|
Form1.EchoText := '';
|
|
|
|
if Form1.chkCSF.Checked
|
|
then begin
|
|
s := AText;
|
|
if (copy(s, 1, 2) = '~"') and (copy(s, length(AText), 1) = '"') then begin
|
|
Delete(s,1,2);
|
|
Delete(s,length(s),1);
|
|
end;
|
|
//S := AnsiReplaceStr(AText, #13, '\r');
|
|
//S := AnsiReplaceStr(AText, #10, '\n');
|
|
Form1.AppendToMemo2(EscQ(s) + LineEnding);
|
|
end
|
|
else
|
|
Form1.Memo2.Lines.Add(AText);
|
|
end;
|
|
|
|
type THack = class(TCmdLineDebugger) end;
|
|
|
|
procedure TRunner.DoRun;
|
|
procedure DoOneRun(Name: String; UsesDirs: array of TUsesDir);
|
|
var
|
|
TestExeName: string;
|
|
dbg: TGDBMIDebugger;
|
|
i, j , hc: Integer;
|
|
begin
|
|
ClearTestErrors;
|
|
FTesting := False;
|
|
if Form1.chkCSF.Checked
|
|
then begin
|
|
Form1.AppendToMemo2('"' + EscQ(Parent.Parent.TestName) + ' ' + Name + '",');
|
|
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;
|
|
|
|
hc := Form1.SpinHC.Value;
|
|
if hc < 1 then hc := 1;
|
|
|
|
while hc > 0 do begin
|
|
dbg.Run;
|
|
dec(hc);
|
|
end;
|
|
|
|
//t:= GetTickCount;
|
|
if Form1.chkCSF.Checked then begin
|
|
Form1.AppendToMemo2('"');
|
|
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.AppendToMemo2('","');
|
|
end;
|
|
if Form1.chkCSF.Checked then begin
|
|
Form1.AppendToMemo2('"');
|
|
end;
|
|
|
|
|
|
dbg.Stop;
|
|
finally
|
|
dbg.Free;
|
|
CleanGdb;
|
|
end;
|
|
Form1.Memo2.Lines.Add(' ');
|
|
end;
|
|
|
|
var
|
|
AUsesDir: TUsesDir;
|
|
i: Integer;
|
|
begin
|
|
i := Form1.CheckListBox1.Items.IndexOf(CompilerInfo.Name);
|
|
if not Form1.CheckListBox1.Checked[i] then exit;
|
|
i := Form1.CheckListBox2.Items.IndexOf(DebuggerInfo.Name);
|
|
if not Form1.CheckListBox2.Checked[i] then exit;
|
|
|
|
if Form1.edUses.Text <> '' then begin
|
|
|
|
with AUsesDir do begin
|
|
DirName := Form1.edUses.Text;
|
|
ExeId:= '';
|
|
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
|
|
else
|
|
DoOneRun('', []);
|
|
end;
|
|
|
|
{ TForm1 }
|
|
|
|
procedure TForm1.BtnRunClick(Sender: TObject);
|
|
var
|
|
Dummy: TTestResult;
|
|
i: Integer;
|
|
begin
|
|
edPasHistory.AddHistoryItem
|
|
(edPasFile.Text + '*' + edBreakFile.Text + '*' + edBreakLine.Text + '*' + edUses.Text + '*' + EdDefine.Text,
|
|
15, True, False);
|
|
edPasHistory.Items.SaveToFile(AppendPathDelim(ExtractFilePath(Paramstr(0))) + 'run_gdbmi_cmds.txt');
|
|
|
|
|
|
if Memo2.Lines.Count > 0 then begin;
|
|
Memo2.Lines.Add('');
|
|
Memo2.Lines.Add('----- ***** ----- ***** ----- ***** -----');
|
|
Memo2.Lines.Add('');
|
|
end;
|
|
|
|
if Form1.chkCSF.Checked then begin
|
|
Form1.AppendToMemo2(LineEnding + '"-","');
|
|
for i := 0 to Form1.Memo1.Lines.Count - 1 do begin
|
|
Form1.AppendToMemo2(EscQ(Trim(Form1.Memo1.Lines[i])) + '","');
|
|
end;
|
|
Form1.AppendToMemo2('"' + LineEnding);
|
|
end;
|
|
|
|
Dummy := TTestResult.Create;
|
|
GetTestRegistry.Run(Dummy);
|
|
Dummy.Free;
|
|
|
|
//for i := 0 to FTests.Count - 1 do
|
|
//RunTest(TTest(FTests[i]), AResult);
|
|
|
|
end;
|
|
|
|
procedure TForm1.edPasFileChange(Sender: TObject);
|
|
begin
|
|
|
|
end;
|
|
|
|
procedure TForm1.edPasHistoryChange(Sender: TObject);
|
|
var
|
|
t: TCaption;
|
|
i: SizeInt;
|
|
begin
|
|
t := edPasHistory.Text;
|
|
i := pos('*', t)-1;
|
|
if i < 0 then i := length(t);
|
|
edPasFile.Text := copy(t, 1, i);
|
|
delete(t,1,i+1);
|
|
|
|
i := pos('*', t)-1;
|
|
if i < 0 then i := length(t);
|
|
edBreakFile.Text := copy(t, 1, i);
|
|
delete(t,1,i+1);
|
|
|
|
i := pos('*', t)-1;
|
|
if i < 0 then i := length(t);
|
|
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;
|
|
|
|
procedure TForm1.FormCreate(Sender: TObject);
|
|
var
|
|
l: TCompilerList;
|
|
i, j: Integer;
|
|
l2: TDebuggerList;
|
|
begin
|
|
RegisterDbgTest(TRunner);
|
|
if FileExistsUTF8(AppendPathDelim(ExtractFilePath(Paramstr(0))) + 'run_gdbmi_cmds.txt') then
|
|
edPasHistory.Items.LoadFromFile(AppendPathDelim(ExtractFilePath(Paramstr(0))) + 'run_gdbmi_cmds.txt');
|
|
if edPasHistory.Items.Count > 0 then
|
|
edPasHistory.ItemIndex := 0;
|
|
edBreakFile.Text := ExtractFileName(edPasHistory.Text);
|
|
edBreakLine.Text := '1';
|
|
|
|
edPasHistoryChange(nil);
|
|
|
|
l := GetCompilers;
|
|
for i := 0 to l.Count-1 do begin
|
|
j := CheckListBox1.Items.Add(l.Name[i]);
|
|
CheckListBox1.Checked[j] := True;
|
|
end;
|
|
l2 := GetDebuggers;
|
|
for i := 0 to l2.Count-1 do begin
|
|
j := CheckListBox2.Items.Add(l2.Name[i]);
|
|
CheckListBox2.Checked[j] := True;
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.AppendToMemo2(Txt: String);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
i := Memo2.Lines.Count;
|
|
if (i = 0)then
|
|
Memo2.Append(Txt)
|
|
else
|
|
Memo2.Lines[i-1] := Memo2.Lines[i-1] + Txt;
|
|
end;
|
|
|
|
procedure TForm1.BitBtn1Click(Sender: TObject);
|
|
begin
|
|
if not OpenDialog1.Execute then exit;
|
|
edPasFile.Text := OpenDialog1.FileName;
|
|
edBreakFile.Text := ExtractFileName(edPasHistory.Text);
|
|
edBreakLine.Text := '1';
|
|
end;
|
|
|
|
end.
|
|
|
|
|