fpc unit console runner:

* fixed memleak with long options
+ added stylesheet parameter
+ added example stylesheet
* renamed App to Appliction, so Lazarus can set the Application.Title

git-svn-id: trunk@10183 -
This commit is contained in:
vincents 2006-11-10 06:52:18 +00:00
parent 45523c4fd1
commit 8a29f2f36c
7 changed files with 281 additions and 30 deletions

1
.gitattributes vendored
View File

@ -145,6 +145,7 @@ components/fpcunit/Makefile svneol=native#text/plain
components/fpcunit/Makefile.fpc svneol=native#text/plain
components/fpcunit/blueball.xpm svneol=native#text/plain
components/fpcunit/console/consoletestrunner.pas svneol=native#text/plain
components/fpcunit/console/fpcunit.xsl svneol=native#text/plain
components/fpcunit/console/fpcunitconsolerunner.lpk svneol=native#text/plain
components/fpcunit/console/fpcunitconsolerunner.pas svneol=native#text/plain
components/fpcunit/fpcunittestrunner.lpk svneol=native#text/pascal

View File

@ -25,7 +25,7 @@ interface
uses
custapp, Classes, SysUtils, fpcunit, testregistry, testreport, testutils,
xmlreporter, xmlwrite;
dom, xmlreporter, xmlwrite;
const
Version = '0.2';
@ -39,25 +39,31 @@ type
private
FShowProgress: boolean;
FFileName: string;
FStyleSheet: string;
FLongOpts: TStrings;
protected
property FileName: string read FFileName write FFileName;
property LongOpts: TStrings read FLongOpts write FLongOpts;
property ShowProgress: boolean read FShowProgress write FShowProgress;
property StyleSheet: string read FStyleSheet write FStyleSheet;
procedure DoRun; override;
procedure doTestRun(aTest: TTest); virtual;
function GetShortOpts: string; virtual;
function GetLongOpts: TStrings; virtual;
procedure AppendLongOpts; virtual;
procedure WriteCustomHelp; virtual;
procedure ParseOptions; virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
implementation
const
ShortOpts = 'alhp';
LongOpts: array[1..7] of string =
DefaultLongOpts: array[1..8] of string =
('all', 'list', 'progress', 'help',
'suite:', 'format:', 'file:');
'suite:', 'format:', 'file:', 'stylesheet:');
{ TProgressWriter }
type
@ -115,14 +121,27 @@ var
procedure doXMLTestRun(aTest: TTest);
var
XMLResultsWriter: TXMLResultsWriter;
procedure ExtendDocument(Doc: TXMLDocument);
var
n: TDOMElement;
begin
if StyleSheet<>'' then begin
Doc.StylesheetType := 'text/xsl';
Doc.StylesheetHRef := StyleSheet;
end;
n := Doc.CreateElement('Title');
n.AppendChild(Doc.CreateTextNode(Title));
Doc.FirstChild.AppendChild(n);
end;
begin
try
XMLResultsWriter := TXMLResultsWriter.Create;
testResult.AddListener(XMLResultsWriter);
aTest.Run(testResult);
XMLResultsWriter.WriteResult(testResult);
XMLResultsWriter.Document.StylesheetType := 'text/xsl';
XMLResultsWriter.Document.StylesheetHRef := 'results.xsl';
ExtendDocument(XMLResultsWriter.Document);
if FileName<>'' then
WriteXMLFile(XMLResultsWriter.Document, FileName)
else
@ -133,6 +152,7 @@ var
end;
end;
{$IFNDEF VER2_0}
procedure doPlainTestRun(aTest: TTest);
var
PlainResultsWriter: TPlainResultsWriter;
@ -148,6 +168,7 @@ var
testResult.Free;
end;
end;
{$ENDIF}
begin
testResult := TTestResult.Create;
@ -175,13 +196,12 @@ begin
Result := ShortOpts;
end;
function TTestRunner.GetLongOpts: TStrings;
procedure TTestRunner.AppendLongOpts;
var
i: Integer;
begin
Result := TStringList.Create;
for i := low(LongOpts) to high(LongOpts) do
Result.Add(LongOpts[i]);
for i := low(DefaultLongOpts) to high(DefaultLongOpts) do
LongOpts.Add(DefaultLongOpts[i]);
end;
procedure TTestRunner.WriteCustomHelp;
@ -198,8 +218,11 @@ begin
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(' --stylesheet=<reference> add stylesheet reference');
writeln(' --file=<filename> output results to file');
writeln;
writeln(' -l or --list show a list of registered tests');
@ -226,6 +249,21 @@ begin
if HasOption('file') then
FileName := GetOptionValue('file');
if HasOption('stylesheet') then
StyleSheet := GetOptionValue('stylesheet');
end;
constructor TTestRunner.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FLongOpts := TStringList.Create;
AppendLongOpts;
end;
destructor TTestRunner.Destroy;
begin
FLongOpts.Free;
inherited Destroy;
end;
procedure TTestRunner.DoRun;
@ -233,7 +271,7 @@ var
I: integer;
S: string;
begin
S := CheckOptions(GetShortOpts, GetLongOpts);
S := CheckOptions(GetShortOpts, LongOpts);
if (S <> '') then
Writeln(S);
@ -243,7 +281,9 @@ begin
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;

