mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-12-06 21:58:32 +01:00
DBG: Tests
git-svn-id: trunk@32187 -
This commit is contained in:
martin
parent
3123ce42c2
commit
e22fd7551a
@ -28,7 +28,7 @@
|
||||
program WatchesPrg;
|
||||
{$H-}
|
||||
|
||||
uses sysutils, variants;
|
||||
uses sysutils, variants, Classes;
|
||||
|
||||
type
|
||||
{$DEFINE Global_Types}
|
||||
|
||||
@ -225,6 +225,8 @@
|
||||
|
||||
PVarTFooClass: ^TFooClass;
|
||||
|
||||
VarFooComp, VarFooComp1: TFooComp;
|
||||
|
||||
{ OBJECT }
|
||||
VarOldObject: TOldObject;
|
||||
{$ENDIF}
|
||||
@ -258,6 +260,9 @@
|
||||
|
||||
{ OBJECT }
|
||||
VarOldObject.OldVal := 1;
|
||||
|
||||
VarFooComp := TFooComp.Create(nil);
|
||||
VarFooComp := nil;
|
||||
{$ENDIF}
|
||||
{%endregion FooFunc}
|
||||
|
||||
@ -265,7 +270,17 @@
|
||||
{$IFDEF Global_Types}
|
||||
{ Classes }
|
||||
|
||||
TFooComp = class(TComponent)
|
||||
public
|
||||
ValueInt: Integer;
|
||||
end;
|
||||
|
||||
{ TFoo }
|
||||
|
||||
TFoo = class
|
||||
private
|
||||
function GetValueInt: Integer;
|
||||
procedure SetValueInt(AValue: Integer);
|
||||
public
|
||||
ValueInt: Integer;
|
||||
ValueFoo: TFoo;
|
||||
@ -274,6 +289,7 @@
|
||||
FooString: String;
|
||||
FooChar: Char;
|
||||
property PropInt: Integer read ValueInt write ValueInt;
|
||||
property PropIntGS: Integer read GetValueInt write SetValueInt;
|
||||
end;
|
||||
|
||||
TFooChild = class(TFoo) end;
|
||||
@ -303,6 +319,20 @@
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF Global_Var}
|
||||
{ TFoo }
|
||||
|
||||
function TFoo.GetValueInt: Integer;
|
||||
begin
|
||||
Result := PropInt;
|
||||
end;
|
||||
|
||||
procedure TFoo.SetValueInt(AValue: Integer);
|
||||
begin
|
||||
PropInt := AValue;
|
||||
end;
|
||||
|
||||
var
|
||||
|
||||
//var
|
||||
{ Classes }
|
||||
GlobTFoo, GlobTFoo1, GlobTFoo2, GlobTFooNil: TFoo;
|
||||
|
||||
@ -7,7 +7,22 @@ interface
|
||||
uses
|
||||
Classes, SysUtils, process, UTF8Process, LCLProc;
|
||||
|
||||
function TestCompile(const PrgName, FpcOpts, ExeName, FpcExe: string): String;
|
||||
type
|
||||
|
||||
{ TCompileHelper }
|
||||
|
||||
TCompileHelper = class
|
||||
private
|
||||
FLastError: String;
|
||||
public
|
||||
function TestCompile(const PrgName, FpcOpts, ExeName, FpcExe: string): String;
|
||||
function TestCompileUnits(const FpcExe, FpcOpts, SrcDirName, OutLibName: string): Boolean;
|
||||
property LastError: String read FLastError;
|
||||
end;
|
||||
|
||||
var CompileHelper: TCompileHelper;
|
||||
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
@ -58,7 +73,9 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function TestCompile(const PrgName, FpcOpts, ExeName, FpcExe: string): String;
|
||||
{ TCompileHelper }
|
||||
|
||||
function TCompileHelper.TestCompile(const PrgName, FpcOpts, ExeName, FpcExe: string): String;
|
||||
var
|
||||
FpcBuild: TProcessUTF8;
|
||||
OutputLines: TStrings;
|
||||
@ -96,5 +113,50 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCompileHelper.TestCompileUnits(const FpcExe, FpcOpts, SrcDirName,
|
||||
OutLibName: string): Boolean;
|
||||
var
|
||||
FpcBuild: TProcessUTF8;
|
||||
OutputLines: TStrings;
|
||||
CmdLine: string;
|
||||
begin
|
||||
Result := False;
|
||||
FpcBuild := TProcessUTF8.Create(nil);
|
||||
OutputLines := nil;
|
||||
try
|
||||
{$IFDEF windows}
|
||||
FpcBuild.Options := [poNewConsole, poUsePipes];
|
||||
{$ELSE}
|
||||
FpcBuild.Options := [poNoConsole, poUsePipes];
|
||||
{$ENDIF}
|
||||
FpcBuild.ShowWindow := swoHIDE;
|
||||
|
||||
CmdLine := FpcExe + ' -MObjFPC -FU' + OutLibName + ' ' + FpcOpts + ' ' + SrcDirName;
|
||||
debugln(['**** running compiler: ', CmdLine]);
|
||||
FpcBuild.CommandLine := CmdLine;
|
||||
|
||||
FpcBuild.CurrentDirectory := ExtractFileDir(SrcDirName);
|
||||
|
||||
FpcBuild.Execute;
|
||||
OutputLines := ReadOutput(FpcBuild);
|
||||
if FpcBuild.Running then begin
|
||||
FpcBuild.Terminate(99);
|
||||
end;
|
||||
FLastError := OutputLines.Text;
|
||||
if FpcBuild.ExitStatus = 0
|
||||
then Result := True
|
||||
else Result := False;
|
||||
finally
|
||||
FpcBuild.Free;
|
||||
OutputLines.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
CompileHelper:= TCompileHelper.Create;
|
||||
|
||||
finalization
|
||||
FreeAndNil(CompileHelper);
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -1,24 +1,24 @@
|
||||
object Form1: TForm1
|
||||
Left = 511
|
||||
Height = 463
|
||||
Left = 493
|
||||
Height = 519
|
||||
Top = 232
|
||||
Width = 599
|
||||
Width = 731
|
||||
Caption = 'Form1'
|
||||
ClientHeight = 463
|
||||
ClientWidth = 599
|
||||
ClientHeight = 519
|
||||
ClientWidth = 731
|
||||
OnCreate = FormCreate
|
||||
LCLVersion = '0.9.31'
|
||||
object Panel1: TPanel
|
||||
Left = 6
|
||||
Height = 52
|
||||
Height = 81
|
||||
Top = 6
|
||||
Width = 587
|
||||
Width = 719
|
||||
Align = alTop
|
||||
AutoSize = True
|
||||
BorderSpacing.Around = 6
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 52
|
||||
ClientWidth = 587
|
||||
ClientHeight = 81
|
||||
ClientWidth = 719
|
||||
TabOrder = 0
|
||||
object edBreakFile: TEdit
|
||||
AnchorSideLeft.Control = Label1
|
||||
@ -27,36 +27,38 @@ object Form1: TForm1
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 36
|
||||
Height = 23
|
||||
Top = 29
|
||||
Width = 176
|
||||
Top = 58
|
||||
Width = 214
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Top = 6
|
||||
OnChange = edPasFileChange
|
||||
TabOrder = 0
|
||||
end
|
||||
object edBreakLine: TEdit
|
||||
AnchorSideLeft.Control = Label2
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = edBreakFile
|
||||
Left = 247
|
||||
Left = 285
|
||||
Height = 23
|
||||
Top = 29
|
||||
Top = 58
|
||||
Width = 115
|
||||
BorderSpacing.Left = 6
|
||||
OnChange = edPasFileChange
|
||||
TabOrder = 1
|
||||
end
|
||||
object Button1: TButton
|
||||
object BtnRun: TButton
|
||||
AnchorSideTop.Control = Panel1
|
||||
AnchorSideRight.Control = Panel1
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = Panel1
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 479
|
||||
Left = 611
|
||||
Height = 25
|
||||
Top = 27
|
||||
Top = 56
|
||||
Width = 108
|
||||
Anchors = [akRight, akBottom]
|
||||
Caption = 'Run'
|
||||
OnClick = Button1Click
|
||||
OnClick = BtnRunClick
|
||||
TabOrder = 2
|
||||
end
|
||||
object Label1: TLabel
|
||||
@ -65,7 +67,7 @@ object Form1: TForm1
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 0
|
||||
Height = 16
|
||||
Top = 32
|
||||
Top = 61
|
||||
Width = 30
|
||||
Caption = 'Break'
|
||||
ParentColor = False
|
||||
@ -75,22 +77,24 @@ object Form1: TForm1
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = edBreakFile
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 218
|
||||
Left = 256
|
||||
Height = 16
|
||||
Top = 32
|
||||
Top = 61
|
||||
Width = 23
|
||||
BorderSpacing.Left = 6
|
||||
Caption = 'Line'
|
||||
ParentColor = False
|
||||
end
|
||||
object edPasFile: TComboBox
|
||||
object edPasHistory: TComboBox
|
||||
AnchorSideLeft.Control = Panel1
|
||||
AnchorSideTop.Control = Panel1
|
||||
Left = 0
|
||||
Height = 23
|
||||
Top = 0
|
||||
Width = 364
|
||||
Width = 506
|
||||
ItemHeight = 15
|
||||
OnChange = edPasHistoryChange
|
||||
Style = csDropDownList
|
||||
TabOrder = 3
|
||||
end
|
||||
object BitBtn1: TBitBtn
|
||||
@ -98,10 +102,13 @@ object Form1: TForm1
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = edPasFile
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 370
|
||||
AnchorSideRight.Control = edPasHistory
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 471
|
||||
Height = 25
|
||||
Top = -1
|
||||
Top = 28
|
||||
Width = 35
|
||||
Anchors = [akTop, akRight]
|
||||
AutoSize = True
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Top = 6
|
||||
@ -109,30 +116,86 @@ object Form1: TForm1
|
||||
OnClick = BitBtn1Click
|
||||
TabOrder = 4
|
||||
end
|
||||
object edPasFile: TEdit
|
||||
AnchorSideLeft.Control = Label1
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = edPasHistory
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = BitBtn1
|
||||
Left = 36
|
||||
Height = 23
|
||||
Top = 29
|
||||
Width = 429
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Top = 6
|
||||
BorderSpacing.Right = 6
|
||||
OnChange = edPasFileChange
|
||||
TabOrder = 5
|
||||
end
|
||||
object Label3: TLabel
|
||||
AnchorSideLeft.Control = Panel1
|
||||
AnchorSideTop.Control = edPasFile
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 0
|
||||
Height = 16
|
||||
Top = 32
|
||||
Width = 19
|
||||
Caption = 'File'
|
||||
ParentColor = False
|
||||
end
|
||||
object chkStripEcho: TCheckBox
|
||||
AnchorSideLeft.Control = BtnRun
|
||||
AnchorSideTop.Control = Panel1
|
||||
AnchorSideRight.Control = Panel1
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 611
|
||||
Height = 19
|
||||
Top = 0
|
||||
Width = 108
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
Caption = 'Strip Echo'
|
||||
TabOrder = 6
|
||||
end
|
||||
object chkCSF: TCheckBox
|
||||
AnchorSideLeft.Control = BtnRun
|
||||
AnchorSideTop.Control = chkStripEcho
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = Panel1
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 611
|
||||
Height = 19
|
||||
Top = 21
|
||||
Width = 108
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Top = 2
|
||||
Caption = 'CSF'
|
||||
TabOrder = 7
|
||||
end
|
||||
end
|
||||
object Panel2: TPanel
|
||||
Left = 175
|
||||
Height = 399
|
||||
Top = 64
|
||||
Width = 424
|
||||
Height = 426
|
||||
Top = 93
|
||||
Width = 556
|
||||
Align = alClient
|
||||
ClientHeight = 399
|
||||
ClientWidth = 424
|
||||
ClientHeight = 426
|
||||
ClientWidth = 556
|
||||
TabOrder = 1
|
||||
object Memo1: TMemo
|
||||
Left = 1
|
||||
Height = 125
|
||||
Top = 1
|
||||
Width = 422
|
||||
Top = 4
|
||||
Width = 554
|
||||
Align = alTop
|
||||
ScrollBars = ssAutoBoth
|
||||
TabOrder = 0
|
||||
end
|
||||
object Memo2: TMemo
|
||||
Left = 1
|
||||
Height = 269
|
||||
Height = 296
|
||||
Top = 129
|
||||
Width = 422
|
||||
Width = 554
|
||||
Align = alClient
|
||||
ScrollBars = ssAutoBoth
|
||||
TabOrder = 1
|
||||
@ -141,25 +204,25 @@ object Form1: TForm1
|
||||
Cursor = crVSplit
|
||||
Left = 1
|
||||
Height = 3
|
||||
Top = 126
|
||||
Width = 422
|
||||
Top = 1
|
||||
Width = 554
|
||||
Align = alTop
|
||||
ResizeAnchor = akTop
|
||||
end
|
||||
end
|
||||
object Panel3: TPanel
|
||||
Left = 0
|
||||
Height = 399
|
||||
Top = 64
|
||||
Left = 5
|
||||
Height = 426
|
||||
Top = 93
|
||||
Width = 170
|
||||
Align = alLeft
|
||||
ClientHeight = 399
|
||||
ClientHeight = 426
|
||||
ClientWidth = 170
|
||||
TabOrder = 2
|
||||
object CheckListBox1: TCheckListBox
|
||||
Left = 1
|
||||
Height = 176
|
||||
Top = 1
|
||||
Top = 6
|
||||
Width = 168
|
||||
Align = alTop
|
||||
ItemHeight = 0
|
||||
@ -169,14 +232,14 @@ object Form1: TForm1
|
||||
Cursor = crVSplit
|
||||
Left = 1
|
||||
Height = 5
|
||||
Top = 177
|
||||
Top = 1
|
||||
Width = 168
|
||||
Align = alTop
|
||||
ResizeAnchor = akTop
|
||||
end
|
||||
object CheckListBox2: TCheckListBox
|
||||
Left = 1
|
||||
Height = 216
|
||||
Height = 243
|
||||
Top = 182
|
||||
Width = 168
|
||||
Align = alClient
|
||||
@ -185,9 +248,9 @@ object Form1: TForm1
|
||||
end
|
||||
end
|
||||
object Splitter3: TSplitter
|
||||
Left = 170
|
||||
Height = 399
|
||||
Top = 64
|
||||
Left = 0
|
||||
Height = 426
|
||||
Top = 93
|
||||
Width = 5
|
||||
end
|
||||
object OpenDialog1: TOpenDialog
|
||||
|
||||
@ -7,7 +7,7 @@ interface
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, EditBtn, StdCtrls,
|
||||
Buttons, CompileHelpers, TestBase, testregistry, fpcunit, GDBMIDebugger, Debugger, LCLIntf,
|
||||
CheckLst, CmdLineDebugger;
|
||||
CheckLst, CmdLineDebugger, strutils, math;
|
||||
|
||||
type
|
||||
|
||||
@ -15,14 +15,18 @@ type
|
||||
|
||||
TForm1 = class(TForm)
|
||||
BitBtn1: TBitBtn;
|
||||
Button1: TButton;
|
||||
BtnRun: TButton;
|
||||
chkCSF: TCheckBox;
|
||||
chkStripEcho: TCheckBox;
|
||||
CheckListBox1: TCheckListBox;
|
||||
CheckListBox2: TCheckListBox;
|
||||
edPasFile: TComboBox;
|
||||
edPasFile: TEdit;
|
||||
edPasHistory: TComboBox;
|
||||
edBreakFile: TEdit;
|
||||
edBreakLine: TEdit;
|
||||
Label1: TLabel;
|
||||
Label2: TLabel;
|
||||
Label3: TLabel;
|
||||
Memo1: TMemo;
|
||||
Memo2: TMemo;
|
||||
OpenDialog1: TOpenDialog;
|
||||
@ -33,12 +37,16 @@ type
|
||||
Splitter2: TSplitter;
|
||||
Splitter3: TSplitter;
|
||||
procedure BitBtn1Click(Sender: TObject);
|
||||
procedure Button1Click(Sender: TObject);
|
||||
procedure BtnRunClick(Sender: TObject);
|
||||
procedure edPasFileChange(Sender: TObject);
|
||||
procedure edPasHistoryChange(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
public
|
||||
{ public declarations }
|
||||
CurMemoLine: Integer;
|
||||
EchoText, MemoText: string;
|
||||
end;
|
||||
|
||||
var
|
||||
@ -62,6 +70,11 @@ type
|
||||
procedure DoRun;
|
||||
end;
|
||||
|
||||
function EscQ(s: string): String;
|
||||
begin
|
||||
Result := AnsiReplaceStr(s, '"', '""');
|
||||
end;
|
||||
|
||||
{ TRunner }
|
||||
|
||||
procedure TRunner.dobrk(ADebugger: TDebugger; ABreakPoint: TBaseBreakPoint;
|
||||
@ -71,9 +84,33 @@ begin
|
||||
end;
|
||||
|
||||
procedure TRunner.DoDbgOut(Sender: TObject; const AText: String);
|
||||
var s: string;
|
||||
i: Integer;
|
||||
begin
|
||||
if not FTesting then exit;
|
||||
Form1.Memo2.Lines.Add(AText);
|
||||
|
||||
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.MemoText := Form1.MemoText + EscQ(s) + LineEnding;
|
||||
Form1.Memo2.Text := Form1.MemoText;
|
||||
end
|
||||
else
|
||||
Form1.Memo2.Lines.Add(AText);
|
||||
end;
|
||||
|
||||
type THack = class(TCmdLineDebugger) end;
|
||||
@ -92,8 +129,15 @@ begin
|
||||
i := Form1.CheckListBox2.Items.IndexOf(DebuggerInfo.Name);
|
||||
if not Form1.CheckListBox2.Checked[i] then exit;
|
||||
|
||||
ClearTestErrors;
|
||||
FTesting := False;
|
||||
Form1.Memo2.Lines.Add('***** '+ Parent.TestName + ' ' + Parent.Parent.TestName);
|
||||
if Form1.chkCSF.Checked
|
||||
then begin
|
||||
Form1.MemoText := Form1.MemoText + LineEnding + '"' + EscQ(Parent.Parent.TestName) + '",';
|
||||
Form1.Memo2.Text := Form1.MemoText;
|
||||
end
|
||||
else
|
||||
Form1.Memo2.Lines.Add('***** '+ Parent.TestName + ' ' + Parent.Parent.TestName);
|
||||
|
||||
try
|
||||
TestCompile(Form1.edPasFile.Text, TestExeName);
|
||||
@ -104,10 +148,9 @@ begin
|
||||
|
||||
|
||||
try
|
||||
dbg := TGDBMIDebugger.Create(DebuggerInfo.ExeName);
|
||||
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
|
||||
@ -116,26 +159,33 @@ begin
|
||||
end;
|
||||
|
||||
(* Start debugging *)
|
||||
dbg.Init;
|
||||
if dbg.State = dsError then begin
|
||||
Form1.Memo2.Lines.Add('Failed to start');
|
||||
exit;
|
||||
end;
|
||||
|
||||
dbg.WorkingDir := AppDir;
|
||||
dbg.FileName := TestExeName;
|
||||
dbg.Arguments := '';
|
||||
dbg.ShowConsole := True;
|
||||
//if dbg.State = dsError then begin
|
||||
// Form1.Memo2.Lines.Add('Failed to start');
|
||||
// exit;
|
||||
//end;
|
||||
|
||||
dbg.Run;
|
||||
|
||||
//t:= GetTickCount;
|
||||
for i := 0 to Form1.Memo1.Lines.Count - 1 do begin
|
||||
if Trim(Form1.Memo1.Lines[i]) = '' then Continue;
|
||||
FTesting := True;
|
||||
dbg.TestCmd(Trim(Form1.Memo1.Lines[i]));
|
||||
FTesting := False;
|
||||
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));
|
||||
|
||||
@ -163,21 +213,40 @@ begin
|
||||
dbg.Stop;
|
||||
finally
|
||||
dbg.Free;
|
||||
CleanGdb;
|
||||
end;
|
||||
Form1.Memo2.Lines.Add(' ');
|
||||
end;
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
procedure TForm1.Button1Click(Sender: TObject);
|
||||
procedure TForm1.BtnRunClick(Sender: TObject);
|
||||
var
|
||||
Dummy: TTestResult;
|
||||
i: Integer;
|
||||
begin
|
||||
edPasHistory.AddHistoryItem
|
||||
(edPasFile.Text + '*' + edBreakFile.Text + '*' + edBreakLine.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;
|
||||
MemoText := Memo2.Text;
|
||||
|
||||
if Form1.chkCSF.Checked then begin
|
||||
MemoText := MemoText + LineEnding + '"-","';
|
||||
for i := 0 to Form1.Memo1.Lines.Count - 1 do begin
|
||||
MemoText := MemoText + EscQ(Trim(Form1.Memo1.Lines[i])) + '","';
|
||||
end;
|
||||
MemoText := MemoText + '"' + LineEnding;
|
||||
Form1.Memo2.Text := MemoText;
|
||||
end;
|
||||
|
||||
Dummy := TTestResult.Create;
|
||||
GetTestRegistry.Run(Dummy);
|
||||
Dummy.Free;
|
||||
@ -187,6 +256,30 @@ begin
|
||||
|
||||
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);
|
||||
|
||||
edBreakLine.Text := copy(t, 1, i);
|
||||
end;
|
||||
|
||||
procedure TForm1.FormCreate(Sender: TObject);
|
||||
var
|
||||
l: TCompilerList;
|
||||
@ -195,12 +288,14 @@ var
|
||||
begin
|
||||
RegisterDbgTest(TRunner);
|
||||
if FileExistsUTF8(AppendPathDelim(ExtractFilePath(Paramstr(0))) + 'run_gdbmi_cmds.txt') then
|
||||
edPasFile.Items.LoadFromFile(AppendPathDelim(ExtractFilePath(Paramstr(0))) + 'run_gdbmi_cmds.txt');
|
||||
if edPasFile.Items.Count > 0 then
|
||||
edPasFile.ItemIndex := 0;
|
||||
edBreakFile.Text := ExtractFileName(edPasFile.Text);
|
||||
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]);
|
||||
@ -216,10 +311,9 @@ end;
|
||||
procedure TForm1.BitBtn1Click(Sender: TObject);
|
||||
begin
|
||||
if not OpenDialog1.Execute then exit;
|
||||
edPasFile.AddHistoryItem(OpenDialog1.FileName, 15, True, False);
|
||||
edBreakFile.Text := ExtractFileName(edPasFile.Text);
|
||||
edPasFile.Text := OpenDialog1.FileName;
|
||||
edBreakFile.Text := ExtractFileName(edPasHistory.Text);
|
||||
edBreakLine.Text := '1';
|
||||
edPasFile.Items.SaveToFile(AppendPathDelim(ExtractFilePath(Paramstr(0))) + 'run_gdbmi_cmds.txt');
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -50,6 +50,12 @@ type
|
||||
Version: Integer;
|
||||
end;
|
||||
|
||||
TUsesDir = record
|
||||
DirName: String;
|
||||
SymbolType: TSymbolType;
|
||||
ExtraOpts, NamePostFix: string;
|
||||
end;
|
||||
|
||||
{ TBaseList }
|
||||
|
||||
TBaseList = class
|
||||
@ -121,7 +127,16 @@ type
|
||||
procedure Run(AResult: TTestResult); override;
|
||||
procedure RunTest(ATest: TTest; AResult: TTestResult); override;
|
||||
procedure RegisterDbgTest(ATestClass: TTestCaseClass);
|
||||
Procedure TestCompile(const PrgName: string; out ExeName: string; NamePostFix: String=''; ExtraArgs: String='');
|
||||
Procedure TestCompileUses(UsesDir: TUsesDir; out UsesLibDir);
|
||||
Procedure TestCompile(const PrgName: string;
|
||||
out ExeName: string;
|
||||
NamePostFix: String=''; ExtraArgs: String=''
|
||||
); overload;
|
||||
Procedure TestCompile(const PrgName: string;
|
||||
out ExeName: string;
|
||||
UsesDirs: array of TUsesDir;
|
||||
NamePostFix: String=''; ExtraArgs: String=''
|
||||
); overload;
|
||||
public
|
||||
property SymbolType: TSymbolType read FSymbolType;
|
||||
property SymbolSwitch: String read FSymbolSwitch;
|
||||
@ -795,8 +810,19 @@ begin
|
||||
TDebuggerSuite(Test[i]).RegisterDbgTest(ATestClass);
|
||||
end;
|
||||
|
||||
procedure TCompilerSuite.TestCompileUses(UsesDir: TUsesDir; out UsesLibDir);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TCompilerSuite.TestCompile(const PrgName: string; out ExeName: string;
|
||||
NamePostFix: String=''; ExtraArgs: String='');
|
||||
begin
|
||||
TestCompile(PrgName, ExeName, [], NamePostFix, ExtraArgs);
|
||||
end;
|
||||
|
||||
procedure TCompilerSuite.TestCompile(const PrgName: string; out ExeName: string;
|
||||
UsesDirs: array of TUsesDir; NamePostFix: String; ExtraArgs: String);
|
||||
var
|
||||
ExePath, ErrMsg: String;
|
||||
begin
|
||||
@ -813,7 +839,7 @@ begin
|
||||
if FileExists(ExeName) then
|
||||
raise EAssertionFailedError.Create('Found existing file before compiling: ' + ExeName);
|
||||
FCompiledList.Add(ExeName);
|
||||
ErrMsg := CompileHelpers.TestCompile(PrgName, FSymbolSwitch + ' ' + FCompilerInfo.ExtraOpts + ExtraArgs, ExeName, CompilerInfo.ExeName);
|
||||
ErrMsg := CompileHelper.TestCompile(PrgName, FSymbolSwitch + ' ' + FCompilerInfo.ExtraOpts + ExtraArgs, ExeName, CompilerInfo.ExeName);
|
||||
if ErrMsg <> '' then begin
|
||||
debugln(ErrMsg);
|
||||
raise EAssertionFailedError.Create('Compilation Failed: ' + ExeName + LineEnding + ErrMsg);
|
||||
|
||||
@ -9,11 +9,14 @@ uses
|
||||
|
||||
type
|
||||
|
||||
{ TTestGdbType }
|
||||
|
||||
TTestGdbType = class(TTestCase)
|
||||
private
|
||||
FIgnoreBaseDeclaration: Boolean;
|
||||
published
|
||||
procedure TestPTypeParser;
|
||||
procedure TestUnEscape;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -322,6 +325,17 @@ begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TTestGdbType.TestUnEscape;
|
||||
begin
|
||||
AssertEquals('a\102c', 'aBc', UnEscapeBackslashed('a\102c', [uefOctal]));
|
||||
AssertEquals('4:a\tc', 'a c', UnEscapeBackslashed('a\tc', [uefTab], 4));
|
||||
AssertEquals('4:a\t\tc', 'a c', UnEscapeBackslashed('a\t\tc', [uefTab], 4));
|
||||
AssertEquals('6:a\tc', 'a c', UnEscapeBackslashed('a\tc', [uefTab], 6));
|
||||
AssertEquals('4:a\102\tc\\d', 'aB c\d', UnEscapeBackslashed('a\102\tc\\d', [uefOctal, uefTab],4));
|
||||
AssertEquals('a\102\tc\\d', 'aB\tc\d', UnEscapeBackslashed('a\102\tc\\d', [uefOctal],4));
|
||||
AssertEquals('4:a\102\tc\\d (no oct)', 'a\102 c\d', UnEscapeBackslashed('a\102\tc\\d', [uefTab],4));
|
||||
end;
|
||||
|
||||
|
||||
|
||||
initialization
|
||||
|
||||
Loading…
Reference in New Issue
Block a user