paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2026-01-06 11:20:37 +01:00
Code Issues Packages Projects Releases Wiki Activity

added fpcunit tests that compile the examples

Browse Source 
git-svn-id: trunk@9851 -
This commit is contained in:
vincents 2006-09-09 20:11:36 +00:00
parent 843b17534a
commit a887252122
8 changed files with 575 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
.gitattributes vendored
View File

@ -2613,6 +2613,13 @@ packager/ucomponentmanmain.pas svneol=native#text/pascal
packager/ufrmaddcomponent.lfm svneol=native#text/plain
packager/ufrmaddcomponent.lrs svneol=native#text/pascal
packager/ufrmaddcomponent.pas svneol=native#text/pascal
test/hello.ahk svneol=native#text/plain
test/readme.txt svneol=native#text/plain
test/runtests.lpi svneol=native#text/plain
test/runtests.lpr svneol=native#text/plain
test/runtestsgui.lpi svneol=native#text/plain
test/runtestsgui.lpr svneol=native#text/plain
test/testlpi.pas svneol=native#text/plain
tools/apiwizz/apiwizard.lfm svneol=native#text/plain
tools/apiwizz/apiwizard.lrs svneol=native#text/pascal
tools/apiwizz/apiwizard.pp svneol=native#text/pascal

19
test/hello.ahk Normal file
View File

@ -0,0 +1,19 @@
;
; AutoHotkey Version: 1.x
; Language: English
; Platform: Win9x/NT
; Author: A.N.Other <myemail@nowhere.com>
;
; Script Function:
; Template script (you can customize this template by editing "ShellNew\Template.ahk" in your Windows folder)
;
#NoEnv ; Recommended for performance and compatibility with future AutoHotkey releases.
SendMode Input ; Recommended for new scripts due to its superior speed and reliability.
WinWait, Hello World,
IfWinNotActive, Hello World, , WinActivate, Hello World,
WinWaitActive, Hello World,
Click, 98, 68

7
test/readme.txt Normal file
View File

@ -0,0 +1,7 @@
This directory contains test written with fpcunit. It contains two projects:
* runtests.lpi for running the tests using the fpcunit console runner.
* runtestsgui.lpi for running the tests using the fpcunit gui runner.
The first test suite compiles the example project from the example dir.
On windows it will run the programs and interact with them using autohotkey.

190
test/runtests.lpi Normal file
View File

