Forráskód Böngészése

* Patch from Uberto Barbini:
- enabled the possibility to show failures and errors that may occurr
in the setup and teardown of the tests
- added AssertNull and AssertNotNull for Interfaces.

michael 20 éve
szülő
commit
438a0574ba

+ 2 - 2
fcl/fpcunit/demo/consolerunner/testrunner.pp

@@ -16,9 +16,9 @@
 
  **********************************************************************}
 program testrunner;
-
 uses
-  custapp, classes, SysUtils, fpcunit, suiteconfig, testreport, testregistry;
+  custapp, classes, SysUtils, fpcunit, suiteconfig, testreport, 
+  testregistry;
 
 Const
   ShortOpts = 'alh';

+ 161 - 3
fcl/fpcunit/exampletests/fpcunittests.pp

@@ -61,7 +61,9 @@ type
     procedure FailEqualsTClass;
     procedure FailEqualsTObject;
     procedure FailAssertNull;
+    procedure FailAssertNullInterface;
     procedure FailAssertNotNull;
+    procedure FailAssertNotNullInterface;
     procedure RaiseMyException;
     procedure InterceptFailure(AMethod: TRunMethod; const ExpectedMessage: string);
   published
@@ -74,7 +76,9 @@ type
     procedure TestEqualsTClass;
     procedure TestEqualsTObject;
     procedure TestNull;
+    procedure TestNullInterface;
     procedure TestNotNull;
+    procedure TestNotNullInterface;
     procedure TestFailEqualsInt;
     procedure TestFailEqualsInt64;
     procedure TestFailEqualsCurrency;
@@ -84,7 +88,9 @@ type
     procedure TestFailEqualsTClass;
     procedure TestFailEqualsTObject;
     procedure TestFailNull;
+    procedure TestFailNullInterface;
     procedure TestFailNotNull;
+    procedure TestFailNotNullInterface;
     procedure TestAssertException;
     procedure TestComparisonMsg;
   end;
@@ -113,6 +119,20 @@ type
     procedure TestWithFailure;
   end;
 
+  TExampleStepTest = class(TTestCase)
+  private
+    FWhenException: TTestStep;
+    procedure SetWhenException(const Value: TTestStep);
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+  public
+    constructor Create; override;
+    property WhenException: TTestStep read FWhenException write SetWhenException;
+  published
+    procedure TestException;
+  end;
+
   TListenerTest = class(TTestCase)
   private
     FMockListener: TMockListener;
@@ -124,10 +144,26 @@ type
     procedure TestStartAndEndTest;
     procedure TestAddError;
     procedure TestAddFailure;
+    procedure TestSetUpTearDown;
+    procedure TestSetUpException;
+    procedure TestTearDownException;
+  end;
+
+  IMyIntf = interface
+    procedure SayGoodbye;
+  end;
+
+  TMyIntfObj = class(TInterfacedObject, IMyIntf)
+    procedure SayGoodbye;
   end;
 
 implementation
 
+procedure TMyIntfObj.SayGoodbye;
+begin
+  writeln('Ciao');
+end;
+
 procedure TTestCaseTest.SetUp;
 begin
   FFlag := 1
@@ -158,8 +194,6 @@ begin
   FSuite.Free;
 end;
 
-
-
 procedure TTestSuiteTest.CheckCountTestCases;
 begin
   AssertTrue(FSuite.CountTestCases = 2);
@@ -259,6 +293,14 @@ begin
   AssertNull(nil);
 end;
 
+procedure TAssertTest.TestNullInterface;
+var
+  myintf: IMyIntf;
+begin
+  myintf := nil;
+  AssertNull(myintf);
+end;
+
 procedure TAssertTest.TestNotNull;
 var
   obj: TTestCase;
@@ -268,6 +310,14 @@ begin
   obj.Free;
 end;
 
+procedure TAssertTest.TestNotNullInterface;
+var
+  myintf: IMyIntf;
+begin
+  myintf := TMyIntfObj.Create;
+  AssertNotNull(myintf);
+end;
+
 procedure TAssertTest.InterceptFailure(AMethod: TRunMethod; const ExpectedMessage: string);
 var
   failureIntercepted: boolean;
