From b6ba87bed489e5eedaf9cc7e84b938a5c700293d Mon Sep 17 00:00:00 2001 From: Joost van der Sluis Date: Thu, 30 Dec 2021 01:34:41 +0100 Subject: [PATCH] * Add Ant/JUnit alike XML test-output format --- packages/fcl-fpcunit/fpmake.pp | 7 + .../fcl-fpcunit/src/consoletestrunner.pas | 7 +- packages/fcl-fpcunit/src/junittestreport.pp | 283 ++++++++++++++++++ 3 files changed, 295 insertions(+), 2 deletions(-) create mode 100644 packages/fcl-fpcunit/src/junittestreport.pp diff --git a/packages/fcl-fpcunit/fpmake.pp b/packages/fcl-fpcunit/fpmake.pp index 9bd78eedad..49cde7f446 100644 --- a/packages/fcl-fpcunit/fpmake.pp +++ b/packages/fcl-fpcunit/fpmake.pp @@ -105,6 +105,13 @@ begin AddUnit('fpcunitreport'); AddUnit('testutils'); end; + T:=P.Targets.AddUnit('junittestreport.pp'); + with T.Dependencies do + begin + AddUnit('fpcunit'); + AddUnit('fpcunitreport'); + AddUnit('testutils'); + end; T:=P.Targets.AddUnit('consoletestrunner.pas'); with T.Dependencies do begin diff --git a/packages/fcl-fpcunit/src/consoletestrunner.pas b/packages/fcl-fpcunit/src/consoletestrunner.pas index c0e459aa1e..637ec6e881 100644 --- a/packages/fcl-fpcunit/src/consoletestrunner.pas +++ b/packages/fcl-fpcunit/src/consoletestrunner.pas @@ -26,13 +26,13 @@ interface uses custapp, Classes, SysUtils, fpcunit, testregistry, testutils, fpcunitreport, latextestreport, xmltestreport, plaintestreport, - dom; + junittestreport, dom; const Version = '0.3'; type - TFormat = (fPlain, fLatex, fXML, fPlainNoTiming); + TFormat = (fPlain, fLatex, fXML, fPlainNoTiming, fJUnit); TRunMode = (rmUnknown,rmList,rmSuite,rmAll); var @@ -237,6 +237,7 @@ begin 'plain': Result:=fPlain; 'plainnotiming': Result:=fPlainNoTiming; 'xml': Result:=fXML; + 'junit': Result:=fJUnit; else Raise EConvertError.CreateFmt('Not a valid output format : "%s"',[S]); end; @@ -248,6 +249,7 @@ begin fLatex: Result := TLatexResultsWriter.Create(nil); fPlain: Result := TPlainResultsWriter.Create(nil); fPlainNotiming: Result := TPlainResultsWriter.Create(nil); + fJUnit: Result := TJUnitResultsWriter.Create(nil) else begin Result := TXmlResultsWriter.Create(nil); @@ -317,6 +319,7 @@ begin writeln(' plain output as plain ASCII source'); writeln(' plainnotiming output as plain ASCII source, skip timings'); writeln(' xml output as XML source (default)'); + writeln(' junit output as JUnit compatible XML source'); writeln(' --skiptiming Do not output timings (useful for diffs of testruns)'); writeln(' --sparse Produce Less output (errors/failures only)'); writeln(' --no-addresses Do not display address info'); diff --git a/packages/fcl-fpcunit/src/junittestreport.pp b/packages/fcl-fpcunit/src/junittestreport.pp new file mode 100644 index 0000000000..223157eede --- /dev/null +++ b/packages/fcl-fpcunit/src/junittestreport.pp @@ -0,0 +1,283 @@ +{ + This file is part of the Free Component Library (FCL) + Copyright (c) 2021 by Joost van der Sluis (CNOC) + + An example of an XML report writer for FPCUnit tests. + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + ********************************************************************** + + + Purpose: + This unit contains a XML/JUnit TestListener for use with the fpcUnit testing + framework. It uses the XMLWrite unit (part of FPC) to generate + the XML document. + The output is compatible to the output that the Ant JUnit task produces. + This format is used by a lot of third-party tools to examine test results. + + The XSD found at https://github.com/windyroad/JUnit-Schema is used as a + guideline for the format. + + Notes: + Specify 'null' as the filename if you don't want to output to file (e.g. + used by the GUI test runner which instead reads the Document property). + +} + +unit junittestreport; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils,fpcunit, fpcunitreport, dom, XMLWrite, + {$ifdef unix}unix,{$endif} + DateUtils; + + +type + + { TJUnitResultsWriter } + + TJUnitResultsWriter = class(TCustomResultsWriter) + private + FDoc: TXMLDocument; + // When there are no suites, create an artificial one and add it to the root + // of the XML-document. + // JvdS: I do not know if this can ever happens, but the TXMLResultsWriter + // has similar logic... + FSingleSuite: TDOMElement; + // When there are suites, create a list of suites and add it to the root + // of the XML-document. + FMultipleSuites: TDOMElement; + FSuitePath: TFPList; + FCurrentTest: TDOMElement; + FTestSuiteCount: Integer; + // The result (testsuites) is flattened, so we have to keep our own count. + FTestCount: Integer; + FFailureCount: Integer; + FIgnoreCount: Integer; + FErrorCount: Integer; + protected + function GetSingleSuiteElement: TDOMElement; + function GetMultipleSuitesElement: TDOMElement; + function GetCurrentElement: TDOMElement; + procedure WriteTestHeader(ATest: TTest; ALevel: integer; ACount: integer); override; + procedure WriteTestFooter(ATest: TTest; ALevel: integer; ATiming: TDateTime); override; + procedure WriteSuiteHeader(ATestSuite: TTestSuite; ALevel: integer); override; + procedure WriteSuiteFooter(ATestSuite: TTestSuite; ALevel: integer; + ATiming: TDateTime; ANumRuns: integer; ANumErrors: integer; + ANumFailures: integer; ANumIgnores: integer); override; + public + constructor Create(aOwner: TComponent); override; + destructor Destroy; override; + procedure WriteHeader; override; + procedure AddFailure(ATest: TTest; AFailure: TTestFailure); override; + procedure AddError(ATest: TTest; AError: TTestFailure); override; + procedure WriteResult(aResult: TTestResult); override; + { A public property to the internal XML document } + property Document: TXMLDocument read FDoc; + end; + +implementation + +{ TJUnitResultsWriter } + +function TJUnitResultsWriter.GetCurrentElement: TDOMElement; +begin + if Assigned(FCurrentTest) then + Result := FCurrentTest + else if FSuitePath.Count > 0 then + //test is included in a suite + Result := TDOMElement(FSuitePath[FSuitePath.Count -1]) + else + //no suite to append so append it to the single-suite element + Result := GetSingleSuiteElement; +end; + +procedure TJUnitResultsWriter.WriteTestHeader(ATest: TTest; ALevel: integer; ACount: integer); +var + n: TDOMElement; +begin + inherited; + n := FDoc.CreateElement('testcase'); + n['name'] := ATest.TestName; + n['classname'] := ATest.ClassName; + if FSuitePath.Count > 0 then + // test is included in a suite + TDOMElement(FSuitePath[FSuitePath.Count -1]).AppendChild(n) + else + // no suite to append so append to the artificial suite + GetSingleSuiteElement.AppendChild(n); + FCurrentTest := n; + Inc(FTestCount); +end; + +procedure TJUnitResultsWriter.WriteTestFooter(ATest: TTest; ALevel: integer; ATiming: TDateTime); +begin + inherited; + if not SkipTiming then + FCurrentTest['time'] := FloatToStrF(ATiming * SecsPerDay, ffFixed, 1, 3); +end; + + +procedure TJUnitResultsWriter.WriteSuiteHeader(ATestSuite: TTestSuite; ALevel: integer); +var + n: TDOMElement; + s: string; +begin + inherited; + n := FDoc.CreateElement('testsuite'); + FSuitePath.Add(n); + n['name'] := ATestSuite.TestSuiteName; + n['timestamp'] := DateToISO8601(NowUTC); + {$ifdef unix} + s := GetHostName; + if s = '' then + s := 'localhost'; + n['hostname'] := s; + {$endif} + n['id'] := IntToStr(FTestSuiteCount); + Inc(FTestSuiteCount); + GetMultipleSuitesElement.AppendChild(n); + + FTestCount := 0; + FIgnoreCount := 0; + FErrorCount := 0; + FFailureCount := 0; +end; + + +procedure TJUnitResultsWriter.WriteSuiteFooter(ATestSuite: TTestSuite; ALevel: integer; + ATiming: TDateTime; ANumRuns: integer; ANumErrors: integer; ANumFailures: integer; + ANumIgnores: integer); +var + n: TDOMElement; +begin + inherited; + + n := TDomElement(FSuitePath[FSuitePath.Count -1]); + if n.ChildNodes.Count = 0 then + begin + // some testsuites only contain child testsuites. Those are omitted from the XML. + n.Free; + end + else + begin + n['tests'] := IntToStr(FTestCount); + n['failures'] := IntToStr(FFailureCount); + n['errors'] := IntToStr(FErrorCount); + n['skipped'] := IntToStr(FIgnoreCount); + if not SkipTiming then + n['time'] := FloatToStrF(ATiming * SecsPerDay, ffFixed, 1, 3); + end; + FSuitePath.Delete(FSuitePath.Count -1); +end; + +constructor TJUnitResultsWriter.Create(aOwner: TComponent); +begin + inherited Create(aOwner); + FDoc:= TXMLDocument.Create; + FSuitePath := TFPList.Create; +end; + +destructor TJUnitResultsWriter.Destroy; +begin + FSingleSuite := nil; + FMultipleSuites := nil; + FSuitePath.Free; + FDoc.Free; + inherited Destroy; +end; + + +procedure TJUnitResultsWriter.WriteHeader; +begin + inherited; + FTestSuiteCount := 0; +end; + +procedure TJUnitResultsWriter.AddFailure(ATest: TTest; AFailure: TTestFailure); +var + CurrentElement: TDOMElement; +begin + inherited; + CurrentElement := GetCurrentElement; + if AFailure.IsIgnoredTest then + begin + CurrentElement.AppendChild(FDoc.CreateElement('skipped')); + Inc(FIgnoreCount); + end + else + begin + CurrentElement := CurrentElement.AppendChild(FDoc.CreateElement('failure')) as TDOMElement; + + CurrentElement.AppendChild(FDoc.CreateElement('message')).AppendChild + (FDoc.CreateTextNode(AFailure.ExceptionMessage)); + CurrentElement.AppendChild(FDoc.CreateElement('name')).AppendChild + (FDoc.CreateTextNode(AFailure.ExceptionClassName)); + CurrentElement.AppendChild(FDoc.CreateTextNode(AFailure.AsString)); + Inc(FFailureCount); + end; +end; + +procedure TJUnitResultsWriter.AddError(ATest: TTest; AError: TTestFailure); +var + CurrentElement: TDOMElement; +begin + inherited; + CurrentElement := GetCurrentElement; + CurrentElement := CurrentElement.AppendChild(FDoc.CreateElement('error')) as TDOMElement; + + CurrentElement.AppendChild(FDoc.CreateElement('message')).AppendChild + (FDoc.CreateTextNode(AError.ExceptionMessage)); + CurrentElement.AppendChild(FDoc.CreateElement('name')).AppendChild + (FDoc.CreateTextNode(AError.ExceptionClassName)); + CurrentElement.AppendChild(FDoc.CreateTextNode(AError.AsString)); + Inc(FErrorCount); +end; + +procedure TJUnitResultsWriter.WriteResult(aResult: TTestResult); +var + f: text; +begin + // This is so that the GUI Test Runner doesn't output text as well. + if FileName <> 'null' then + begin + system.Assign(f, FileName); + rewrite(f); + WriteXMLFile(FDoc, f); + close(f); + end; +end; + +function TJUnitResultsWriter.GetSingleSuiteElement: TDOMElement; +begin + if not Assigned(FSingleSuite) then + begin + FSingleSuite := FDoc.CreateElement('testsuite'); + FSingleSuite['timestamp'] := DateToISO8601(NowUTC); + FDoc.AppendChild(FSingleSuite); + end; + Result := FSingleSuite; +end; + +function TJUnitResultsWriter.GetMultipleSuitesElement: TDOMElement; +begin + if not Assigned(FMultipleSuites) then + begin + FMultipleSuites := FDoc.CreateElement('testsuites'); + FDoc.AppendChild(FMultipleSuites); + end; + Result := FMultipleSuites; +end; + +end. +