+ Patch from Dean Zobec to be able to selectively ignore some tests

git-svn-id: trunk@4757 -

fcl/fpcunit/fpcunit.pp

@@ -47,6 +47,10 @@ type
     constructor Create(const msg :string); overload;
   end;
 
+
+  EIgnoredTest = class(EAssertionFailedError);
+
+
   TTestStep = (stSetUp, stRunTest, stTearDown, stNothing);
 
 
@@ -60,14 +64,18 @@ type
     FLastStep: TTestStep;
     function GetTestName: string; virtual;
     function GetTestSuiteName: string; virtual;
+    function GetEnableIgnores: boolean; virtual;
     procedure SetTestSuiteName(const aName: string); virtual; abstract;
+    procedure SetEnableIgnores(Value: boolean); virtual; abstract;
   public
     function CountTestCases: integer; virtual;
     procedure Run(AResult: TTestResult); virtual;
+    procedure Ignore(const AMessage: string);
   published
     property TestName: string read GetTestName;
     property TestSuiteName: string read GetTestSuiteName write SetTestSuiteName;
     property LastStep: TTestStep read FLastStep;
+    property EnableIgnores: boolean read GetEnableIgnores write SetEnableIgnores;
   end;
   {$M-}
 
@@ -138,6 +146,7 @@ type
     function GetAsString: string;
     function GetExceptionMessage: string;
     function GetIsFailure: boolean;
+    function GetIsIgnoredTest: boolean;
     function GetExceptionClassName: string;
     procedure SetTestLastStep(const Value: TTestStep);
   public
@@ -146,6 +155,7 @@ type
   published
     property AsString: string read GetAsString;
     property IsFailure: boolean read GetIsFailure;
+    property IsIgnoredTest: boolean read GetIsIgnoredTest;
     property ExceptionMessage: string read GetExceptionMessage;
     property ExceptionClassName: string read GetExceptionClassName;
     property SourceUnitName: string read FSourceUnitName write FSourceUnitName;
@@ -166,6 +176,7 @@ type
   private
     FName: string;
     FTestSuiteName: string;
+    FEnableIgnores: boolean;
   protected
     function CreateResult: TTestResult; virtual;
     procedure SetUp; virtual;
@@ -173,8 +184,10 @@ type
     procedure RunTest; virtual;
     function GetTestName: string; override;
     function GetTestSuiteName: string; override;
+    function GetEnableIgnores: boolean; override;
     procedure SetTestSuiteName(const aName: string); override;
     procedure SetTestName(const Value: string); virtual;
+    procedure SetEnableIgnores(Value: boolean); override;
     procedure RunBare; virtual;
   public
     constructor Create; virtual;
@@ -196,12 +209,15 @@ type
     FTests: TFPList;
     FName: string;
     FTestSuiteName: string;
+    FEnableIgnores: boolean;
     function GetTest(Index: integer): TTest;
   protected
     function GetTestName: string; override;
     function GetTestSuiteName: string; override;
+    function GetEnableIgnores: boolean; override;
     procedure SetTestSuiteName(const aName: string); override;
     procedure SetTestName(const Value: string); virtual;
+    procedure SetEnableIgnores(Value: boolean); override;
   public
     constructor Create(AClass: TClass; AName: string); reintroduce; overload; virtual;
     constructor Create(AClass: TClass); reintroduce; overload; virtual;
@@ -229,20 +245,21 @@ type
   protected
     FRunTests: integer;
     FFailures: TFPList;
+    FIgnoredTests: TFPList;
     FErrors: TFPList;
     FListeners: TFPList;
     FSkippedTests: TFPList;
     FStartingTime: TDateTime;
     function GetNumErrors: integer;
     function GetNumFailures: integer;
+    function GetNumIgnoredTests: integer;
     function GetNumSkipped: integer;
   public
     constructor Create; virtual;
     destructor Destroy; override;
-    property Listeners: TFPList read FListeners;
     procedure ClearErrorLists;
     procedure StartTest(ATest: TTest);