@@ -373,6 +423,18 @@ begin
   end;
 end;
 
+procedure TAssertTest.FailAssertNullInterface;
+var
+  myintf: IMyIntf;
+begin
+  myintf := TMyIntfObj.Create;
+  try
+    AssertNull(myIntf);
+  finally
+    myintf := nil;
+  end;
+end;
+
 procedure TAssertTest.FailAssertNotNull;
 var
   obj: TObject;
@@ -381,6 +443,14 @@ begin
   AssertNotNull(obj);
 end;
 
+procedure TAssertTest.FailAssertNotNullInterface;
+var
+  myintf: IMyIntf;
+begin
+  myintf := nil;
+  AssertNotNull(myintf);
+end;
+
 procedure TAssertTest.TestFailEqualsInt;
 begin
   InterceptFailure(@FailEqualsInt, ' expected: <33> but was: <34>');
@@ -431,11 +501,21 @@ begin
   InterceptFailure(@FailAssertNull, '');
 end;
 
+procedure TAssertTest.TestFailNullInterface;
+begin
+  InterceptFailure(@FailAssertNullInterface, '');
+end;
+
 procedure TAssertTest.TestFailNotNull;
 begin
   InterceptFailure(@FailAssertNotNull, '');
 end;
 
+procedure TAssertTest.TestFailNotNullInterface;
+begin
+  InterceptFailure(@FailAssertNotNullInterface, '');
+end;
+
 procedure TAssertTest.RaiseMyException;
 begin
   raise EMyException.Create('EMyException raised');
@@ -488,7 +568,6 @@ begin
   FList.Add('Ended: ' + ATest.TestName)
 end;
 
-
 procedure TMockListener.AddExpectedLine(ALine: string);
 begin
   FExpectedList.Add(ALine)
@@ -574,4 +653,83 @@ begin
   end;
 end;
 
+procedure TListenerTest.TestSetUpException;
+var
+  t: TExampleStepTest;
+begin
+  t := TExampleStepTest.CreateWith('TestException', 'TExampleStepTest');
+  try
+    t.WhenException := stSetUp;
+    t.Run(FResult);
+    FMockListener.AddExpectedLine('TestException: [SETUP] Error Raised');
+    FMockListener.Verify(FMockListener.FErrorList);
+  finally
+    t.Free;
+  end;
+end;
+
+procedure TListenerTest.TestTearDownException;
+var
+  t: TExampleStepTest;
+begin
+  t := TExampleStepTest.CreateWith('TestException', 'TExampleStepTest');
+  try
+    t.WhenException := stTearDown;
+    t.Run(FResult);
+    FMockListener.AddExpectedLine('TestException: [TEARDOWN] Error Raised');
+    FMockListener.Verify(FMockListener.FErrorList);
+  finally
+    t.Free;
+  end;
+end;
+
+procedure TListenerTest.TestSetUpTearDown;
+var
+  t: TExampleStepTest;
+begin
+  t := TExampleStepTest.CreateWith('TestException', 'TExampleStepTest');
+  try
+    t.WhenException := stNothing;
+    t.Run(FResult);
+    FMockListener.Verify(FMockListener.FErrorList);
+    FMockListener.Verify(FMockListener.FFailureList);
+  finally
+    t.Free;
+  end;
+end;
+
+{ TExampleStepTest }
+
+constructor TExampleStepTest.Create;
+begin
+  inherited;
+  FWhenException := stNothing;
+end;
+
+procedure TExampleStepTest.SetUp;
+begin
+  AssertTrue(stSetUp = LastStep);
+  if FWhenException = stSetUp then
+    raise exception.Create('Error Raised');
+  inherited;
+end;
+
+procedure TExampleStepTest.SetWhenException(const Value: TTestStep);
+begin
+  FWhenException := Value;
+end;
+
+procedure TExampleStepTest.TearDown;
+begin
+  AssertTrue(stTearDown = LastStep);
+  if FWhenException = stTearDown then
+    raise exception.Create('Error Raised');
+  inherited;
+end;
+
+procedure TExampleStepTest.TestException;
+begin
+  AssertTrue(True);
+end;
+
 end.

+ 56 - 10
fcl/fpcunit/fpcunit.pp

