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

DBG: Tests

Browse Source 
git-svn-id: trunk@32651 -
This commit is contained in:
martin 2011-10-03 12:00:59 +00:00
parent 9d45bfaa7e
commit 1adda67314
2 changed files with 31 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
debugger/test/Gdbmi/fpclist.txt.sample
View File

@ -13,3 +13,7 @@ symbols=gs,gw,gwset
exe=c:\FPC\trunk\bin\i386-win32\fpc.exe
symbols=gs,gw,gwset,gw3
[fpc trunk external linker]
exe=c:\FPC\trunk\bin\i386-win32\fpc.exe
symbols=gs,gw,gwset,gw3
opts=-Xe

32
debugger/test/Gdbmi/testbase.pas
View File

@ -208,12 +208,14 @@ type
FTestCnt, FTestErrorCnt, FIgnoredErrorCnt, FUnexpectedSuccessCnt, FSucessCnt: Integer;
FCurrentPrgName, FCurrentExename: String;
FLogFile: TextFile;
FLogFileCreated: Boolean;
function GetCompilerInfo: TCompilerInfo;
function GetDebuggerInfo: TDebuggerInfo;
function GetSymbolType: TSymbolType;
protected
function CreateResult: TTestResult; override;
function GetLogActive: Boolean;
procedure CreateLog;
procedure SetUp; override;
procedure TearDown; override;
procedure DoDbgOutPut(Sender: TObject; const AText: String); virtual;
@ -236,6 +238,7 @@ type
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;
function SkipTest: Boolean;
public
property Parent: TGDBTestsuite read FParent write FParent;
property DebuggerInfo: TDebuggerInfo read GetDebuggerInfo;
@ -270,6 +273,8 @@ var
implementation
uses TestGDBMIControl;
var
Compilers: TCompilerList = nil;
Debuggers: TDebuggerList = nil;
@ -346,6 +351,7 @@ end;
procedure TGDBTestCase.InternalDbgOutPut(Sender: TObject; const AText: String);
begin
if GetLogActive then begin
CreateLog;
writeln(FLogFile, AText);
end;
DoDbgOutPut(Sender, AText);
@ -382,13 +388,14 @@ begin
Result := WriteLog;
end;
procedure TGDBTestCase.SetUp;
procedure TGDBTestCase.CreateLog;
var
name: String;
i: Integer;
dir: String;
begin
if GetLogActive then begin
if FLogFileCreated then exit;
//if GetLogActive then begin
name := TestName
+ '_' + NameToFileName(GetCompilerInfo.Name)
+ '_' + SymbolTypeNames[GetSymbolType]
@ -403,14 +410,20 @@ begin
name[i] := '_';
AssignFile(FLogFile, Dir + name);
Rewrite(FLogFile);
end;
FLogFileCreated := True;
//end;
end;
procedure TGDBTestCase.SetUp;
begin
FLogFileCreated := False;
inherited SetUp;
end;
procedure TGDBTestCase.TearDown;
begin
inherited TearDown;
if GetLogActive then begin
if FLogFileCreated then begin
CloseFile(FLogFile);
end;
end;
@ -430,6 +443,7 @@ begin
FRegisters := TIDERegisters.Create;
Result := GdbClass.Create(DebuggerInfo.ExeName);
Result.OnDbgOutput := @InternalDbgOutPut;
//TManagedBreakpoints(FBreakpoints).Master := FDebugger.BreakPoints;
FWatches.Supplier := Result.Watches;
@ -449,7 +463,6 @@ begin
Result.FileName := TestExeName;
Result.Arguments := '';
Result.ShowConsole := True;
Result.OnDbgOutput := @InternalDbgOutPut;
end;
@ -583,6 +596,7 @@ begin
[FTestErrorCnt, FTestCnt, FIgnoredErrorCnt, FUnexpectedSuccessCnt, FSucessCnt ]);
FTestErrors := '';
if GetLogActive then begin
CreateLog;
writeln(FLogFile, '***' + s1 + '***' +LineEnding);
writeln(FLogFile, '================= Failed:'+LineEnding);
writeln(FLogFile, s);
@ -607,6 +621,7 @@ procedure TGDBTestCase.TestCompile(const PrgName: string; out ExeName: string;
UsesDirs: array of TUsesDir; NamePostFix: String; ExtraArgs: String);
begin
if GetLogActive then begin
CreateLog;
writeln(FLogFile, LineEnding+LineEnding+'******************* compile '+PrgName + ' ' + ExtraArgs +LineEnding);
end;
Parent.TestCompile(PrgName, ExeName, UsesDirs, NamePostFix, ExtraArgs);
@ -614,6 +629,13 @@ begin
FCurrentExename := ExeName;
end;
function TGDBTestCase.SkipTest: Boolean;
begin
Result := not TestControlForm.chkGDB.Checked[TestControlForm.chkGDB.Items.IndexOf(DebuggerInfo.Name)];
Result := Result or
not TestControlForm.chkFPC.Checked[TestControlForm.chkFPC.Items.IndexOf(CompilerInfo.Name)];
end;
{ TBaseList }
procedure TBaseList.LoadFromFile(const AFileName: string);