-    procedure AddFailure(ATest: TTest; E: EAssertionFailedError);
+    procedure AddFailure(ATest: TTest; E: EAssertionFailedError; aFailureList: TFPList);
     procedure AddError(ATest: TTest; E: Exception; AUnitName: string;
       AFailedMethodName: string; ALineNumber: longint);
     procedure EndTest(ATest: TTest);
@@ -255,17 +272,21 @@ type
     procedure AddToSkipList(ATestCase: TTestCase);
     procedure RemoveFromSkipList(ATestCase: TTestCase);
   published
+    property Listeners: TFPList read FListeners;
     property Failures: TFPList read FFailures;
+    property IgnoredTests: TFPList read FIgnoredTests;
     property Errors: TFPList read FErrors;
     property RunTests: integer read FRunTests;
     property NumberOfErrors: integer read GetNumErrors;
     property NumberOfFailures: integer read GetNumFailures;
+    property NumberOfIgnoredTests: integer read GetNumIgnoredTests;
     property NumberOfSkippedTests: integer read GetNumSkipped;
     property StartingTime: TDateTime read FStartingTime;
   end;
 
   function ComparisonMsg(const aExpected: string; const aActual: string): string;
 
+  
 Resourcestring
 
   SCompare = ' expected: <%s> but was: <%s>';
@@ -366,6 +387,10 @@ begin
   Result := FRaisedExceptionClass.InheritsFrom(EAssertionFailedError);
 end;
 
+function TTestFailure.GetIsIgnoredTest: boolean;
+begin
+  Result := FRaisedExceptionClass.InheritsFrom(EIgnoredTest);
+end;
 
 procedure TTestFailure.SetTestLastStep(const Value: TTestStep);
 begin
@@ -392,12 +417,20 @@ begin
   Result := 0;
 end;
 
+function TTest.GetEnableIgnores: boolean;
+begin
+  Result := True;
+end;
 
 procedure TTest.Run(AResult: TTestResult);
 begin
   { do nothing }
 end;
 
+procedure TTest.Ignore(const AMessage: String);
+begin
+  if EnableIgnores then raise EIgnoredTest.Create(AMessage);
+end;
 
 { TAssert }
 
@@ -702,6 +735,7 @@ end;
 constructor TTestCase.Create;
 begin
   inherited Create;
+  FEnableIgnores := True;
 end;
 
 
@@ -744,6 +778,12 @@ begin
 end;
 
 
+function TTestCase.GetEnableIgnores: boolean;
+begin
+  Result := FEnableIgnores;
+end;
+
+
 function TTestCase.GetTestSuiteName: string;
 begin
   Result := FTestSuiteName;
@@ -763,6 +803,12 @@ begin
 end;
 
 
+procedure TTestCase.SetEnableIgnores(Value: boolean);
+begin
+  FEnableIgnores := Value;
+end;
+
+
 function TTestCase.CreateResultAndRun: TTestResult;
 begin
   Result := CreateResult;
@@ -797,7 +843,7 @@ var
   RunMethod: TRunMethod;
   pMethod : Pointer;
 begin
-  AssertNotNull(FName);
+  AssertNotNull('name of the test not assigned', FName);
   pMethod := Self.MethodAddress(FName);
   if (Assigned(pMethod)) then
   begin
@@ -882,6 +928,7 @@ constructor TTestSuite.Create;
 begin
   inherited Create;
   FTests := TFPList.Create;
+  FEnableIgnores := True;
 end;
 
 
@@ -911,6 +958,12 @@ begin
 end;
 
 
+function TTestSuite.GetEnableIgnores: boolean;
+begin
+  Result := FEnableIgnores;
+end;
+
+
 procedure TTestSuite.SetTestName(const Value: string);
 begin
   FName := Value;
@@ -924,6 +977,18 @@ begin
 end;
 
 
+procedure TTestSuite.SetEnableIgnores(Value: boolean);
+var
+  i: integer;
+begin
+  if FEnableIgnores <> Value then
+  begin
+    FEnableIgnores := Value;
+    for i := 0 to FTests.Count - 1 do
+      TTest(FTests[i]).EnableIgnores := Value;
+  end
+end;
+
 function TTestSuite.CountTestCases: integer;
 var
   i: integer;
