← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to fpcsrc/packages/fcl-fpcunit/src/latextestreport.pp

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/packages/fcl-fpcunit/src/latextestreport.pp
 
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
 **********************************************************************}
 
17
unit latextestreport;
 
18
 
 
19
interface
 
20
 
 
21
uses
 
22
  classes, SysUtils, fpcunit, fpcunitreport, strutils;
 
23
 
 
24
type
 
25
   
 
26
  TLatexResultsWriter = class(TCustomResultsWriter)
 
27
  private
 
28
    FDoc: TStringList;
 
29
    FSuiteHeaderIdx: TFPList;
 
30
    FTempFailure: TTestFailure;
 
31
  protected
 
32
    class function EscapeText(const S: string): String; virtual;
 
33
    procedure WriteTestHeader(ATest: TTest; ALevel: integer; ACount: integer); override;
 
34
    procedure WriteTestFooter(ATest: TTest; ALevel: integer; ATiming: TDateTime); override;
 
35
    procedure WriteSuiteHeader(ATestSuite: TTestSuite; ALevel: integer); override;
 
36
    procedure WriteSuiteFooter(ATestSuite: TTestSuite; ALevel: integer; 
 
37
      ATiming: TDateTime; ANumRuns: integer; ANumErrors: integer; 
 
38
      ANumFailures: integer; ANumIgnores: integer); override;
 
39
  public
 
40
    constructor Create(aOwner: TComponent); override;
 
41
    destructor  Destroy; override;
 
42
    procedure WriteHeader; override;
 
43
    procedure WriteFooter; override;
 
44
    procedure WriteResult(aResult: TTestResult); override;
 
45
    procedure AddFailure(ATest: TTest; AFailure: TTestFailure); override;
 
46
    procedure AddError(ATest: TTest; AError: TTestFailure); override;
 
47
    procedure StartTest(ATest: TTest); override;
 
48
    procedure EndTest(ATest: TTest); override;
 
49
  end;
 
50
 
 
51
function TestSuiteAsLatex(aSuite:TTestSuite): string;
 
52
function GetSuiteAsLatex(aSuite: TTestSuite): string;
 
53
 
 
54
implementation
 
55
 
 
56
class function TLatexResultsWriter.EscapeText(const S: string): String;
 
57
var
 
58
  i: integer;
 
59
begin
 
60
  SetLength(Result, 0);
 
61
    for i := 1 to Length(S) do
 
62
      case S[i] of
 
63
        '&','{','}','#','_','$','%':     // Escape these characters
 
64
          Result := Result + '\' + S[i];
 
65
        '~','^':
 
66
          Result := Result + '\'+S[i]+' ';
 
67
        '\':
 
68
          Result := Result + '$\backslash$';
 
69
        '<':
 
70
          Result := Result + '$<$';
 
71
        '>':
 
72
          Result := Result + '$>$'
 
73
        else
 
74
          Result := Result + S[i];
 
75
      end;
 
76
end;
 
77
 
 
78
constructor TLatexResultsWriter.Create(aOwner: TComponent);
 
79
begin
 
80
  inherited Create(aOwner);
 
81
  FDoc := TStringList.Create;
 
82
  FSuiteHeaderIdx := TFPList.Create;
 
83
  FTempFailure := nil;
 
84
end;
 
85
 
 
86
destructor  TLatexResultsWriter.Destroy;
 
87
begin
 
88
  FDoc.Free;
 
89
  FSuiteHeaderIdx.Free;
 
90
  inherited Destroy;
 
91
end;
 
92
 
 
93
procedure TLatexResultsWriter.WriteHeader;
 
94
begin
 
95
  inherited WriteHeader;
 
96
  FDoc.Add('\documentclass[a4paper,12pt]{report}');
 
97
  FDoc.Add('\usepackage{fullpage}');
 
98
  FDoc.Add('\usepackage{color}');
 
99
  FDoc.Add('\definecolor{Blue}{rgb}{0.3,0.3,0.9}');
 
100
  FDoc.Add('\definecolor{Red}{rgb}{1,0,0}');
 
101
  FDoc.Add('\definecolor{Pink}{rgb}{1,0,1}');
 
102
  FDoc.Add('\definecolor{Yellow}{rgb}{1,1,0}');
 
103
  FDoc.Add('\author{FPCUnit}');
 