@@ -18,7 +18,6 @@
 unit fpcunit;
 
 interface
-
 {$define SHOWLINEINFO}
 
 uses
@@ -34,6 +33,9 @@ type
     constructor Create(const msg :string); overload;
   end;
 
+  TTestStep = (stSetUp, stRunTest, stTearDown, stNothing);
+
+
   TRunMethod = procedure of object;
 
   TTestResult = class;
@@ -41,6 +43,7 @@ type
   {$M+}
   TTest = class(TObject)
   protected
+    FLastStep: TTestStep;
     function GetTestName: string; virtual;
     function GetTestSuiteName: string; virtual;
     procedure SetTestSuiteName(const aName: string); virtual; abstract;
@@ -50,6 +53,7 @@ type
   published
     property TestName: string read GetTestName;
     property TestSuiteName: string read GetTestSuiteName write SetTestSuiteName;
+    property LastStep: TTestStep read FLastStep;
   end;
   {$M-}
 
@@ -86,10 +90,14 @@ type
     class procedure AssertNotSame(Expected, Actual: Pointer); overload;
     class procedure AssertNotNull(const AMessage: string; AObject: TObject); overload;
     class procedure AssertNotNull(AObject: TObject); overload;
+    class procedure AssertNotNull(const AMessage: string; AInterface: IInterface); overload;
+    class procedure AssertNotNull(AInterface: IInterface); overload;
     class procedure AssertNotNull(const AMessage: string; APointer: Pointer); overload;
     class procedure AssertNotNull(APointer: Pointer); overload;
     class procedure AssertNull(const AMessage: string; AObject: TObject); overload;
     class procedure AssertNull(AObject: TObject); overload;
+    class procedure AssertNull(const AMessage: string; AInterface: IInterface); overload;
+    class procedure AssertNull(AInterface: IInterface); overload;
     class procedure AssertNull(const AMessage: string; APointer: Pointer); overload;
     class procedure AssertNull(APointer: Pointer); overload;
     class procedure AssertNotNull(const AMessage, AString: string); overload;
@@ -107,12 +115,14 @@ type
     FRaisedExceptionClass: TClass;
     FRaisedExceptionMessage: string;
     FSourceUnitName: string;
+    FTestLastStep: TTestStep;
     function GetAsString: string;
     function GetExceptionMessage: string;
     function GetIsFailure: boolean;
     function GetExceptionClassName: string;
+    procedure SetTestLastStep(const Value: TTestStep);
   public
-    constructor CreateFailure(ATest: TTest; E: Exception);
+    constructor CreateFailure(ATest: TTest; E: Exception; LastStep: TTestStep);
     property ExceptionClass: TClass read FRaisedExceptionClass;
   published
     property AsString: string read GetAsString;
@@ -122,6 +132,7 @@ type
     property SourceUnitName: string read FSourceUnitName write FSourceUnitName;
     property LineNumber: longint read FLineNumber write FLineNumber;
     property MethodName: string read FMethodName write FMethodName;
+    property TestLastStep: TTestStep read FTestLastStep write SetTestLastStep;
   end;
 
   ITestListener = interface
@@ -145,14 +156,14 @@ type
     function GetTestSuiteName: string; override;
     procedure SetTestSuiteName(const aName: string); override;
     procedure SetTestName(const Value: string); virtual;
+    procedure RunBare; virtual;
   public
     constructor Create; virtual;
-    constructor CreateWith(const AName: string; const ATestSuiteName: string); virtual;
+    constructor CreateWith(const ATestName: string; const ATestSuiteName: string); virtual;
     constructor CreateWithName(const AName: string); virtual;
     function CountTestCases: integer; override;
     function CreateResultAndRun: TTestResult; virtual;
     procedure Run(AResult: TTestResult); override;
-    procedure RunBare; virtual;
     function AsString: string;
     property TestSuiteName: string read GetTestSuiteName write SetTestSuiteName;
   published
@@ -269,13 +280,14 @@ begin
   inherited Create(msg);
 end;
 