@ -0,0 +1,190 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="\"/>
<Version Value="5"/>
<General>
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=".exe"/>
<ActiveEditorIndexAtStart Value="4"/>
</General>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<CommandLineParams Value="-a"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="FCL"/>
</Item1>
</RequiredPackages>
<Units Count="12">
<Unit0>
<Filename Value="runtests.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="runtests"/>
<CursorPos X="1" Y="46"/>
<TopLine Value="26"/>
<EditorIndex Value="3"/>
<UsageCount Value="27"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="testlpi.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="TestLpi"/>
<CursorPos X="55" Y="69"/>
<TopLine Value="1"/>
<EditorIndex Value="0"/>
<UsageCount Value="27"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="..\..\source\fpc\2.1\fcl\inc\process.pp"/>
<UnitName Value="process"/>
<CursorPos X="37" Y="128"/>
<TopLine Value="106"/>
<UsageCount Value="10"/>
</Unit2>
<Unit3>
<Filename Value="..\..\source\fpc\2.1\fcl\image\fpwritebmp.pp"/>
<UnitName Value="FPWriteBMP"/>
<CursorPos X="40" Y="699"/>
<TopLine Value="677"/>
<UsageCount Value="9"/>
</Unit3>
<Unit4>
<Filename Value="..\..\source\lazarus\lcl\intfgraphics.pas"/>
<UnitName Value="IntfGraphics"/>
<CursorPos X="9" Y="3273"/>
<TopLine Value="3251"/>
<UsageCount Value="9"/>
</Unit4>
<Unit5>
<Filename Value="..\..\source\fpc\2.1\packages\extra\zlib\zlib.pp"/>
<UnitName Value="zlib"/>
<CursorPos X="16" Y="131"/>
<TopLine Value="1"/>
<UsageCount Value="9"/>
</Unit5>
<Unit6>
<Filename Value="..\..\source\fpc\2.1\packages\base\paszlib\gzio.pas"/>
<UnitName Value="gzio"/>
<CursorPos X="11" Y="24"/>
<TopLine Value="2"/>
<UsageCount Value="9"/>
</Unit6>
<Unit7>
<Filename Value="..\..\source\fpc\2.1\packages\base\hash\crc.pas"/>
<UnitName Value="crc"/>
<CursorPos X="78" Y="14"/>
<TopLine Value="66"/>
<UsageCount Value="9"/>
</Unit7>
<Unit8>
<Filename Value="..\..\source\fpc\2.1\fcl\fpcunit\testreport.pp"/>
<UnitName Value="testreport"/>
<CursorPos X="3" Y="318"/>
<TopLine Value="195"/>
<EditorIndex Value="1"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
</Unit8>
<Unit9>
<Filename Value="..\..\source\fpc\2.0\fcl\fpcunit\xmlreporter.pas"/>
<UnitName Value="xmlreporter"/>
<CursorPos X="35" Y="115"/>
<TopLine Value="93"/>
<UsageCount Value="9"/>
</Unit9>
<Unit10>
<Filename Value="..\..\source\fpc\2.1\fcl\fpcunit\xmlreporter.pas"/>
<UnitName Value="xmlreporter"/>
<CursorPos X="23" Y="49"/>
<TopLine Value="170"/>
<EditorIndex Value="2"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
</Unit10>
<Unit11>
<Filename Value="..\..\source\lazarus\components\fpcunit\ide\fpcunitproject1.inc"/>
<CursorPos X="66" Y="42"/>
<TopLine Value="118"/>
<EditorIndex Value="4"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit11>
</Units>
<JumpHistory Count="1" HistoryIndex="0">
<Position1>
<Filename Value="..\..\source\lazarus\components\fpcunit\ide\fpcunitproject1.inc"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position1>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<PathDelim Value="\"/>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<BreakPoints Count="8">
<Item1>
<Source Value="..\..\source\lazarus\ide\main.pp"/>
<Line Value="5295"/>
</Item1>
<Item2>
<Source Value="..\..\source\fpc\2.1\rtl\objpas\classes\stringl.inc"/>
<Line Value="188"/>
</Item2>
<Item3>
<Source Value="..\..\source\lazarus\lcl\lresources.pp"/>
<Line Value="2114"/>
</Item3>
<Item4>
<Source Value="..\..\source\lazarus\lcl\lresources.pp"/>
<Line Value="2176"/>
</Item4>
<Item5>
<Source Value="..\..\source\lazarus\lcl\lresources.pp"/>
<Line Value="1075"/>
</Item5>
<Item6>
<Source Value="..\..\source\lazarus\lcl\lresources.pp"/>
<Line Value="1077"/>
</Item6>
<Item7>
<Source Value="..\..\source\lazarus\ide\main.pp"/>
<Line Value="9215"/>
</Item7>
<Item8>
<Source Value="..\..\source\lazarus\lcl\lresources.pp"/>
<Line Value="2530"/>
</Item8>
</BreakPoints>
<Watches Count="1">
<Item1>
<Expression Value="name"/>
</Item1>
</Watches>
<Exceptions Count="1">
<Item1>
<Name Value="EAssertionFailedError"/>
</Item1>
</Exceptions>
</Debugging>
</CONFIG>

163
test/runtests.lpr Normal file
View File

