diff --git a/.gitattributes b/.gitattributes index 87975d9332..fa56d0a75c 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/components/fpcunit/console/consoletestrunner.pas b/components/fpcunit/console/consoletestrunner.pas index 52aa4a5581..6276fda883 100644 --- a/components/fpcunit/console/consoletestrunner.pas +++ b/components/fpcunit/console/consoletestrunner.pas @@ -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= add stylesheet reference'); writeln(' --file= 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; diff --git a/components/fpcunit/console/fpcunit.xsl b/components/fpcunit/console/fpcunit.xsl new file mode 100644 index 0000000000..fdbb7090dc --- /dev/null +++ b/components/fpcunit/console/fpcunit.xsl @@ -0,0 +1,206 @@ + + + + + + + + + <xsl:value-of select="$title"/> + + + + + + + +
+ fpcUnit Report 0.3.0 © 2006 by + Graeme Geldenhuys.

+ Licensed under the GNU General Public License.

+ Modified by Vincent Snijders.

+
+ + + + + + + + + + + + + +

+

Summary

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
NameTestsFailuresErrorsElapsed TimeRun Date
Summary
Summary
Summary
+ +

Note: Failures are anticipated and checked for with assertions. Errors are +unexpected results.

+
+ + + + + + + + +
+ +

Test Listing

+

+ [Summary] + [Test Listing] + [Failures] + [Errors] +

+ + + + + + + + + + + + + + +
NameElapsed Time
(hh:mm:ss.zzz)
+
+ + + + + +
+ +

Failures:

+

+ [Summary] + [Test Listing] + [Failures] + [Errors] +

+ +

+ [Back to top] +

+ + + + + + + + + + + + + + +
Message:
Exception Class:
Exception Message:
+ +
+ + + + + +
+ +

Errors

+

+ [Summary] + [Test Listing] + [Failures] + [Errors] +

+ +

+ [Back to top] +

+ + + + + + + + + + + + + + + + + + + + + + + + + + +
Message:
Exception Class:
Exception Message:
UnitName:
LineNumber:
Method Name:
+ +
+ + + + + diff --git a/components/fpcunit/ide/fpcunitproject1.inc b/components/fpcunit/ide/fpcunitproject1.inc index 18a8a4b503..80ec8ee27e 100644 --- a/components/fpcunit/ide/fpcunitproject1.inc +++ b/components/fpcunit/ide/fpcunitproject1.inc @@ -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 ; diff --git a/components/fpcunit/ide/fpcunitproject1.pas b/components/fpcunit/ide/fpcunitproject1.pas index c458e3edfe..3517a318a9 100644 --- a/components/fpcunit/ide/fpcunitproject1.pas +++ b/components/fpcunit/ide/fpcunitproject1.pas @@ -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. diff --git a/test/runtests.lpi b/test/runtests.lpi index ff270a9ef4..51cf4fd280 100644 --- a/test/runtests.lpi +++ b/test/runtests.lpi @@ -23,16 +23,16 @@ - + - + - + @@ -43,6 +43,11 @@ + + + + + diff --git a/test/runtests.lpr b/test/runtests.lpr index bbbfae95d0..488c8de2fa 100644 --- a/test/runtests.lpr +++ b/test/runtests.lpr @@ -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;