1{
2    This file is part of the Free Component Library (FCL)
3    Copyright (c) 2006 by Dean Zobec, Graeme Geldenhuys
4
5    An example of an XML report writer for FPCUnit tests.
6
7    See the file COPYING.FPC, included in this distribution,
8    for details about the copyright.
9
10    This program is distributed in the hope that it will be useful,
11    but WITHOUT ANY WARRANTY; without even the implied warranty of
12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
13
14 **********************************************************************
15
16
17  Purpose:
18    This unit contains a XML TestListener for use with the fpcUnit testing
19    framework. It uses the XMLWrite unit (part of FPC) to generate
20    the XML document. The benefit of using XMLWrite is that the data generated
21    is valid XML, with reserved characters correctly escaped.
22    This allows the XML document to be further processed with XSLT etc without
23    any issues.
24
25  Notes:
26    Specify 'null' as the filename if you don't want to output to file (e.g.
27    used by the GUI test runner which instead reads the Document property).
28
29}
30
31unit xmltestreport;
32
33{$mode objfpc}{$H+}
34
35interface
36
37uses
38  Classes, SysUtils,fpcunit, fpcunitreport, testutils, dom, XMLWrite;
39
40
41type
42
43  { TXMLResultsWriter }
44
45  TXMLResultsWriter = class(TCustomResultsWriter)
46  private
47    FDoc: TXMLDocument;
48    FResults, FListing: TDOMNode;
49    FSuitePath: TFPList;
50    FCurrentTest: TDOMElement;
51  protected
52    function GetCurrentElement: TDOMElement;
53    procedure WriteTestHeader(ATest: TTest; ALevel: integer; ACount: integer); override;
54    procedure WriteTestFooter(ATest: TTest; ALevel: integer; ATiming: TDateTime); override;
55    procedure WriteSuiteHeader(ATestSuite: TTestSuite; ALevel: integer); override;
56    procedure WriteSuiteFooter(ATestSuite: TTestSuite; ALevel: integer;
57      ATiming: TDateTime; ANumRuns: integer; ANumErrors: integer;
58      ANumFailures: integer; ANumIgnores: integer); override;
59  public
60    constructor Create(aOwner: TComponent); override;
61    destructor  Destroy; override;
62    procedure WriteHeader; override;
63    procedure WriteFooter; override;
64    procedure AddFailure(ATest: TTest; AFailure: TTestFailure); override;
65    procedure AddError(ATest: TTest; AError: TTestFailure); override;
66    procedure StartTest(ATest: TTest); override;
67    procedure EndTest(ATest: TTest); override;
68    procedure WriteResult(aResult: TTestResult); override;
69    { A public property to the internal XML document }
70    property Document: TXMLDocument read FDoc;
71  end;
72
73function GetSuiteAsXML(aSuite: TTestSuite): string;
74function TestSuiteAsXML(n: TDOMElement; FDoc: TXMLDocument; aSuite:TTest): string;
75
76implementation
77
78function GetSuiteAsXML(aSuite: TTestSuite): string;
79var
80  FDoc: TXMLDocument;
81  n: TDOMElement;
82  stream : TStringStream;
83begin
84  Result := '';
85
86  if aSuite <> nil then
87  begin
88    FDoc:= TXMLDocument.Create;
89
90    n := FDoc.CreateElement('TestSuites');
91    FDoc.AppendChild(n);
92
93    TestSuiteAsXML(n, FDoc, aSuite);
94
95    stream := TStringStream.Create('');
96    WriteXMLFile(FDoc, stream);
97    Result:=stream.DataString;
98    stream.Free;
99  end;
100end;
101
102function TestSuiteAsXML(n: TDOMElement; FDoc: TXMLDocument; aSuite:TTest): string;
103var
104  i: integer;
105  E,T : TDomElement;
106
107begin
108  Result:='';
109  if aSuite.GetChildTestCount>0 then
110    begin
111    if (aSuite.TestName='') then
112      E:=N
113    else
114      begin
115      E:=FDoc.CreateElement('Suite');
116      E['Name']:=aSuite.TestName;
117      N.AppendChild(E);
118      end;
119    for i:=0 to Pred(aSuite.GetChildTestCount) do
120      TestSuiteAsXML(E,FDoc,aSuite.GetChildTest(i));
121    end
122  else
123    begin
124    T:=FDoc.CreateElement('Test');
125    T['name']:=aSuite.TestName;
126    N.AppendChild(T);
127    end;
128end;
129
130
131{ TXMLResultsWriter }
132
133function TXMLResultsWriter.GetCurrentElement: TDOMElement;
134begin
135  if Assigned(FCurrentTest) then
136    Result := FCurrentTest
137  else if FSuitePath.Count > 0 then
138  //test is included in a suite
139    Result := TDOMElement(FSuitePath[FSuitePath.Count -1])
140  else
141  //no suite to append so append directly to the listing node
142    FListing.LastChild;
143end;
144
145procedure TXMLResultsWriter.WriteTestHeader(ATest: TTest; ALevel: integer; ACount: integer);
146var
147  n: TDOMElement;
148begin
149  inherited;
150  n := FDoc.CreateElement('Test');
151  n['Name'] := ATest.TestName;
152  n['Result'] := 'OK';
153  if FSuitePath.Count > 0 then
154  //test is included in a suite
155    TDOMElement(FSuitePath[FSuitePath.Count -1]).AppendChild(n)
156  else
157  //no suite to append so append directly to the listing node
158    FListing.AppendChild(n);
159  FCurrentTest := n;
160end;
161
162procedure TXMLResultsWriter.WriteTestFooter(ATest: TTest; ALevel: integer; ATiming: TDateTime);
163begin
164  inherited;
165  if not SkipTiming then
166    FCurrentTest['ElapsedTime'] := FormatDateTime('hh:nn:ss.zzz', ATiming);
167end;
168
169
170procedure TXMLResultsWriter.WriteSuiteHeader(ATestSuite: TTestSuite; ALevel: integer);
171var
172  n: TDOMElement;
173begin
174  inherited;
175  n := FDoc.CreateElement('TestSuite');
176  FSuitePath.Add(n);
177  n['Name'] := ATestSuite.TestName;
178  if FSuitePath.Count = 1 then
179    FListing.AppendChild(n)
180  else
181    TDOMElement(FSuitePath[FSuitePath.Count -2]).AppendChild(n);
182end;
183
184
185procedure TXMLResultsWriter.WriteSuiteFooter(ATestSuite: TTestSuite; ALevel: integer;
186  ATiming: TDateTime; ANumRuns: integer; ANumErrors: integer; ANumFailures: integer;
187  ANumIgnores: integer);
188var
189  n: TDOMElement;
190begin
191  inherited;
192  n := TDomElement(FSuitePath[FSuitePath.Count -1]);
193  if not SkipTiming then
194    n['ElapsedTime'] := FormatDateTime('hh:nn:ss.zzz', ATiming);
195  n['NumberOfRunTests'] := IntToStr(ANumRuns);
196  n['NumberOfErrors'] := IntToStr(ANumErrors);
197  n['NumberOfFailures'] := IntToStr(ANumFailures);
198  n['NumberOfIgnoredTests'] := IntToStr(ANumIgnores);
199  FSuitePath.Delete(FSuitePath.Count -1);
200end;
201
202constructor TXMLResultsWriter.Create(aOwner: TComponent);
203begin
204  inherited Create(aOwner);
205  FDoc:= TXMLDocument.Create;
206  FSuitePath := TFPList.Create;
207  FResults := nil;
208  FListing := nil;
209end;
210
211destructor  TXMLResultsWriter.Destroy;
212begin
213  FResults := nil;
214  FListing := nil;
215  FSuitePath.Free;
216  FDoc.Free;
217  inherited Destroy;
218end;
219
220
221procedure TXMLResultsWriter.WriteHeader;
222begin
223  inherited;
224  FResults := FDoc.CreateElement('TestResults');
225  FResults.AppendChild(FDoc.CreateComment(' Generated using FPCUnit on '
226    + FormatDateTime('yyyy-mm-dd hh:nn:ss', Now) ));
227  FDoc.AppendChild(FResults);
228  FListing := FDoc.CreateElement('TestListing');
229  FResults.AppendChild(FListing);
230end;
231
232
233procedure TXMLResultsWriter.WriteFooter;
234begin
235  inherited;
236end;
237
238procedure TXMLResultsWriter.AddFailure(ATest: TTest; AFailure: TTestFailure);
239var
240  CurrentElement: TDOMElement;
241begin
242  inherited;
243  CurrentElement := GetCurrentElement;
244  if AFailure.IsIgnoredTest then
245    CurrentElement['Result'] := 'Ignored'
246  else
247    CurrentElement['Result'] := 'Failed';
248    CurrentElement.AppendChild(FDoc.CreateElement('Message')).AppendChild
249      (FDoc.CreateTextNode(AFailure.AsString));
250    CurrentElement.AppendChild(FDoc.CreateElement('ExceptionClass')).AppendChild
251      (FDoc.CreateTextNode(AFailure.ExceptionClassName));
252    CurrentElement.AppendChild(FDoc.CreateElement('ExceptionMessage')).AppendChild
253      (FDoc.CreateTextNode(AFailure.ExceptionMessage));
254end;
255
256procedure TXMLResultsWriter.AddError(ATest: TTest; AError: TTestFailure);
257var
258  CurrentElement: TDOMElement;
259begin
260  inherited;
261  CurrentElement := GetCurrentElement;
262  CurrentElement['Result'] := 'Error';
263  CurrentElement.AppendChild(FDoc.CreateElement('Message')).AppendChild
264    (FDoc.CreateTextNode(AError.AsString));
265  CurrentElement.AppendChild(FDoc.CreateElement('ExceptionClass')).AppendChild
266    (FDoc.CreateTextNode(AError.ExceptionClassName));
267  CurrentElement.AppendChild(FDoc.CreateElement('ExceptionMessage')).AppendChild
268    (FDoc.CreateTextNode(AError.ExceptionMessage));
269  CurrentElement.AppendChild(FDoc.CreateElement('SourceUnitName')).AppendChild
270    (FDoc.CreateTextNode(AError.SourceUnitName));
271  CurrentElement.AppendChild(FDoc.CreateElement('LineNumber')).AppendChild
272    (FDoc.CreateTextNode(IntToStr(AError.LineNumber)));
273  CurrentElement.AppendChild(FDoc.CreateElement('FailedMethodName')).AppendChild
274    (FDoc.CreateTextNode(AError.FailedMethodName));
275end;
276
277
278procedure TXMLResultsWriter.StartTest(ATest: TTest);
279begin
280  inherited;
281end;
282
283
284procedure TXMLResultsWriter.EndTest(ATest: TTest);
285begin
286  inherited;
287end;
288
289procedure TXMLResultsWriter.WriteResult(aResult: TTestResult);
290var
291  n, lResults: TDOMNode;
292  f: text;
293begin
294  lResults := FDoc.FindNode('TestResults');
295  n := FDoc.CreateElement('NumberOfRunTests');
296  n.AppendChild(FDoc.CreateTextNode(IntToStr(aResult.RunTests)));
297  lResults.AppendChild(n);
298
299  n := FDoc.CreateElement('NumberOfErrors');
300  n.AppendChild(FDoc.CreateTextNode(IntToStr(aResult.NumberOfErrors)));
301  lResults.AppendChild(n);
302
303  n := FDoc.CreateElement('NumberOfFailures');
304  n.AppendChild(FDoc.CreateTextNode(IntToStr(aResult.NumberOfFailures)));
305  lResults.AppendChild(n);
306
307  n := FDoc.CreateElement('NumberOfIgnoredTests');
308  n.AppendChild(FDoc.CreateTextNode(IntToStr(aResult.NumberOfIgnoredTests)));
309  lResults.AppendChild(n);
310
311  if not SkipTiming then
312  begin
313    n := FDoc.CreateElement('TotalElapsedTime');
314    n.AppendChild(FDoc.CreateTextNode(FormatDateTime('hh:nn:ss.zzz',
315      Now - aResult.StartingTime)));
316    lResults.AppendChild(n);
317  end;
318
319  { Summary of ISO 8601  http://www.cl.cam.ac.uk/~mgk25/iso-time.html }
320  n := FDoc.CreateElement('DateTimeRan');
321  n.AppendChild(FDoc.CreateTextNode(FormatDateTime('yyyy-mm-dd hh:nn:ss', Now)));
322  lResults.AppendChild(n);
323
324  // This is so that the GUI Test Runner doesn't output text as well.
325  if FileName <> 'null' then
326  begin
327    system.Assign(f, FileName);
328    rewrite(f);
329    WriteXMLFile(FDoc, f);
330    close(f);
331  end;
332end;
333
334end.
335
336
337
338