@ -0,0 +1,163 @@
program runtests;
{$mode objfpc}{$H+}
uses
custapp, Classes, SysUtils, fpcunit, testregistry,
dom, testreport, xmlreporter, xmlwrite,
TestLpi;
const
ShortOpts = 'alh';
Longopts: array[1..5] of string = ('all', 'list', 'format:', 'suite:', 'help');
Version = 'Version 0.1';
type
TFormat = (fPlain, fLatex, fXML);
TTestRunner = class(TCustomApplication)
private
protected
procedure DoRun; override;
procedure doTestRun(aTest: TTest); virtual;
public
end;
var
FormatParam: TFormat;
procedure TTestRunner.doTestRun(aTest: TTest);
var
testResult: TTestResult;
procedure doXMLTestRun(aTest: TTest);
var
XMLResultsWriter: TXMLResultsWriter;
begin
try
XMLResultsWriter := TXMLResultsWriter.Create;
testResult.AddListener(XMLResultsWriter);
aTest.Run(testResult);
XMLResultsWriter.WriteResult(testResult);
XMLResultsWriter.Document.StylesheetType := 'text/xsl';
XMLResultsWriter.Document.StylesheetHRef := 'results.xsl';
WriteXMLFile(XMLResultsWriter.Document, output);
finally
XMLResultsWriter.Free;
testResult.Free;
end;
end;
{$IFNDEF VER2_0}
procedure doPlainTestRun(aTest: TTest);
var
PlainResultsWriter: TPlainResultsWriter;
begin
try
PlainResultsWriter := TPlainResultsWriter.Create;
testResult.AddListener(PlainResultsWriter);
PlainResultsWriter.WriteHeader;
aTest.Run(testResult);
PlainResultsWriter.WriteResult(testResult);
finally
PlainResultsWriter.Free;
testResult.Free;
end;
end;
{$ENDIF}
begin
testResult := TTestResult.Create;
case FormatParam of
fLatex: doXMLTestRun(aTest); //no latex implemented yet
{$IFNDEF VER2_0}
fPlain: doPlainTestRun(aTest);
{$ENDIF}
else
doXMLTestRun(aTest);
end;
end;
procedure TTestRunner.DoRun;
var
I: integer;
S: string;
begin
S := CheckOptions(ShortOpts, LongOpts);
if (S <> '') then
Writeln(S);
if HasOption('h', 'help') or (ParamCount = 0) then
begin
writeln(Title);
writeln(Version);
writeln;
writeln('Usage: ');
writeln(' --format=latex output as latex source (only list implemented)');
{$IFNDEF VER2_0}
writeln(' --format=plain output as plain ASCII source');
{$ENDIF}
writeln(' --format=xml output as XML source (default)');
writeln;
writeln(' -l or --list show a list of registered tests');
writeln(' -a or --all run all tests');
writeln(' --suite=MyTestSuiteName run single test suite class');
writeln;
writeln('The results can be redirected to an xml file,');
writeln('for example: ./testrunner --all > results.xml');
end;
//get the format parameter
FormatParam := fXML;
if HasOption('format') then
begin
if GetOptionValue('format') = 'latex' then
FormatParam := fLatex;
{$IFNDEF VER2_0}
if GetOptionValue('format') = 'plain' then
FormatParam := fPlain;
{$ENDIF}
end;
//get a list of all registed tests
if HasOption('l', 'list') then
case FormatParam of
fLatex: Write(GetSuiteAsLatex(GetTestRegistry));
{$IFNDEF VER2_0}
fPlain: Write(GetSuiteAsPlain(GetTestRegistry));
{$ENDIF}
else
Write(GetSuiteAsXML(GetTestRegistry));
end;
//run the tests
if HasOption('a', 'all') then
doTestRun(GetTestRegistry)
else
if HasOption('suite') then
begin
S := '';
S := GetOptionValue('suite');
if S = '' then
for I := 0 to GetTestRegistry.Tests.Count - 1 do
writeln(GetTestRegistry[i].TestName)
else
for I := 0 to GetTestRegistry.Tests.Count - 1 do
if GetTestRegistry[i].TestName = S then
doTestRun(GetTestRegistry[i]);
end;
Terminate;
end;
var
App: TTestRunner;
begin
App := TTestRunner.Create(nil);
App.Initialize;
App.Title := 'FPCUnit Console Test Case runner.';
App.Run;
App.Free;
end.

77
test/runtestsgui.lpi Normal file
View File

