* Sparse and SkipAddressInfo

git-svn-id: trunk@30363 -

packages/fcl-fpcunit/src/consoletestrunner.pas

@@ -73,9 +73,9 @@ uses testdecorator;
 
 const
   ShortOpts = 'alhp';
-  DefaultLongOpts: array[1..9] of string =
+  DefaultLongOpts: array[1..11] of string =
      ('all', 'list', 'progress', 'help', 'skiptiming',
-      'suite:', 'format:', 'file:', 'stylesheet:');
+      'suite:', 'format:', 'file:', 'stylesheet:','sparse','no-addresses');
 
   { TProgressWriter }
 type
@@ -154,6 +154,8 @@ begin
     end;
   end;
   Result.SkipTiming:=HasOption('skiptiming');
+  Result.Sparse:=HasOption('sparse');
+  Result.SkipAddressInfo:=HasOption('no-addresses');
 end;
 
 procedure TTestRunner.DoTestRun(ATest: TTest);
@@ -213,6 +215,8 @@ begin
     writeln('  --format=plain            output as plain ASCII source');
     writeln('  --format=xml              output as XML source (default)');
     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');
     writeln('  --stylesheet=<reference>   add stylesheet reference');
     writeln('  --file=<filename>         output results to file');
     writeln;

packages/fcl-fpcunit/src/fpcunitreport.pp

@@ -68,6 +68,8 @@ type
   private
     FLevel: integer;
     FCount: integer;
+    FSkipAddressInfo: Boolean;
+    FSparse: Boolean;
     FTestTime: TDateTime;
     FFileName: string;
     FSuiteResultsStack : TSuiteResultsStack;
@@ -83,6 +85,8 @@ type
     FOnEndTestSuite: TTestEvent;
     FSkipTiming: Boolean;
   protected
+    procedure SetSkipAddressInfo(AValue: Boolean); virtual;
+    procedure SetSparse(AValue: Boolean); virtual;
     procedure WriteTestHeader(ATest: TTest; ALevel: integer; ACount: integer); virtual;
     procedure WriteTestFooter(ATest: TTest; ALevel: integer; ATiming: TDateTime); virtual;
     procedure WriteSuiteHeader(ATestSuite: TTestSuite; ALevel: integer); virtual;
@@ -122,7 +126,9 @@ type
     property OnStartTestSuite: TTestEvent read FOnStartTestSuite write FOnStartTestSuite;
     property OnEndTestSuite: TTestEvent read FOnEndTestSuite write FOnEndTestSuite;
     Property SkipTiming : Boolean Read FSkipTiming Write FSkipTiming;
-  end; 
+    Property Sparse : Boolean Read FSparse Write SetSparse;
+    Property SkipAddressInfo : Boolean Read FSkipAddressInfo Write SetSkipAddressInfo;
+  end;
 
 implementation
 
@@ -272,6 +278,18 @@ begin
     FOnAddError(Self, ATest, AError);
 end;
 
+procedure TCustomResultsWriter.SetSkipAddressInfo(AValue: Boolean);
+begin
+  if FSkipAddressInfo=AValue then Exit;
+  FSkipAddressInfo:=AValue;
+end;
+
+procedure TCustomResultsWriter.SetSparse(AValue: Boolean);
+begin
+  if FSparse=AValue then Exit;
+  FSparse:=AValue;
+end;
+
 procedure TCustomResultsWriter.WriteTestHeader(ATest: TTest; ALevel: integer; ACount: integer);
 begin
   if Assigned(FOnWriteTestHeader) then 
@@ -291,9 +309,9 @@ begin
     FOnWriteSuiteHeader(Self, ATestSuite, ALevel);
 end;
 
