paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-09 22:48:57 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Patch from Uberto Barbini:

Browse Source 
- 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.
This commit is contained in:
michael 2005-02-22 20:41:54 +00:00
parent 47cec51c8d
commit 438a0574ba
3 changed files with 219 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
fcl/fpcunit/demo/consolerunner/testrunner.pp
View File

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

164
fcl/fpcunit/exampletests/fpcunittests.pp
View File

@ -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.

66
fcl/fpcunit/fpcunit.pp
View File

@ -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}