@@ -979,6 +1044,7 @@ constructor TTestResult.Create;
 begin
   inherited Create;
   FFailures       := TFPList.Create;
+  FIgnoredTests   := TFPList.Create;
   FErrors         := TFPList.Create;
   FListeners      := TFPList.Create;
   FSkippedTests   := TFPList.Create;
@@ -990,6 +1056,8 @@ destructor TTestResult.Destroy;
 begin
   FreeObjects(FFailures);
   FFailures.Free;
+  FreeObjects(FIgnoredTests);
+  FIgnoredTests.Free;
   FreeObjects(FErrors);
   FErrors.Free;
   FListeners.Free;
@@ -1001,6 +1069,8 @@ procedure TTestResult.ClearErrorLists;
 begin
   FreeObjects(FFailures);
   FFailures.Clear;
+  FreeObjects(FIgnoredTests);
+  FIgnoredTests.Clear;
   FreeObjects(FErrors);
   FErrors.Clear;
 end;
@@ -1017,6 +1087,10 @@ begin
   Result := FFailures.Count;
 end;
 
+function TTestResult.GetNumIgnoredTests: integer;
+begin
+  Result := FIgnoredTests.Count;
+end;
 
 function TTestResult.GetNumSkipped: integer;
 begin
@@ -1036,14 +1110,14 @@ begin
 end;
 
 
-procedure TTestResult.AddFailure(ATest: TTest; E: EAssertionFailedError);
+procedure TTestResult.AddFailure(ATest: TTest; E: EAssertionFailedError; aFailureList: TFPList);
 var
   i: integer;
   f: TTestFailure;
 begin
   //lock mutex
   f := TTestFailure.CreateFailure(ATest, E, ATest.LastStep);
-  FFailures.Add(f);
+  aFailureList.Add(f);
   for i := 0 to FListeners.Count - 1 do
     ITestListener(FListeners[i]).AddFailure(ATest, f);
   //unlock mutex
@@ -1105,8 +1179,10 @@ begin
   try
     protect(ATestCase, Self);
   except
+    on E: EIgnoredTest do
+      AddFailure(ATestCase, E, FIgnoredTests);
     on E: EAssertionFailedError do
-      AddFailure(ATestCase, E);
+      AddFailure(ATestCase, E, FFailures);
     on E: Exception do
       begin
       {$ifdef SHOWLINEINFO}

fcl/fpcunit/tests/asserttest.pp

@@ -19,13 +19,14 @@ unit asserttest;
 interface
 
 uses
-  fpcunit, testregistry;
+  fpcunit, testregistry, sysutils;
 
 type
 
   TAssertTest = class(TTestCase)
   published
     procedure TestFail;
+    procedure TestIgnore;
     procedure TestAssertSame;
     procedure TestAssertSameNull;
     procedure TestAssertNotSameFailsNull;
@@ -38,6 +39,18 @@ type
     procedure TestAssertNotSame;
   end;
 
+  TMyTest = class(TTestCase)
+  published
+    procedure RaiseIgnoreTest;
+  end;
+
+  TTestIgnore = class(TTestCase)
+  published
+    procedure TestIgnoreResult;
+    procedure TestIgnoreActivation;
+    procedure TestIgnoreSetting;
+  end;
+
 implementation
 
 procedure TAssertTest.TestFail;
@@ -51,6 +64,17 @@ begin
   raise EAssertionFailedError.Create;
 end;
 
+procedure TAssertTest.TestIgnore;
+begin
+  try
+    Ignore('Ignored Test');
+  except
+    on E: EIgnoredTest do
+      Exit;
+  end;
+  fail('Wrong or no Exception raised with ignore');
+end;
+
 procedure TAssertTest.TestAssertSame;
 var
   o: TObject;
@@ -209,8 +233,69 @@ begin
   Fail('Error: Objects are the same!');
 end;
 