-constructor TTestFailure.CreateFailure(ATest: TTest; E: Exception);
+constructor TTestFailure.CreateFailure(ATest: TTest; E: Exception; LastStep: TTestStep);
 begin
   inherited Create;
   FTestName := ATest.GetTestName;
   FTestSuiteName := ATest.GetTestSuiteName;
   FRaisedExceptionClass := E.ClassType;
   FRaisedExceptionMessage := E.Message;
+  FTestLastStep := LastStep;
 end;
 
 function TTestFailure.GetAsString: string;
@@ -297,6 +309,10 @@ end;
 function TTestFailure.GetExceptionMessage: string;
 begin
   Result := FRaisedExceptionMessage;
+  if TestLastStep = stSetUp then
+    Result := '[SETUP] ' + Result
+  else if TestLastStep = stTearDown then
+    Result := '[TEARDOWN] ' + Result;
 end;
 
 function TTestFailure.GetIsFailure: boolean;
@@ -304,6 +320,11 @@ begin
   Result := FRaisedExceptionClass.InheritsFrom(EAssertionFailedError);
 end;
 
+procedure TTestFailure.SetTestLastStep(const Value: TTestStep);
+begin
+  FTestLastStep := Value;
+end;
+
 { TTest}
 
 function TTest.GetTestName: string;
@@ -497,6 +518,16 @@ begin
   AssertNotNull('', AObject);
 end;
 
+class procedure TAssert.AssertNotNull(const AMessage: string; AInterface: IInterface);
+begin
+  AssertTrue(AMessage, (AInterface <> nil));
+end;
+
+class procedure TAssert.AssertNotNull(AInterface: IInterface);
+begin
+  AssertNotNull('', AInterface);
+end;
+
 class procedure TAssert.AssertNotNull(const AMessage: string; APointer: Pointer);
 begin
   AssertTrue(AMessage, (APointer <> nil));
@@ -517,6 +548,16 @@ begin
   AssertNull('', AObject);
 end;
 
+class procedure TAssert.AssertNull(const AMessage: string; AInterface: IInterface);
+begin
+  AssertTrue(AMessage, (AInterface = nil));
+end;
+
+class procedure TAssert.AssertNull(AInterface: IInterface);
+begin
+  AssertNull('', AInterface);
+end;
+
 class procedure TAssert.AssertNull(const AMessage: string; APointer: Pointer);
 begin
   AssertTrue(AMessage, (APointer = nil));
@@ -566,10 +607,10 @@ begin
   FName := AName;
 end;
 
-constructor TTestCase.CreateWith(const AName: string; const ATestSuiteName: string);
+constructor TTestCase.CreateWith(const ATestName: string; const ATestSuiteName: string);
 begin
   Create;
-  FName := AName;
+  FName := ATestName;
   FTestSuiteName := ATestSuiteName;
 end;
 
@@ -623,12 +664,16 @@ end;
 
 procedure TTestCase.RunBare;
 begin
+  FLastStep := stSetUp;
   SetUp;
   try
+    FLastStep := stRunTest;
     RunTest;
+    FLastStep := stTearDown;
   finally
     TearDown;
   end;
+  FLastStep := stNothing;
 end;
 
 procedure TTestCase.RunTest;
@@ -846,7 +891,7 @@ var
   f: TTestFailure;
 begin
   //lock mutex
-  f := TTestFailure.CreateFailure(ATest, E);
+  f := TTestFailure.CreateFailure(ATest, E, ATest.LastStep);
   FFailures.Add(f);
   for i := 0 to FListeners.Count - 1 do
     ITestListener(FListeners[i]).AddFailure(ATest, f);
@@ -860,7 +905,7 @@ var
   f: TTestFailure;
 begin
   //lock mutex
-  f := TTestFailure.CreateFailure(ATest, E);
+  f := TTestFailure.CreateFailure(ATest, E, ATest.LastStep);
   f.SourceUnitName := AUnitName;
   f.MethodName := AMethodName;
   f.LineNumber := ALineNumber;
@@ -897,7 +942,8 @@ begin
   try
     ATestCase.RunBare;
   except
-    on E: EAssertionFailedError do AddFailure(ATestCase, E);
+    on E: EAssertionFailedError do
+      AddFailure(ATestCase, E);
     on E: Exception do
       begin
       {$ifdef SHOWLINEINFO}