104
  FDoc.Add('\title{Unit tests run by FPCUnit}');
 
105
  FDoc.Add('\begin{document}');
 
106
  FDoc.Add('\maketitle');
 
107
  FDoc.Add('\flushleft');
 
108
end;
 
109
 
 
110
procedure TLatexResultsWriter.WriteFooter;
 
111
begin
 
112
  inherited WriteFooter;
 
113
  
 
114
end;
 
115
    
 
116
procedure TLatexResultsWriter.WriteResult(aResult: TTestResult);
 
117
var
 
118
  f: text;
 
119
begin
 
120
  inherited WriteResult(aResult);
 
121
  with aResult do
 
122
  begin
 
123
    FDoc.Insert(11, '\begin{tabular}{ll}');
 
124
    FDoc.Insert(12, '{\bf Number of run tests:} &' + intToStr(RunTests)+ '\\');
 
125
    FDoc.Insert(13, '{\bf Number of errors:} &' + intToStr(NumberOfErrors)+ '\\');
 
126
    FDoc.Insert(14, '{\bf Number of failures:} &' + intToStr(NumberOfFailures)+ '\\');
 
127
    FDoc.Insert(15, '{\bf Number of ignored tests:} &' + intToStr(NumberOfIgnoredTests)+ '\\');
 
128
    FDoc.Insert(16, '\end{tabular}');
 
129
  end;
 
130
  FDoc.Add('\end{document}');
 
131
  system.Assign(f, FileName);
 
132
  rewrite(f);
 
133
  writeln(f, FDoc.Text);
 
134
  close(f);
 
135
end;
 
136
  
 
137
{ITestListener}
 
138
    
 
139
procedure TLatexResultsWriter.AddFailure(ATest: TTest; AFailure: TTestFailure);
 
140
begin
 
141
  inherited AddFailure(ATest, AFailure);
 
142
  FTempFailure := AFailure;
 
143
end;
 
144
 
 
145
procedure TLatexResultsWriter.AddError(ATest: TTest; AError: TTestFailure);
 
146
begin
 
147
  inherited;
 
148
  FTempFailure := AError;
 
149
end;
 
150
    
 
151
procedure TLatexResultsWriter.WriteTestHeader(ATest: TTest; ALevel: integer; ACount: integer);
 
152
begin
 
153
  inherited;
 
154
end;
 
155
 
 
156
procedure TLatexResultsWriter.WriteTestFooter(ATest: TTest; ALevel: integer; ATiming: TDateTime);
 
157
begin
 
158
  inherited;
 
159
  FDoc.Add(StringOfChar(' ',ALevel*2)+ '  '+ '\item[-] ' + FormatDateTime('ss.zzz', ATiming)  
 
160
    + '  ' + EscapeText(ATest.TestName));
 
161
  if Assigned(FTempFailure) then
 
162
  begin
 
163
    //check if it's an error 
 
164
    if not FTempFailure.IsFailure then 
 
165
    begin
 
166
      FDoc[FDoc.Count -1] := '{\color{Red}'+FDoc[FDoc.Count -1];
 
167
      FDoc.Add('\begin{description}');
 
168
      FDoc.Add('\item[Error:] '+ EscapeText(FTempFailure.ExceptionClassName));
 
169
      FDoc.Add('\item[Exception:]  '+ EscapeText(FTempFailure.ExceptionMessage));
 
170
      FDoc.Add('\item[Source unit:] '+ EscapeText(FTempFailure.SourceUnitName));
 
171
      FDoc.Add('\item[Method name:] '+ EscapeText(FTempFailure.FailedMethodName));
 
172
      FDoc.Add('\item[Line number:] '+ IntToStr(FTempFailure.LineNumber));
 
173
      FDoc.Add('\end{description}}');
 
174
    end
 
175
    else
 
176
      if FTempFailure.IsIgnoredTest then
 
177
      begin
 
178
        FDoc[FDoc.Count -1] := '{\color{Yellow}'+FDoc[FDoc.Count -1] + '  {\bf IGNORED TEST: ' + 
 
179
          EscapeText(FTempFailure.ExceptionMessage) +'}}'
 
180
      end
 
181
      else
 
182
        //is a failure
 
183
        FDoc[FDoc.Count -1] := '{\color{Pink}'+FDoc[FDoc.Count -1] + '  {\bf FAILED: ' + 
 