+procedure TMyTest.RaiseIgnoreTest;
+begin
+  Ignore('This is an ignored test');
+  AssertEquals('the compiler can count', 3, 1+1); 
+end;
+
+procedure TTestIgnore.TestIgnoreResult;
+var
+  t: TMyTest;
+  res: TTestResult;
+begin
+  t := TMyTest.CreateWithName('RaiseIgnoreTest');
+  res := t.CreateResultAndRun;
+  assertEquals('no test was run', 1, res.RunTests);
+  assertEquals('no Ignored Test present', 1, res.NumberOfIgnoredTests);
+  assertTrue('failure is not signalled as Ignored Test', TTestFailure(res.IgnoredTests[0]).IsIgnoredTest);
+  assertEquals('wrong failure name', 'EIgnoredTest', TTestFailure(res.IgnoredTests[0]).ExceptionClassName);
+  assertEquals('wrong message', 'This is an ignored test', TTestFailure(res.IgnoredTests[0]).ExceptionMessage);
+  t.Free;
+  res.Free;
+end;
+
+procedure TTestIgnore.TestIgnoreActivation;
+var
+  t: TMyTest;
+  res: TTestResult;
+begin
+  t := TMyTest.CreateWithName('RaiseIgnoreTest');
+  t.EnableIgnores := false;
+  res := t.CreateResultandRun;
+  assertEquals('no test was run', 1, res.RunTests);
+  assertEquals('Ignored Test reported even if the switch is not active', 0, res.NumberOfIgnoredTests);
+  assertEquals('no failure caught', 1, res.NumberOfFailures);
+  assertFalse('failure is signalled as Ignored Test and the switch is not active', 
+    TTestFailure(res.Failures[0]).IsIgnoredTest);
+  assertEquals('wrong failure name', 'EAssertionFailedError', TTestFailure(res.Failures[0]).ExceptionClassName);
+  assertEquals('wrong message', 'the compiler can count expected: <3> but was: <2>', TTestFailure(res.Failures[0]).ExceptionMessage);
+  t.Free;
+  res.Free;
+end;
+
+procedure TTestIgnore.TestIgnoreSetting;
+var
+  ts: TTestSuite;
+  i: integer;
+begin
+  ts := TTestSuite.Create(TTestIgnore);
+  try
+    AssertTrue('EnableIgnores must be True at creation', ts.EnableIgnores);
+    for i := 0 to ts.Tests.Count - 1 do
+      AssertTrue('EnableIgnores of Test ' + IntToStr(i) + ' must be True at creation', TTest(ts.Tests[i]).EnableIgnores);
+    ts.EnableIgnores := False; 
+    AssertFalse('EnableIgnores was not set to false', ts.EnableIgnores);
+    for i := 0 to ts.Tests.Count - 1 do
+      AssertFalse('EnableIgnores of Test ' + IntToStr(i) + ' was not set to False', TTest(ts.Tests[i]).EnableIgnores);
+  finally
+    ts.Free;
+  end;
+end;
+
+
 initialization
 
-  RegisterTests([TAssertTest]);
+  RegisterTests([TAssertTest, TTestIgnore]);
 
 end.

fcl/fpcunit/tests/frameworktest.pp

@@ -46,6 +46,7 @@ begin
   FSuite := TTestSuite.Create;
   FSuite.TestName := 'Framework test';
   FSuite.AddTestSuiteFromClass(TAssertTest);
+  FSuite.AddTestSuiteFromClass(TTestIgnore);
   FSuite.AddTest(TSuiteTest.Suite());
 end;
 

fcl/fpcunit/xmlreporter.pas

@@ -51,6 +51,7 @@ type
     FResults: TDOMNode;
     FListing: TDOMNode;
     FFailures: TDOMNode;
