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

tests: added test projects from lcl\tests to the test suite.

Browse Source 
git-svn-id: trunk@10569 -
This commit is contained in:
vincents 2007-02-02 13:40:34 +00:00
parent ff6424e4ba
commit 7bb39a459a
1 changed files with 22 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
test/testlpi.pas
View File

@ -36,8 +36,8 @@ type
procedure RunScript; procedure RunScript;
public public
constructor Create(const APath: string; const ATestName: string); overload; constructor Create(const APath: string; const ATestName: string); overload;
class function Suite(const APath: string): TTestSuite; class function CreateProjectSuite(const aName, APath: string): TTestSuite;
class function ExamplesSuite: TTestSuite; class function CreateSuiteFromDirectory(const AName, ABasePath: string): TTestSuite;
published published
procedure TestCompile; procedure TestCompile;
procedure TestRun; procedure TestRun;
@ -48,12 +48,14 @@ implementation
var var
LazarusDir: string; LazarusDir: string;
ExamplesDir: string; ExamplesDir: string;
LCLTestDir: string;
ScriptEngine: string; ScriptEngine: string;
procedure InitDirectories; procedure InitDirectories;
begin begin
LazarusDir := ExpandFileName(ExtractFilePath(ParamStr(0)) + '../'); LazarusDir := ExpandFileName(ExtractFilePath(ParamStr(0)) + '../');
ExamplesDir := LazarusDir + 'examples' + PathDelim; ExamplesDir := LazarusDir + 'examples' + PathDelim;
LCLTestDir := LazarusDir + 'lcl' + PathDelim + 'tests' + PathDelim;
ScriptEngine := 'C:\Program Files\AutoHotkey\AutoHotKey.exe'; ScriptEngine := 'C:\Program Files\AutoHotkey\AutoHotKey.exe';
end; end;
@ -85,11 +87,12 @@ begin
FPath := APath; FPath := APath;
end; end;
class function TLpiTest.Suite(const APath: string): TTestSuite; class function TLpiTest.CreateProjectSuite(const AName,
APath: string): TTestSuite;
var var
AhkFileName: String; AhkFileName: String;
begin begin
Result := TTestSuite.Create(APath); Result := TTestSuite.Create(AName);
Result.AddTest(TLpiTest.Create(APath, 'TestCompile')); Result.AddTest(TLpiTest.Create(APath, 'TestCompile'));
{$IFDEF win32} {$IFDEF win32}
AhkFileName := GetScriptFileName(APath); AhkFileName := GetScriptFileName(APath);
@ -100,29 +103,33 @@ begin
{$ENDIF} {$ENDIF}
end; end;
class function TLpiTest.ExamplesSuite: TTestSuite; class function TLpiTest.CreateSuiteFromDirectory(const AName,
ABasePath: string): TTestSuite;
procedure SearchDirectory(const ADirectory: string); procedure SearchDirectory(const ADirectory: string);
var var
SearchMask: String; RelativePath: string;
SearchMask: string;
FileInfo: TSearchRec; FileInfo: TSearchRec;
begin begin
SearchMask := ADirectory + '*'; SearchMask := ABasePath+ADirectory + '*';
if FindFirst(SearchMask,faAnyFile,FileInfo)=0 then begin if FindFirst(SearchMask,faAnyFile,FileInfo)=0 then begin
repeat repeat
// skip special directory entries // skip special directory entries
if (FileInfo.Name='.') or (FileInfo.Name='..') then continue; if (FileInfo.Name='.') or (FileInfo.Name='..') then continue;
RelativePath := ADirectory+ FileInfo.Name;
if RightStr(FileInfo.Name,4)='.lpi' then if RightStr(FileInfo.Name,4)='.lpi' then
Result.AddTest(Suite(ADirectory + FileInfo.Name)) Result.AddTest(CreateProjectSuite(RelativePath, ABasePath+RelativePath))
else if (FileInfo.Attr and faDirectory=faDirectory) then else if (FileInfo.Attr and faDirectory=faDirectory) then
SearchDirectory(AppendPathDelim(ADirectory+FileInfo.Name)); SearchDirectory(AppendPathDelim(RelativePath));
until FindNext(FileInfo)<>0; until FindNext(FileInfo)<>0;
end; end;
FindClose(FileInfo); FindClose(FileInfo);
end; end;
begin begin
Result := TTestSuite.Create('Examples'); Result := TTestSuite.Create(AName);
SearchDirectory(AppendPathDelim(ExamplesDir)) SearchDirectory('')
end; end;
procedure TLpiTest.TestCompile; procedure TLpiTest.TestCompile;
@ -173,6 +180,9 @@ end;
initialization initialization
InitDirectories; InitDirectories;
GetTestRegistry.AddTest(TLpiTest.ExamplesSuite); GetTestRegistry.AddTest(
TLpiTest.CreateSuiteFromDirectory('Examples', ExamplesDir));
GetTestRegistry.AddTest(
TLpiTest.CreateSuiteFromDirectory('LCL test', LCLTestDir));
end. end.