@ -0,0 +1,77 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="\"/>
<Version Value="5"/>
<General>
<SessionStorage Value="InIDEConfig"/>
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=".exe"/>
<Title Value="Run Lazarus tests"/>
</General>
<VersionInfo>
<UseVersionInfo Value="False"/>
<AutoIncrementBuild Value="False"/>
<CurrentVersionNr Value="0"/>
<CurrentMajorRevNr Value="0"/>
<CurrentMinorRevNr Value="0"/>
<CurrentBuildNr Value="0"/>
<ProjectVersion Value="1,0,0,0"/>
<Language Value="0409"/>
<CharSet Value="04E4"/>
<Comments Value=""/>
<CompanyName Value=""/>
<FileDescription Value=""/>
<InternalName Value=""/>
<LegalCopyright Value=""/>
<LegalTrademarks Value=""/>
<OriginalFilename Value=""/>
<ProductName Value=""/>
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="3">
<Item1>
<PackageName Value="LCL"/>
</Item1>
<Item2>
<PackageName Value="FPCUnitTestRunner"/>
</Item2>
<Item3>
<PackageName Value="FCL"/>
</Item3>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="runtestsgui.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="runtestsgui"/>
</Unit0>
<Unit1>
<Filename Value="testlpi.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="TestLpi"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<PathDelim Value="\"/>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</CONFIG>

14
test/runtestsgui.lpr Normal file
View File

@ -0,0 +1,14 @@
program runtestsgui;
{$mode objfpc}{$H+}
uses
Interfaces, Forms, GuiTestRunner, TestLpi;
begin
Application.Title:='Run Lazarus tests';
Application.Initialize;
Application.CreateForm(TGuiTestRunner, TestRunner);
Application.Run;
end.

98
test/testlpi.pas Normal file
View File

@ -0,0 +1,98 @@
unit TestLpi;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fpcunit, testutils, testregistry, process,
FileUtil;
type
{ TLpiTest }
TLpiTest= class(TTestCase)
private
FPath: string;
public
constructor Create(const APath: string; const ATestName: string); overload;
class function Suite(const APath: string): TTestSuite;
class function ExamplesSuite: TTestSuite;
published
procedure TestCompile;
procedure TestRun;
end;
implementation
var
LazarusDir: string;
ExamplesDir: string;
procedure InitDirectories;
begin
LazarusDir := ExpandFileName(ExtractFilePath(ParamStr(0)) + '../');
ExamplesDir := LazarusDir + 'examples' + PathDelim;
end;
constructor TLpiTest.Create(const APath: string; const ATestName: string);
begin
inherited CreateWithName(ATestName);
FPath := APath;
end;
class function TLpiTest.Suite(const APath: string): TTestSuite;
begin
Result := TTestSuite.Create(APath);
Result.AddTest(TLpiTest.Create(APath, 'TestCompile'));
end;
class function TLpiTest.ExamplesSuite: TTestSuite;
var
SearchMask: String;
FileInfo: TSearchRec;
begin
Result := TTestSuite.Create('Examples');
SearchMask := ExamplesDir + '*.lpi';
writeln(stdout, SearchMask+LineEnding);
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);
end;
procedure TLpiTest.TestCompile;
var
LazBuildPath: string;
LazBuild: TProcess;
begin
LazBuildPath := LazarusDir + 'lazbuild' + GetExeExt;
AssertTrue(LazBuildPath + ' does not exist', FileExists(LazBuildPath));
LazBuild := TProcess.Create(nil);
try
LazBuild.Options := [poNewConsole];
LazBuild.ShowWindow := swoHIDE;
LazBuild.CommandLine := LazBuildPath + ' ' + FPath;
LazBuild.CurrentDirectory := ExtractFileDir(FPath);
LazBuild.Execute;
LazBuild.WaitOnExit;
AssertEquals('Compilation failed: ExitCode', 0, LazBuild.ExitStatus);
finally
LazBuild.Free;
end;
end;
procedure TLpiTest.TestRun;
begin
end;
initialization
InitDirectories;
GetTestRegistry.AddTest(TLpiTest.ExamplesSuite);
end.