View File

@ -0,0 +1,206 @@
<?xml version="1.0"?>
<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
<xsl:output method="html" encoding="UTF-8"/>
<xsl:template match="/">
<xsl:variable name="title" select="TestResults/Title" />
<html>
<head>
<title><xsl:value-of select="$title"/></title>
<style type="text/css" title="fpcUnit" media="screen">
@import "fpcunit.css";
</style>
</head>
<body>
<a name="Summary"></a>
<xsl:apply-templates/>
<address>
<a href="http://opensoft.homeip.net">fpcUnit Report</a> 0.3.0 © 2006 by
<a href="mailto:graemeg@gmail.com?subject=Comments about fpcUnit Report">Graeme Geldenhuys</a>.<br></br>
Licensed under the <a href="http://www.gnu.org/copyleft/gpl.html">GNU General Public License</a>.<br></br>
Modified by Vincent Snijders.<br></br>
</address>
</body>
</html>
</xsl:template>
<xsl:template match="TestResults">
<xsl:variable name="runnedCount" select="NumberOfRunTests" />
<xsl:variable name="failureCount" select="NumberOfFailures" />
<xsl:variable name="errorCount" select="NumberOfErrors" />
<xsl:variable name="elapsedTime" select="TotalElapsedTime" />
<xsl:variable name="dateRan" select="DateTimeRan" />
<xsl:variable name="title" select="Title" />
<h2><xsl:value-of select="$title"/></h2>
<h3>Summary</h3>
<!-- Summary Table -->
<table border="0" rules="none" width="100%">
<tr align="left" class="title">
<th width="45%" align="left">Name</th>
<th width="7%" align="left">Tests</th>
<th width="8%" align="left">Failures</th>
<th width="8%" align="left">Errors</th>
<th width="11%" align="left">Elapsed Time</th>
<th width="14%" align="left">Run Date</th>
</tr>
<xsl:choose>
<xsl:when test="$errorCount &gt; 0">
<tr class="error">
<td>Summary</td>
<td><xsl:value-of select="$runnedCount"/></td>
<td><xsl:value-of select="$failureCount"/></td>
<td><xsl:value-of select="$errorCount"/></td>
<td><xsl:value-of select="$elapsedTime"/></td>
<td><xsl:value-of select="$dateRan"/></td>
</tr>
</xsl:when>
<xsl:when test="$failureCount &gt; 0">
<tr class="failure">
<td>Summary</td>
<td><xsl:value-of select="$runnedCount"/></td>
<td><xsl:value-of select="$failureCount"/></td>
<td><xsl:value-of select="$errorCount"/></td>
<td><xsl:value-of select="$elapsedTime"/></td>
<td><xsl:value-of select="$dateRan"/></td>
</tr>
</xsl:when>
<xsl:otherwise>
<tr class="success">
<td>Summary</td>
<td><xsl:value-of select="$runnedCount"/></td>
<td><xsl:value-of select="$failureCount"/></td>
<td><xsl:value-of select="$errorCount"/></td>
<td><xsl:value-of select="$elapsedTime"/></td>
<td><xsl:value-of select="$dateRan"/></td>
</tr>
</xsl:otherwise>
</xsl:choose>
</table>
<p>Note: <i>Failures</i> are anticipated and checked for with assertions. <i>Errors</i> are
unexpected results.</p>
<hr></hr>
<xsl:call-template name="test_listing"/>
<xsl:call-template name="test_failures"/>
<xsl:call-template name="test_errors"/>
</xsl:template>
<xsl:template name="test_listing">
<div id="testlisting">
<a name="Test_Listing"></a>
<h3>Test Listing</h3>
<p>
[<a href="#Summary">Summary</a>]
[<a href="#Test_Listing">Test Listing</a>]
[<a href="#Failures">Failures</a>]
[<a href="#Errors">Errors</a>]
</p>
<!-- Test Listing Table -->
<table border="0" rules="none" width="100%">
<tr align="left" class="title">
<th width="89%" align="left">Name</th>
<th width="11%" align="left">Elapsed Time<br/>(hh:mm:ss.zzz)</th>
</tr>
<xsl:for-each select="TestListing/Test">
<xsl:variable name="testName" select="@Name" />
<xsl:variable name="elapsedTime" select="ElapsedTime" />
<tr class="success">
<td><xsl:value-of select="$testName"/></td>
<td><xsl:value-of select="ElapsedTime"/></td>
</tr>
</xsl:for-each>
</table>
</div> <!-- testlisting -->
</xsl:template>
<xsl:template name="test_failures">
<div id="failures">
<a name="Failures"></a>
<h3>Failures:</h3>
<p>
[<a href="#Summary">Summary</a>]
[<a href="#Test_Listing">Test Listing</a>]
[<a href="#Failures">Failures</a>]
[<a href="#Errors">Errors</a>]
</p>
<xsl:for-each select="ListOfFailures/Failure">
<p class="backToTop">
[<a href="#Failures">Back to top</a>]
</p>
<table>
<!-- Error Table Body -->
<TR>
<TD valign="top" class="title" width="300">Message:</TD>
<TD valign="top" class="resultmessage"><xsl:value-of select="Message" /></TD>
</TR>
<TR>
<TD valign="top" class="title">Exception Class:</TD>
<TD valign="top" class="resultmessage"><xsl:value-of select="ExceptionClass" /></TD>
</TR>
<TR>
<TD valign="top" class="title">Exception Message:</TD>
<TD valign="top" class="resultmessage"><xsl:value-of select="ExceptionMessage" /></TD>
</TR>
</table>
</xsl:for-each>
</div> <!-- failures -->
</xsl:template>
<xsl:template name="test_errors">
<div id="errors">
<a name="Errors"></a>
<h3>Errors</h3>
<p>
[<a href="#Summary">Summary</a>]
[<a href="#Test_Listing">Test Listing</a>]
[<a href="#Failures">Failures</a>]
[<a href="#Errors">Errors</a>]
</p>
<xsl:for-each select="ListOfErrors/Error">
<p class="backToTop">
[<a href="#Errors">Back to top</a>]
</p>
<table>
<!-- Error Table Body -->
<TR>
<TD valign="top" class="title" width="300">Message:</TD>
<TD valign="top" class="resultmessage"><xsl:value-of select="Message" /></TD>
</TR>
<TR>
<TD valign="top" class="title">Exception Class:</TD>
<TD valign="top" class="resultmessage"><xsl:value-of select="ExceptionClass" /></TD>
</TR>
<TR>
<TD valign="top" class="title">Exception Message:</TD>
<TD valign="top" class="resultmessage"><xsl:value-of select="ExceptionMessage" /></TD>
</TR>
<TR>
<TD valign="top" class="title">UnitName:</TD>
<TD valign="top" class="resultmessage"><xsl:value-of select="SourceUnitName" /></TD>
</TR>
<TR>
<TD valign="top" class="title">LineNumber:</TD>
<TD valign="top" class="resultmessage"><xsl:value-of select="LineNumber" /></TD>
</TR>
<TR>
<TD valign="top" class="title">Method Name:</TD>
<TD valign="top" class="resultmessage"><xsl:value-of select="FailedMethodName" /></TD>
</TR>
</table>
</xsl:for-each>
</div> <!-- errors -->
</xsl:template>
</xsl:stylesheet>

