1{$mode objfpc}
2{$h+}
3{
4    This file is part of the Free Component Library (FCL)
5    Copyright (c) 2006 by Dean Zobec
6
7    an example of latex report for FPCUnit tests.
8
9    See the file COPYING.FPC, included in this distribution,
10    for details about the copyright.
11
12    This program is distributed in the hope that it will be useful,
13    but WITHOUT ANY WARRANTY; without even the implied warranty of
14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
15
16 **********************************************************************}
17unit latextestreport;
18
19interface
20
21uses
22  classes, SysUtils, fpcunit, fpcunitreport, strutils;
23
24type
25
26  { TLatexResultsWriter }
27
28  TLatexResultsWriter = class(TCustomResultsWriter)
29  private
30    FDoc: TStringList;
31    FSuiteHeaderIdx: TFPList;
32    FTempFailure: TTestFailure;
33    function TimeFormat(ATiming: TDateTime): String;
34  protected
35    class function EscapeText(const S: string): String; virtual;
36    procedure WriteTestHeader(ATest: TTest; ALevel: integer; ACount: integer); override;
37    procedure WriteTestFooter(ATest: TTest; ALevel: integer; ATiming: TDateTime); override;
38    procedure WriteSuiteHeader(ATestSuite: TTestSuite; ALevel: integer); override;
39    procedure WriteSuiteFooter(ATestSuite: TTestSuite; ALevel: integer;
40      ATiming: TDateTime; ANumRuns: integer; ANumErrors: integer;
41      ANumFailures: integer; ANumIgnores: integer); override;
42  public
43    constructor Create(aOwner: TComponent); override;
44    destructor  Destroy; override;
45    procedure WriteHeader; override;
46    procedure WriteFooter; override;
47    procedure WriteResult(aResult: TTestResult); override;
48    procedure AddFailure(ATest: TTest; AFailure: TTestFailure); override;
49    procedure AddError(ATest: TTest; AError: TTestFailure); override;
50    procedure StartTest(ATest: TTest); override;
51    procedure EndTest(ATest: TTest); override;
52  end;
53
54function TestSuiteAsLatex(aSuite:TTest): string;
55function GetSuiteAsLatex(aSuite: TTestSuite): string;
56
57implementation
58
59uses dateutils;
60
61function TLatexResultsWriter.TimeFormat(ATiming: TDateTime): String;
62Var
63  M : Int64;
64
65begin
66  Result:='ss.zzz';
67  M:=MinutesBetween(ATiming,0);
68  if M>60 then
69    Result:='hh:mm:'+Result
70  else if M>1 then
71   Result:='mm:'+Result;
72end;
73
74class function TLatexResultsWriter.EscapeText(const S: string): String;
75var
76  i: integer;
77begin
78  SetLength(Result, 0);
79    for i := 1 to Length(S) do
80      case S[i] of
81        '&','{','}','#','_','$','%':     // Escape these characters
82          Result := Result + '\' + S[i];
83        '~','^':
84          Result := Result + '\'+S[i]+' ';
85        '\':
86          Result := Result + '$\backslash$';
87        '<':
88          Result := Result + '$<$';
89        '>':
90          Result := Result + '$>$'
91        else
92          Result := Result + S[i];
93      end;
94end;
95
96constructor TLatexResultsWriter.Create(aOwner: TComponent);
97begin
98  inherited Create(aOwner);
99  FDoc := TStringList.Create;
100  FSuiteHeaderIdx := TFPList.Create;
101  FTempFailure := nil;
102end;
103
104destructor  TLatexResultsWriter.Destroy;
105begin
106  FDoc.Free;
107  FSuiteHeaderIdx.Free;
108  inherited Destroy;
109end;
110
111procedure TLatexResultsWriter.WriteHeader;
112begin
113  inherited WriteHeader;
114  FDoc.Add('\documentclass[a4paper,12pt]{report}');
115  FDoc.Add('\usepackage{fullpage}');
116  FDoc.Add('\usepackage{color}');
117  FDoc.Add('\definecolor{Blue}{rgb}{0.3,0.3,0.9}');
118  FDoc.Add('\definecolor{Red}{rgb}{1,0,0}');
119  FDoc.Add('\definecolor{Pink}{rgb}{1,0,1}');
120  FDoc.Add('\definecolor{Yellow}{rgb}{1,1,0}');
121  FDoc.Add('\author{FPCUnit}');
122  FDoc.Add('\title{Unit tests run by FPCUnit}');
123  FDoc.Add('\begin{document}');
124  FDoc.Add('\maketitle');
125  FDoc.Add('\flushleft');
126end;
127
128procedure TLatexResultsWriter.WriteFooter;
129begin
130  inherited WriteFooter;
131
132end;
133
134procedure TLatexResultsWriter.WriteResult(aResult: TTestResult);
135var
136  f: text;
137begin
138  inherited WriteResult(aResult);
139  with aResult do
140  begin
141    FDoc.Insert(11, '\begin{tabular}{ll}');
142    FDoc.Insert(12, '{\bf Number of run tests:} &' + intToStr(RunTests)+ '\\');
143    FDoc.Insert(13, '{\bf Number of errors:} &' + intToStr(NumberOfErrors)+ '\\');
144    FDoc.Insert(14, '{\bf Number of failures:} &' + intToStr(NumberOfFailures)+ '\\');
145    FDoc.Insert(15, '{\bf Number of ignored tests:} &' + intToStr(NumberOfIgnoredTests)+ '\\');
146    FDoc.Insert(16, '\end{tabular}');
147  end;
148  FDoc.Add('\end{document}');
149  system.Assign(f, FileName);
150  rewrite(f);
151  writeln(f, FDoc.Text);
152  close(f);
153end;
154
155{ITestListener}
156
157procedure TLatexResultsWriter.AddFailure(ATest: TTest; AFailure: TTestFailure);
158begin
159  inherited AddFailure(ATest, AFailure);
160  FTempFailure := AFailure;
161end;
162
163procedure TLatexResultsWriter.AddError(ATest: TTest; AError: TTestFailure);
164begin
165  inherited;
166  FTempFailure := AError;
167end;
168
169procedure TLatexResultsWriter.WriteTestHeader(ATest: TTest; ALevel: integer; ACount: integer);
170begin
171  inherited;
172end;
173
174procedure TLatexResultsWriter.WriteTestFooter(ATest: TTest; ALevel: integer; ATiming: TDateTime);
175
176Var
177  S : String;
178begin
179  inherited;
180  S:=StringOfChar(' ',ALevel*2)+ '  '+ '\item[-] ';
181  if Not SkipTiming then
182    S:=S+FormatDateTime(TimeFormat(ATiming), ATiming);
183  S:=S+ '  ' + EscapeText(ATest.TestName);
184  FDoc.Add(S);
185  if Assigned(FTempFailure) then
186  begin
187    //check if it's an error
188    if not FTempFailure.IsFailure then
189    begin
190      FDoc[FDoc.Count -1] := '{\color{Red}'+FDoc[FDoc.Count -1];
191      FDoc.Add('\begin{description}');
192      FDoc.Add('\item[Error:] '+ EscapeText(FTempFailure.ExceptionClassName));
193      FDoc.Add('\item[Exception:]  '+ EscapeText(FTempFailure.ExceptionMessage));
194      FDoc.Add('\item[Source unit:] '+ EscapeText(FTempFailure.SourceUnitName));
195      FDoc.Add('\item[Method name:] '+ EscapeText(FTempFailure.FailedMethodName));
196      FDoc.Add('\item[Line number:] '+ IntToStr(FTempFailure.LineNumber));
197      FDoc.Add('\end{description}}');
198    end
199    else
200      if FTempFailure.IsIgnoredTest then
201      begin
202        FDoc[FDoc.Count -1] := '{\color{Yellow}'+FDoc[FDoc.Count -1] + '  {\bf IGNORED TEST: ' +
203          EscapeText(FTempFailure.ExceptionMessage) +'}}'
204      end
205      else
206        //is a failure
207        FDoc[FDoc.Count -1] := '{\color{Pink}'+FDoc[FDoc.Count -1] + '  {\bf FAILED: ' +
208          EscapeText(FTempFailure.ExceptionMessage) +'}}';
209  end;
210  FTempFailure := nil;
211end;
212
213procedure TLatexResultsWriter.WriteSuiteHeader(ATestSuite: TTestSuite; ALevel: integer);
214begin
215  inherited;
216  FDoc.Add('{\bf {\color{Blue}'+ StringOfChar(' ',ALevel*2)+ '\item[-] '+
217    EscapeText(ATestSuite.TestName)+ '}}');
218  FSuiteHeaderIdx.Add(Pointer(FDoc.Count - 1));
219  FDoc.Add(StringOfChar(' ',ALevel*2)+ '\begin{itemize}');
220end;
221
222procedure TLatexResultsWriter.WriteSuiteFooter(ATestSuite: TTestSuite; ALevel: integer;
223  ATiming: TDateTime; ANumRuns: integer; ANumErrors: integer; ANumFailures: integer;
224  ANumIgnores: integer);
225var
226  idx: integer;
227  S : String;
228
229begin
230  inherited;
231  FDoc.Add(StringOfChar(' ',ALevel*2)+ ' \end{itemize}');
232  idx := Integer(FSuiteHeaderIdx[FSuiteHeaderIdx.Count -1]);
233  S:= ' {\color{Blue}';
234  if Not SkipTiming then
235    S:=S+ ' Time: '+FormatDateTime('ss.zzz', ATiming);
236  S:=S+' N:'+ IntToStr(ANumRuns)+ ' E:'+ IntToStr(ANumErrors)+ ' F:'+ IntToStr(ANumFailures)+
237  ' I:'+ IntToStr(ANumIgnores)+'}';
238  FDoc[idx] := FDoc[idx] +S;
239  FSuiteHeaderIdx.Delete(FSuiteHeaderIdx.Count -1);
240end;
241
242procedure TLatexResultsWriter.StartTest(ATest: TTest);
243begin
244  inherited StartTest(ATest);
245end;
246
247procedure TLatexResultsWriter.EndTest(ATest: TTest);
248begin
249  inherited EndTest(ATest);
250
251end;
252
253function TestSuiteAsLatex(aSuite:TTest): string;
254var
255  i,j: integer;
256  s: TTestSuite;
257begin
258  Result:='';
259  if (aSuite.TestName<>'') then
260    begin
261    Result:=Result + '\item[-] ';
262    Result:=Result+TLatexResultsWriter.EscapeText(ASuite.TestName)+slineBreak
263    end;
264  if aSuite.GetChildTestCount>0 then
265    begin
266    Result := Result + '\begin{itemize}'+ System.sLineBreak;
267    for i:=0 to Pred(aSuite.GetChildTestCount) do
268      Result:=Result+TestSuiteAsLatex(aSuite.GetChildTest(i));
269    if (aSuite.TestName<>'') then
270      Result := Result +'\end{itemize}' + System.sLineBreak;
271    end
272
273end;
274
275
276function GetSuiteAsLatex(aSuite: TTestSuite): string;
277begin
278  if aSuite <> nil then
279    begin
280      Result := '\documentclass[a4paper,12pt]{article}' + System.sLineBreak;
281      Result := Result + '\usepackage{array}' + System.sLineBreak;
282      Result := Result + '\usepackage{mdwlist}' + System.sLineBreak + System.sLineBreak;
283      Result := Result + '\begin{document}' + System.sLineBreak + System.sLineBreak;
284      if aSuite.TestName = '' then
285        aSuite.TestName := 'Test Suite';
286      Result := Result + '\begin{itemize}'+ System.sLineBreak;
287      Result := Result + TestSuiteAsLatex(aSuite);
288      Result := Result +'\end{itemize}' + System.sLineBreak;
289      Result := Result + '\end{document}';
290    end
291  else
292    Result := '';
293end;
294
295end.
296