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