mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-10-20 21:46:00 +02:00
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:
parent
45523c4fd1
commit
8a29f2f36c
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -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
|
||||
|
@ -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;
|
||||
|
206
components/fpcunit/console/fpcunit.xsl
Normal file
206
components/fpcunit/console/fpcunit.xsl
Normal 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 > 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 > 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>
|
@ -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
|
||||
;
|
||||
|
@ -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.
|
||||
|
@ -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>
|
||||
|
@ -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;
|
||||
|
Loading…
Reference in New Issue
Block a user