View File

@ -16,13 +16,13 @@ NewSource :=
+ ' end;' + #13
+ #13
+ 'var' + #13
+ ' App: TMyTestRunner;' + #13
+ ' Application: TMyTestRunner;' + #13
+ #13
+ 'begin' + #13
+ ' App := TMyTestRunner.Create(nil);' + #13
+ ' App.Initialize;' + #13
+ ' App.Title := ''FPCUnit Console test runner'';' + #13
+ ' App.Run;' + #13
+ ' App.Free;' + #13
+ ' Application := TMyTestRunner.Create(nil);' + #13
+ ' Application.Initialize;' + #13
+ ' Application.Title := ''FPCUnit Console test runner'';' + #13
+ ' Application.Run;' + #13
+ ' Application.Free;' + #13
+ 'end.' + #13
;

View File

@ -15,12 +15,12 @@ type
end;
var
App: TMyTestRunner;
Application: TMyTestRunner;
begin
App := TMyTestRunner.Create(nil);
App.Initialize;
App.Title := 'FPCUnit Console test runner';
App.Run;
App.Free;
Application := TMyTestRunner.Create(nil);
Application.Initialize;
Application.Title := 'FPCUnit Console test runner';
Application.Run;
Application.Free;
end.

View File

@ -23,16 +23,16 @@
</RunParams>
<RequiredPackages Count="3">
<Item1>
<PackageName Value="fpcunitconsolerunner"/>
<PackageName Value="LCL"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
<PackageName Value="fpcunitconsolerunner"/>
</Item2>
<Item3>
<PackageName Value="FCL"/>
</Item3>
</RequiredPackages>
<Units Count="2">
<Units Count="3">
<Unit0>
<Filename Value="runtests.lpr"/>
<IsPartOfProject Value="True"/>
@ -43,6 +43,11 @@
<IsPartOfProject Value="True"/>
<UnitName Value="TestLpi"/>
</Unit1>
<Unit2>
<Filename Value="..\components\fpcunit\console\fpcunitproject1.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="FPCUnitProject1"/>
</Unit2>
</Units>
</ProjectOptions>
<CompilerOptions>

View File

@ -29,17 +29,16 @@ type
TLazTestRunner = class(TTestRunner)
protected
function GetLongOpts: TStrings; override;
procedure AppendLongOpts; override;
procedure ParseOptions; override;
procedure WriteCustomHelp; override;
end;
{ TLazTestRunner }
function TLazTestRunner.GetLongOpts: TStrings;
procedure TLazTestRunner.AppendLongOpts;
begin
Result:=inherited GetLongOpts;
Result.Add('compiler:');
LongOpts.Add('compiler:');
end;
procedure TLazTestRunner.ParseOptions;