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

tests: seach examples directory recursively for example applications.

Browse Source 
git-svn-id: trunk@10560 -
This commit is contained in:
vincents 2007-02-01 15:43:43 +00:00
parent 065a2e596b
commit b9033c3702
2 changed files with 21 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
test/runtestsgui.lpi
View File

@ -46,7 +46,7 @@
<Unit2>
<Filename Value="testglobals.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="testglobals"/>
<UnitName Value="TestGlobals"/>
</Unit2>
</Units>
</ProjectOptions>

31
test/testlpi.pas
View File

@ -101,19 +101,28 @@ begin
end;
class function TLpiTest.ExamplesSuite: TTestSuite;
var
SearchMask: String;
FileInfo: TSearchRec;
procedure SearchDirectory(const ADirectory: string);
var
SearchMask: String;
FileInfo: TSearchRec;
begin
SearchMask := ADirectory + '*';
if FindFirst(SearchMask,faAnyFile,FileInfo)=0 then begin
repeat
// skip special directory entries
if (FileInfo.Name='.') or (FileInfo.Name='..') then continue;
if RightStr(FileInfo.Name,4)='.lpi' then
Result.AddTest(Suite(ADirectory + FileInfo.Name))
else if (FileInfo.Attr and faDirectory=faDirectory) then
SearchDirectory(AppendPathDelim(ADirectory+FileInfo.Name));
until FindNext(FileInfo)<>0;
end;
FindClose(FileInfo);
end;
begin
Result := TTestSuite.Create('Examples');
SearchMask := ExamplesDir + '*.lpi';
if FindFirst(SearchMask,faAnyFile,FileInfo)=0 then begin
repeat
if RightStr(FileInfo.Name,4)='.lpi' then
Result.AddTest(Suite(ExamplesDir + FileInfo.Name));
until FindNext(FileInfo)<>0;
end;
FindClose(FileInfo);
SearchDirectory(AppendPathDelim(ExamplesDir))
end;
procedure TLpiTest.TestCompile;