paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-22 11:21:53 +02:00
Code Issues Packages Projects Releases Wiki Activity

TTestCase.CheckAssertCalled implemented (bug ID 28408)

Browse Source 
git-svn-id: trunk@32771 -
This commit is contained in:
michael 2015-12-27 19:31:50 +00:00
parent a2985a5572
commit 7ab8472a70
3 changed files with 57 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -2378,6 +2378,7 @@ packages/fcl-fpcunit/src/exampletests/Makefile.fpc svneol=native#text/plain
packages/fcl-fpcunit/src/exampletests/fpcunittests.pp svneol=native#text/plain
packages/fcl-fpcunit/src/exampletests/money.pp svneol=native#text/plain
packages/fcl-fpcunit/src/exampletests/moneytest.pp svneol=native#text/plain
packages/fcl-fpcunit/src/exampletests/needassert.pp svneol=native#text/plain
packages/fcl-fpcunit/src/exampletests/testmockobject.pp svneol=native#text/plain
packages/fcl-fpcunit/src/fpcunit.pp svneol=native#text/plain
packages/fcl-fpcunit/src/fpcunitreport.pp svneol=native#text/plain

38
packages/fcl-fpcunit/src/exampletests/needassert.pp Normal file
View File

@ -0,0 +1,38 @@
program needassert;
uses fpcunit, testregistry, consoletestrunner;
Type
TTestNeedAssert = Class(TTestCase)
Published
Procedure NeedsToFail;
Procedure NeedsToBeOK;
end;
Procedure TTestNeedAssert.NeedsToFail;
begin
// Do not call assert.
end;
Procedure TTestNeedAssert.NeedsToBeOK;
begin
AssertTrue('Some message',True);
end;
Var
Application : TTestRunner;
begin
RegisterTest(TTestNeedAssert);
TTestCase.CheckAssertCalled:=true;
DefaultFormat:=fPlain;
DefaultRunAllTests:=True;
Application:=TTestRunner.Create(Nil);
Application.Initialize;
Application.Run;
Application.Free;
end.

21
packages/fcl-fpcunit/src/fpcunit.pp
View File

@ -78,6 +78,8 @@ type
{ TAssert }
TAssert = class(TTest)
protected
Class var AssertCount : Integer;
public
class procedure Fail(const AMessage: string; AErrorAddrs: Pointer = nil);
class procedure Fail(const AFmt: string; Args : Array of const; AErrorAddrs: Pointer = nil);
@ -206,7 +208,10 @@ type
procedure SetTestName(const Value: string); virtual;
procedure SetEnableIgnores(Value: boolean); override;
procedure RunBare; virtual;
Public
Class Var CheckAssertCalled : Boolean;
public
constructor Create; virtual;
constructor CreateWith(const ATestName: string; const ATestSuiteName: string); virtual;
constructor CreateWithName(const AName: string); virtual;
@ -330,7 +335,8 @@ Resourcestring
SNoValidInheritance = ' does not inherit from TTestCase';
SNoValidTests = 'No valid tests found in ';
SNoException = 'no exception';
SAssertNotCalled = 'Assert not called during test.';
implementation
uses
@ -545,6 +551,7 @@ end;
class procedure TAssert.Fail(const AMessage: string; AErrorAddrs: Pointer);
begin
Inc(AssertCount);
if AErrorAddrs = nil then
raise EAssertionFailedError.Create(AMessage) at CallerAddr
else
@ -553,6 +560,7 @@ end;
class procedure TAssert.Fail(const AFmt: string; Args: array of const; AErrorAddrs: Pointer = nil);
begin
Inc(AssertCount);
if AErrorAddrs = nil then
raise EAssertionFailedError.CreateFmt(AFmt,Args) at CallerAddr
else
@ -574,7 +582,9 @@ begin
if AErrorAddrs=Nil then
AErrorAddrs:=CallerAddr;
if (not ACondition) then
Fail(AMessage,AErrorAddrs);
Fail(AMessage,AErrorAddrs)
else
Inc(AssertCount); // Fail will increae AssertCount
end;
@ -1013,10 +1023,13 @@ begin
RunMethod := TRunMethod(m);
ExpectException('',Nil,'',0);
try
AssertCount:=0;
FailMessage:='';
RunMethod;
if (FExpectedException<>Nil) then
FailMessage:=Format(SExceptionCompare, [FExpectedException.ClassName, SNoException])
FailMessage:=Format(SExceptionCompare, [FExpectedException.ClassName, SNoException]);
if CheckAssertCalled and (AssertCount=0) then
FailMessage:=SAssertNotCalled;
except
On E : Exception do
begin
@ -1465,5 +1478,7 @@ begin
ITestListener(FListeners[i]).EndTestSuite(ATestSuite);
end;
initialization
TTestCase.CheckAssertCalled:=False;
end.