+    FIgnores: TDOMNode;
     FErrors: TDOMNode;
     FStartCrono: TDateTime;
     { Converts the actual test results into XML nodes. This gets called
@@ -81,11 +82,10 @@ implementation
 
 procedure TXMLResultsWriter.TestResultAsXML(pTestResult: TTestResult);
 var
-  i: longint;
   n, lResults: TDOMNode;
 begin
   lResults := FDoc.FindNode('TestResults');
-  n := FDoc.CreateElement('NumberOfRunnedTests');
+  n := FDoc.CreateElement('NumberOfRunTests');
   n.AppendChild(FDoc.CreateTextNode(IntToStr(pTestResult.RunTests)));
   lResults.AppendChild(n);
 
@@ -96,6 +96,10 @@ begin
   n := FDoc.CreateElement('NumberOfFailures');
   n.AppendChild(FDoc.CreateTextNode(IntToStr(pTestResult.NumberOfFailures)));
   lResults.AppendChild(n);
+  
+  n := FDoc.CreateElement('NumberOfIgnoredTests');
+  n.AppendChild(FDoc.CreateTextNode(IntToStr(pTestResult.NumberOfIgnoredTests)));
+  lResults.AppendChild(n);
 
   n := FDoc.CreateElement('TotalElapsedTime');
   n.AppendChild(FDoc.CreateTextNode(FormatDateTime('hh:nn:ss.zzz', Now - pTestResult.StartingTime)));
@@ -124,6 +128,7 @@ begin
   FDoc        := TXMLDocument.Create;
   FResults    := nil;
   FFailures   := nil;
+  FIgnores    := nil;
   FErrors     := nil;
   FListing    := nil;
   WriteHeader;
@@ -144,24 +149,41 @@ end;
 
 
 procedure TXMLResultsWriter.AddFailure(ATest: TTest; AFailure: TTestFailure);
-var
-  n: TDOMElement;
-begin
-  { Try and find the node first }
-  if not Assigned(FFailures) then
-    FFailures := FDoc.FindNode('ListOfFailures');
-  { If we couldn't find it, create it }
-  if not Assigned(FFailures) then
+  procedure GenerateNode(aNode: TDOMNode);
+  var
+    n: TDOMElement;
+    s: string;
   begin
-    FFailures := FDoc.CreateElement('ListOfFailures');
-    FResults.AppendChild(FFailures);
+    if AFailure.IsIgnoredTest then 
+      s := 'ListOfIgnoredTests'
+    else
+      s := 'ListOfFailures';
+    { Try and find the node first }
+    if not Assigned(aNode) then
+      aNode := FDoc.FindNode(s);
+    { If we couldn't find it, create it }
+    if not Assigned(aNode) then
+    begin
+      aNode := FDoc.CreateElement(s);
+      FResults.AppendChild(aNode);
+    end;
+
+    if AFailure.IsIgnoredTest then 
+      s := 'IgnoredTest'
+    else
+      s := 'Failure';
+    n := FDoc.CreateElement(s);
+    n.AppendChild(FDoc.CreateElement('Message')         ).AppendChild(FDoc.CreateTextNode(AFailure.AsString));
+    n.AppendChild(FDoc.CreateElement('ExceptionClass')  ).AppendChild(FDoc.CreateTextNode(AFailure.ExceptionClassName));
+    n.AppendChild(FDoc.CreateElement('ExceptionMessage')).AppendChild(FDoc.CreateTextNode(AFailure.ExceptionMessage));
+    aNode.AppendChild(n);
   end;
-  
-  n := FDoc.CreateElement('Failure');
-  n.AppendChild(FDoc.CreateElement('Message')         ).AppendChild(FDoc.CreateTextNode(AFailure.AsString));
-  n.AppendChild(FDoc.CreateElement('ExceptionClass')  ).AppendChild(FDoc.CreateTextNode(AFailure.ExceptionClassName));
-  n.AppendChild(FDoc.CreateElement('ExceptionMessage')).AppendChild(FDoc.CreateTextNode(AFailure.ExceptionMessage));
-  FFailures.AppendChild(n);
+
+begin
+  if AFailure.IsIgnoredTest then
+    GenerateNode(FIgnores)
+  else
+    GenerateNode(FFailures);
 end;