184
          EscapeText(FTempFailure.ExceptionMessage) +'}}';
 
185
  end;
 
186
  FTempFailure := nil;
 
187
end;
 
188
 
 
189
procedure TLatexResultsWriter.WriteSuiteHeader(ATestSuite: TTestSuite; ALevel: integer);
 
190
begin
 
191
  inherited;
 
192
  FDoc.Add('{\bf {\color{Blue}'+ StringOfChar(' ',ALevel*2)+ '\item[-] '+ 
 
193
    EscapeText(ATestSuite.TestName)+ '}}');
 
194
  FSuiteHeaderIdx.Add(Pointer(FDoc.Count - 1));
 
195
  FDoc.Add(StringOfChar(' ',ALevel*2)+ '\begin{itemize}');
 
196
end;
 
197
 
 
198
procedure TLatexResultsWriter.WriteSuiteFooter(ATestSuite: TTestSuite; ALevel: integer;
 
199
  ATiming: TDateTime; ANumRuns: integer; ANumErrors: integer; ANumFailures: integer;
 
200
  ANumIgnores: integer);
 
201
var
 
202
  idx: integer;
 
203
begin
 
204
  inherited;
 
205
  FDoc.Add(StringOfChar(' ',ALevel*2)+ ' \end{itemize}');
 
206
  idx := Integer(FSuiteHeaderIdx[FSuiteHeaderIdx.Count -1]);
 
207
  FDoc[idx] := FDoc[idx] + ' {\color{Blue}'+ '  Time:'+ FormatDateTime('ss.zzz', ATiming)+
 
208
    ' N:'+ IntToStr(ANumRuns)+ ' E:'+ IntToStr(ANumErrors)+ ' F:'+ IntToStr(ANumFailures)+ 
 
209
    ' I:'+ IntToStr(ANumIgnores)+'}';
 
210
  FSuiteHeaderIdx.Delete(FSuiteHeaderIdx.Count -1);
 
211
end;
 
212
 
 
213
procedure TLatexResultsWriter.StartTest(ATest: TTest);
 
214
begin
 
215
  inherited StartTest(ATest);
 
216
end;
 
217
    
 
218
procedure TLatexResultsWriter.EndTest(ATest: TTest);
 
219
begin
 
220
  inherited EndTest(ATest);
 
221
  
 
222
end;
 
223
 
 
224
function TestSuiteAsLatex(aSuite:TTestSuite): string;
 
225
var
 
226
  i,j: integer;
 
227
  s: TTestSuite;
 
228
begin
 
229
  Result := '\flushleft' + System.sLineBreak;
 
230
  for i := 0 to aSuite.Tests.Count - 1 do
 
231
  begin
 
232
    s := TTestSuite(ASuite.Tests.Items[i]);
 
233
    Result := Result + TLatexResultsWriter.EscapeText(s.TestSuiteName) + System.sLineBreak;
 
234
    Result := Result + '\begin{itemize}'+ System.sLineBreak;
 
235
    for j := 0 to s.Tests.Count - 1 do
 
236
      if TTest(s.Tests.Items[j]) is TTestCase then
 
237
        Result := Result + '\item[-] ' + 
 
238
          TLatexResultsWriter.EscapeText(TTestcase(s.Tests.Items[j]).TestName)
 
239
          + System.sLineBreak;
 
240
    Result := Result +'\end{itemize}' + System.sLineBreak;
 
241
  end;
 
242
end;
 
243
 
 
244
 
 
245
function GetSuiteAsLatex(aSuite: TTestSuite): string;
 
246
begin
 
247
  if aSuite <> nil then
 
248
    begin
 
249
      Result := '\documentclass[a4paper,12pt]{article}' + System.sLineBreak;
 
250
      Result := Result + '\usepackage{array}' + System.sLineBreak;
 
251
      Result := Result + '\usepackage{mdwlist}' + System.sLineBreak + System.sLineBreak;
 
252
      Result := Result + '\begin{document}' + System.sLineBreak + System.sLineBreak;
 
253
      if aSuite.TestName = '' then
 
254
        aSuite.TestName := 'Test Suite';
 
255
      Result := Result + TestSuiteAsLatex(aSuite);
 
256
      Result := Result + '\end{document}';
 
257
    end
 
258
  else
 
259
    Result := '';
 
260
end;
 
261
 
 
262
end.