-procedure TCustomResultsWriter.WriteSuiteFooter(ATestSuite: TTestSuite; ALevel: integer; 
-  ATiming: TDateTime; ANumRuns: integer; ANumErrors: integer; ANumFailures: integer;
-  ANumIgnores: integer);
+procedure TCustomResultsWriter.WriteSuiteFooter(ATestSuite: TTestSuite;
+  ALevel: integer; ATiming: TDateTime; ANumRuns: integer; ANumErrors: integer;
+  aNumFailures: integer; ANumIgnores: integer);
 begin
   if Assigned(FOnWriteSuiteFooter) then 
     FOnWriteSuiteFooter(Self, ATestSuite, ALevel, ATiming, ANumRuns, ANumErrors, 

packages/fcl-fpcunit/src/plaintestreport.pp

@@ -22,16 +22,21 @@ uses
   classes, SysUtils, fpcunit, fpcunitreport;
 
 type
+  TTestResultOption = (ttoSkipAddress,ttoSkipExceptionMessage,ttoErrorsOnly);
+  TTestResultOptions = set of TTestResultOption;
 
   { TPlainResultsWriter }
 
   TPlainResultsWriter = class(TCustomResultsWriter)
   private
+    FTestResultOptions : TTestResultOptions;
     FDoc: TStringList;
     FSuiteHeaderIdx: TFPList;
     FTempFailure: TTestFailure;
     function TimeFormat(ATiming: TDateTime): String;
   protected
+    procedure SetSkipAddressInfo(AValue: Boolean); override;
+    procedure SetSparse(AValue: Boolean); override;
     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;
@@ -47,9 +52,10 @@ type
     procedure AddError(ATest: TTest; AError: TTestFailure); override;
   end;
 
-function TestSuiteAsPlain(aSuite:TTestSuite): string;
-function GetSuiteAsPlain(aSuite: TTestSuite): string;
-function TestResultAsPlain(aTestResult: TTestResult): string;
+
+function TestSuiteAsPlain(aSuite:TTestSuite; Options : TTestResultOptions = []): string;
+function GetSuiteAsPlain(aSuite: TTestSuite; Options : TTestResultOptions = []): string;
+function TestResultAsPlain(aTestResult: TTestResult; Options : TTestResultOptions = []): string;
 
 implementation
 
@@ -83,7 +89,7 @@ begin
   system.Assign(f, FileName);
   rewrite(f);
   FDoc.Add('');
-  FDoc.Add(TestResultAsPlain(aResult));
+  FDoc.Add(TestResultAsPlain(aResult,FTestResultOptions));
   writeln(f, FDoc.Text);
   close(f);
 end;
@@ -116,6 +122,7 @@ begin
   if Not SkipTiming then
     S:=S + FormatDateTime(TimeFormat(ATiming), ATiming) + '  ';
   S:=S + ATest.TestName;
+  if Assigned(FTempFailure) or (not Sparse) then
   FDoc.Add(S);
   if Assigned(FTempFailure) then
   begin
@@ -145,7 +152,7 @@ begin
   FTempFailure := nil;
 end;
 
-Function TPlainResultsWriter.TimeFormat(ATiming : TDateTime) : String;
+function TPlainResultsWriter.TimeFormat(ATiming: TDateTime): String;
 
 Var
   M : Int64;
@@ -159,6 +166,24 @@ begin
    Result:='mm:'+Result;
 end;
 
+procedure TPlainResultsWriter.SetSkipAddressInfo(AValue: Boolean);
+begin
+  inherited SetSkipAddressInfo(AValue);
+  if AValue then
+    Include(FTestResultOptions,ttoSkipAddress)
+  else
+    Exclude(FTestResultOptions,ttoSkipAddress);
+end;
+
+procedure TPlainResultsWriter.SetSparse(AValue: Boolean);
+begin
+  inherited SetSparse(AValue);
+  if AValue then
+    FTestResultOptions:=FTestResultOptions+[ttoSkipExceptionMessage,ttoErrorsOnly]
+  else
+    FTestResultOptions:=FTestResultOptions-[ttoSkipExceptionMessage,ttoErrorsOnly];
+end;
+
 procedure TPlainResultsWriter.WriteSuiteFooter(ATestSuite: TTestSuite; ALevel: integer; 
   ATiming: TDateTime; ANumRuns: integer; ANumErrors: integer; ANumFailures: integer;
   ANumIgnores: integer);
@@ -183,28 +208,39 @@ begin
   FSuiteHeaderIdx.Add(Pointer(FDoc.Count - 1));
 end;
 
-function TestSuiteAsPlain(aSuite:TTestSuite): string;
+function TestSuiteAsPlain(aSuite:TTestSuite; Options : TTestResultOptions = []): string;
 var
   i: integer;
 begin
   Result := '';
   for i := 0 to aSuite.Tests.Count - 1 do
     if TTest(aSuite.Tests.Items[i]) is TTestSuite then
-      Result := Result + TestSuiteAsPlain(TTestSuite(aSuite.Tests.Items[i]))
+      Result := Result + TestSuiteAsPlain(TTestSuite(aSuite.Tests.Items[i]),Options)
     else
       if TTest(aSuite.Tests.Items[i]) is TTestCase then
         Result := Result + '  ' + ASuite.TestName+'.' + TTestcase(aSuite.Tests.Items[i]).TestName + System.sLineBreak;
 end;
 
-function GetSuiteAsPlain(aSuite: TTestSuite): string;
+function GetSuiteAsPlain(aSuite: TTestSuite; Options : TTestResultOptions = []): string;
 begin
   Result := '';
-
   if aSuite <> nil then
-    Result := 'TestSuites: ' + System.sLineBreak + TestSuiteAsPlain(aSuite);
+    Result := 'TestSuites: ' + System.sLineBreak + TestSuiteAsPlain(aSuite,Options);
 end;
 
-function TestResultAsPlain(aTestResult: TTestResult): string;
+function TestResultAsPlain(aTestResult: TTestResult; Options : TTestResultOptions = []): string;
+
+  Procedure WriteFailure(F : TTestFailure; SkipAddress : Boolean = False );
+
+  begin
+    Result := Result + '    Message:           ' + f.AsString + System.sLineBreak;
+    Result := Result + '    Exception class:   ' + f.ExceptionClassName + System.sLineBreak;
+    if not (ttoSkipExceptionMessage in options) then
+      Result := Result + '    Exception message: ' + f.ExceptionMessage + System.sLineBreak;
+    if not (SkipAddress or (ttoSkipAddress in options) )then
+      Result := Result + '        at ' + f.LocationInfo + System.sLineBreak;
+  end;
+
 var
   i: longint;
   f: TTestFailure;
@@ -223,11 +259,7 @@ begin
       begin
         Result := Result + System.sLineBreak;
         Result := Result + '  Error: ' + System.sLineBreak;
-        f := TTestFailure(Errors.Items[i]);
-        Result := Result + '    Message:           ' + f.AsString + System.sLineBreak;
-        Result := Result + '    Exception class:   ' + f.ExceptionClassName + System.sLineBreak;
-        Result := Result + '    Exception message: ' + f.ExceptionMessage + System.sLineBreak;
-        Result := Result + '        at ' + f.LocationInfo + System.sLineBreak;
+        WriteFailure(TTestFailure(Errors.Items[i]));
       end;
     end;
     if NumberOfFailures <> 0 then
@@ -238,11 +270,7 @@ begin
       for i := 0 to Failures.Count - 1 do
       begin
         Result := Result + '  Failure: ' + System.sLineBreak;
-        f := TTestFailure(Failures.Items[i]);
-        Result := Result + '    Message:           ' + f.AsString + System.sLineBreak;
-        Result := Result + '    Exception class:   ' + f.ExceptionClassName + System.sLineBreak;
-        Result := Result + '    Exception message: ' + f.ExceptionMessage + System.sLineBreak;
-        Result := Result + '        at ' + f.LocationInfo + System.sLineBreak;
+        WriteFailure(TTestFailure(Failures.Items[i]));
       end;
     end;
    if NumberOfIgnoredTests <> 0 then
@@ -253,10 +281,7 @@ begin
       for i := 0 to IgnoredTests.Count - 1 do
       begin
         Result := Result + '  Ignored test: ' + System.sLineBreak;
-        f := TTestFailure(IgnoredTests.Items[i]);
-        Result := Result + '    Message:           ' + f.AsString + System.sLineBreak;
-        Result := Result + '    Exception class:   ' + f.ExceptionClassName + System.sLineBreak;
-        Result := Result + '    Exception message: ' + f.ExceptionMessage + System.sLineBreak;
+        WriteFailure(TTestFailure(IgnoredTests.Items[i]),True);
       end;
     end;
   end;