Browse Source

+ Patch from Graeme to add DUnit compatibility interface.

git-svn-id: trunk@3968 -
michael 19 years ago
parent
commit
fce57deb31
4 changed files with 285 additions and 8 deletions
  1. 1 0
      .gitattributes
  2. 138 0
      fcl/fpcunit/DUnitCompatibleInterface.inc
  3. 143 6
      fcl/fpcunit/fpcunit.pp
  4. 3 2
      fcl/fpcunit/testdecorator.pp

+ 1 - 0
.gitattributes

@@ -766,6 +766,7 @@ fcl/dbtests/testbasics.pas svneol=native#text/plain
 fcl/dbtests/testdbbasics.pas -text
 fcl/dbtests/testdbbasics.pas -text
 fcl/dbtests/testsqlfieldtypes.pas -text
 fcl/dbtests/testsqlfieldtypes.pas -text
 fcl/dbtests/toolsunit.pas -text
 fcl/dbtests/toolsunit.pas -text
+fcl/fpcunit/DUnitCompatibleInterface.inc svneol=native#text/plain
 fcl/fpcunit/Makefile svneol=native#text/plain
 fcl/fpcunit/Makefile svneol=native#text/plain
 fcl/fpcunit/Makefile.fpc svneol=native#text/plain
 fcl/fpcunit/Makefile.fpc svneol=native#text/plain
 fcl/fpcunit/README.txt svneol=native#text/plain
 fcl/fpcunit/README.txt svneol=native#text/plain

+ 138 - 0
fcl/fpcunit/DUnitCompatibleInterface.inc

@@ -0,0 +1,138 @@
+{%MainUnit fpcunit.pp}
+
+{$IFDEF read_interface}
+
+{
+    function  GetName: string; virtual;
+    property  Name: string read GetName;
+}
+
+    class procedure Check(pValue: boolean; pMessage: string = '');
+    class procedure CheckEquals(expected, actual: extended; msg: string = ''); overload;
+    class procedure CheckEquals(expected, actual: string; msg: string = ''); overload;
+    class procedure CheckEquals(expected, actual: extended; delta: extended; msg: string = ''); overload;
+    class procedure CheckEquals(expected, actual: integer; msg: string = ''); overload;
+    class procedure CheckEquals(expected, actual: boolean; msg: string = ''); overload;
+    class procedure CheckEquals(expected, actual: TClass; msg: string = ''); overload;
+    class procedure CheckNotEquals(expected, actual: string; msg: string = ''); overload;
+    class procedure CheckNull(obj: IUnknown; msg: string = ''); overload;
+    class procedure CheckNull(obj: TObject; msg: string = ''); overload;
+    class procedure CheckNotNull(obj: TObject; msg: string = ''); overload;
+    class procedure CheckIs(obj :TObject; pClass: TClass; msg: string = ''); overload;
+    class procedure CheckSame(expected, actual: TObject; msg: string = ''); overload;
+    {
+    *** TODO  ***
+    procedure CheckEqualsBin(expected, actual: longword; msg: string = ''; digits: integer=32); virtual;
+    procedure CheckEqualsHex(expected, actual: longword; msg: string = ''; digits: integer=8); virtual;
+
+    procedure CheckNotEquals(expected, actual: integer; msg: string = ''); overload; virtual;
+    procedure CheckNotEquals(expected: extended; actual: extended; delta: extended = 0; msg: string = ''); overload; virtual;
+    procedure CheckNotEquals(expected, actual: boolean; msg: string = ''); overload; virtual;
+    procedure CheckNotEqualsBin(expected, actual: longword; msg: string = ''; digits: integer=32); virtual;
+    procedure CheckNotEqualsHex(expected, actual: longword; msg: string = ''; digits: integer=8); virtual;
+
+    procedure CheckNotNull(obj :IUnknown; msg :string = ''); overload; virtual;
+    procedure CheckSame(expected, actual: IUnknown; msg: string = ''); overload; virtual;
+
+
+    procedure CheckException(AMethod: TTestMethod; AExceptionClass: TClass; msg :string = '');
+    procedure CheckInherits(expected, actual: TClass; msg: string = ''); overload; virtual;
+    }
+
+{$ENDIF read_interface}
+
+
+{$IFDEF read_implementation}
+
+{
+function TAssert.GetName: string;
+begin
+  Result := TestName;
+end;
+}
+
+class procedure TAssert.Check(pValue: boolean; pMessage: string);
+begin
+  AssertTrue(pMessage, pValue);
+end;
+
+
+class procedure TAssert.CheckEquals(expected, actual: extended; msg: string);
+begin
+  AssertEquals(msg, expected, actual);
+end;
+
+
+class procedure TAssert.CheckEquals(expected, actual: string; msg: string);
+begin
+  AssertEquals(msg, expected, actual);
+end;
+
+
+class procedure TAssert.CheckEquals(expected, actual: extended;
+  delta: extended; msg: string);
+begin
+  AssertEquals(msg, expected, actual, delta);
+end;
+
+
+class procedure TAssert.CheckEquals(expected, actual: integer; msg: string);
+begin
+  AssertEquals(msg, expected, actual);
+end;
+
+
+class procedure TAssert.CheckEquals(expected, actual: boolean; msg: string);
+begin
+  AssertEquals(msg, expected, actual);
+end;
+
+
+class procedure TAssert.CheckEquals(expected, actual: TClass; msg: string);
+begin
+  AssertEquals(msg, expected, actual);
+end;
+
+
+class procedure TAssert.CheckNotEquals(expected, actual: string; msg: string);
+begin
+  if AnsiCompareStr(Expected, Actual) = 0 then
+    Fail(msg + ComparisonMsg(Expected, Actual));
+end;
+
+
+class procedure TAssert.CheckNull(obj: IUnknown; msg: string);
+begin
+  AssertNullIntf(msg, obj);
+end;
+
+
+class procedure TAssert.CheckNull(obj: TObject; msg: string);
+begin
+  AssertNull(msg, obj);
+end;
+
+
+class procedure TAssert.CheckNotNull(obj: TObject; msg: string);
+begin
+  AssertNotNull(msg, obj);
+end;
+
+
+class procedure TAssert.CheckIs(obj: TObject; pClass: TClass; msg: string);
+begin
+  Assert(pClass <> nil);
+  if obj = nil then
+    Fail(ComparisonMsg(pClass.ClassName, 'nil'))
+  else if not obj.ClassType.InheritsFrom(pClass) then
+    Fail(ComparisonMsg(pClass.ClassName, obj.ClassName));
+end;
+
+
+class procedure TAssert.CheckSame(expected, actual: TObject; msg: string);
+begin
+   AssertSame(msg, expected, actual);
+end;
+
+{$ENDIF read_implementation}
+

+ 143 - 6
fcl/fpcunit/fpcunit.pp

@@ -1,5 +1,3 @@
-{$mode objfpc}
-{$h+}
 {
 {
     This file is part of the Free Component Library (FCL)
     This file is part of the Free Component Library (FCL)
     Copyright (c) 2004 by Dean Zobec, Michael Van Canneyt
     Copyright (c) 2004 by Dean Zobec, Michael Van Canneyt
@@ -16,14 +14,28 @@
  **********************************************************************}
  **********************************************************************}
 unit fpcunit;
 unit fpcunit;
 
 
+{$mode objfpc}
+{$h+}
+
 interface
 interface
-{$define SHOWLINEINFO}
+{$DEFINE SHOWLINEINFO}
+{ Uncomment this define to remove the DUnit compatibility interface. }
+{$DEFINE DUnit}
 
 
 uses
 uses
   {$ifdef SHOWLINEINFO}
   {$ifdef SHOWLINEINFO}
   LineInfo,
   LineInfo,
   {$endif}
   {$endif}
-  SysUtils, Classes;
+  SysUtils
+  ,Classes
+  ;
+
+
+{ This lets us use a single include file for both the Interface and
+  Implementation sections. }
+{$define read_interface}
+{$undef read_implementation}
+
 
 
 type
 type
 
 
@@ -56,6 +68,7 @@ type
   end;
   end;
   {$M-}
   {$M-}
 
 
+
   TAssert = class(TTest)
   TAssert = class(TTest)
   public
   public
     class procedure Fail(const AMessage: string);
     class procedure Fail(const AMessage: string);
@@ -103,6 +116,10 @@ type
     class procedure AssertNotNull(const AString: string); overload;
     class procedure AssertNotNull(const AString: string); overload;
     class procedure AssertException(const AMessage: string; AExceptionClass: ExceptClass; AMethod: TRunMethod); overload;
     class procedure AssertException(const AMessage: string; AExceptionClass: ExceptClass; AMethod: TRunMethod); overload;
     class procedure AssertException(AExceptionClass: ExceptClass; AMethod: TRunMethod); overload;
     class procedure AssertException(AExceptionClass: ExceptClass; AMethod: TRunMethod); overload;
+
+    {$IFDEF DUnit}
+      {$I DUnitCompatibleInterface.inc}
+    {$ENDIF DUnit}
   end;
   end;
 
 
   TTestFailure = class(TObject)
   TTestFailure = class(TObject)
@@ -254,6 +271,13 @@ implementation
 uses
 uses
   testutils;
   testutils;
 
 
+
+{ This lets us use a single include file for both the Interface and
+  Implementation sections. }
+{$undef read_interface}
+{$define read_implementation}
+
+
 type
 type
 
 
   TTestWarning = class(TTestCase)
   TTestWarning = class(TTestCase)
@@ -263,26 +287,31 @@ type
     procedure RunTest; override;
     procedure RunTest; override;
   end;
   end;
 
 
+
 procedure TTestWarning.RunTest;
 procedure TTestWarning.RunTest;
 begin
 begin
   Fail(FMessage);
   Fail(FMessage);
 end;
 end;
 
 
+
 function ComparisonMsg(const aExpected: string; const aActual: string): string;
 function ComparisonMsg(const aExpected: string; const aActual: string): string;
 begin
 begin
   Result := format(SCompare, [aExpected, aActual]);
   Result := format(SCompare, [aExpected, aActual]);
 end;
 end;
 
 
+
 constructor EAssertionFailedError.Create;
 constructor EAssertionFailedError.Create;
 begin
 begin
   inherited Create('');
   inherited Create('');
 end;
 end;
 
 
+
 constructor EAssertionFailedError.Create(const msg: string);
 constructor EAssertionFailedError.Create(const msg: string);
 begin
 begin
   inherited Create(msg);
   inherited Create(msg);
 end;
 end;
 
 
+
 constructor TTestFailure.CreateFailure(ATest: TTest; E: Exception; LastStep: TTestStep);
 constructor TTestFailure.CreateFailure(ATest: TTest; E: Exception; LastStep: TTestStep);
 begin
 begin
   inherited Create;
   inherited Create;
@@ -293,6 +322,7 @@ begin
   FTestLastStep := LastStep;
   FTestLastStep := LastStep;
 end;
 end;
 
 
+
 function TTestFailure.GetAsString: string;
 function TTestFailure.GetAsString: string;
 var
 var
   s: string;
   s: string;
@@ -304,11 +334,13 @@ begin
   Result := s + FTestName + ': ' + FRaisedExceptionMessage;
   Result := s + FTestName + ': ' + FRaisedExceptionMessage;
 end;
 end;
 
 
+
 function TTestFailure.GetExceptionClassName: string;
 function TTestFailure.GetExceptionClassName: string;
 begin
 begin
   Result := FRaisedExceptionClass.ClassName;
   Result := FRaisedExceptionClass.ClassName;
 end;
 end;
 
 
+
 function TTestFailure.GetExceptionMessage: string;
 function TTestFailure.GetExceptionMessage: string;
 begin
 begin
   Result := FRaisedExceptionMessage;
   Result := FRaisedExceptionMessage;
@@ -318,16 +350,19 @@ begin
     Result := '[TEARDOWN] ' + Result;
     Result := '[TEARDOWN] ' + Result;
 end;
 end;
 
 
+
 function TTestFailure.GetIsFailure: boolean;
 function TTestFailure.GetIsFailure: boolean;
 begin
 begin
   Result := FRaisedExceptionClass.InheritsFrom(EAssertionFailedError);
   Result := FRaisedExceptionClass.InheritsFrom(EAssertionFailedError);
 end;
 end;
 
 
+
 procedure TTestFailure.SetTestLastStep(const Value: TTestStep);
 procedure TTestFailure.SetTestLastStep(const Value: TTestStep);
 begin
 begin
   FTestLastStep := Value;
   FTestLastStep := Value;
 end;
 end;
 
 
+
 { TTest}
 { TTest}
 
 
 function TTest.GetTestName: string;
 function TTest.GetTestName: string;
@@ -335,20 +370,25 @@ begin
   Result := 'TTest';
   Result := 'TTest';
 end;
 end;
 
 
+
 function TTest.GetTestSuiteName: string;
 function TTest.GetTestSuiteName: string;
 begin
 begin
   Result := 'TTest';
   Result := 'TTest';
 end;
 end;
 
 
+
 function TTest.CountTestCases: integer;
 function TTest.CountTestCases: integer;
 begin
 begin
   Result := 0;
   Result := 0;
 end;
 end;
 
 
+
 procedure TTest.Run(AResult: TTestResult);
 procedure TTest.Run(AResult: TTestResult);
 begin
 begin
+  { do nothing }
 end;
 end;
 
 
+
 { TAssert }
 { TAssert }
 
 
 class procedure TAssert.Fail(const AMessage: String);
 class procedure TAssert.Fail(const AMessage: String);
@@ -356,57 +396,68 @@ begin
   raise EAssertionFailedError.Create(AMessage);
   raise EAssertionFailedError.Create(AMessage);
 end;
 end;
 
 
+
 class procedure TAssert.AssertTrue(const AMessage: String; ACondition: Boolean);
 class procedure TAssert.AssertTrue(const AMessage: String; ACondition: Boolean);
 begin
 begin
   if (not ACondition) then
   if (not ACondition) then
     Fail(AMessage);
     Fail(AMessage);
 end;
 end;
 
 
+
 class procedure TAssert.AssertTrue(ACondition: Boolean);
 class procedure TAssert.AssertTrue(ACondition: Boolean);
 begin
 begin
   AssertTrue('', ACondition);
   AssertTrue('', ACondition);
 end;
 end;
 
 
+
 class procedure TAssert.AssertFalse(const AMessage: String; ACondition: Boolean);
 class procedure TAssert.AssertFalse(const AMessage: String; ACondition: Boolean);
 begin
 begin
   AssertTrue(AMessage, not ACondition);
   AssertTrue(AMessage, not ACondition);
 end;
 end;
 
 
+
 class procedure TAssert.AssertFalse(ACondition: Boolean);
 class procedure TAssert.AssertFalse(ACondition: Boolean);
 begin
 begin
   AssertFalse('', ACondition);
   AssertFalse('', ACondition);
 end;
 end;
 
 
+
 class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual: string);
 class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual: string);
 begin
 begin
   AssertTrue(AMessage + ComparisonMsg(Expected, Actual), AnsiCompareStr(Expected, Actual) = 0);
   AssertTrue(AMessage + ComparisonMsg(Expected, Actual), AnsiCompareStr(Expected, Actual) = 0);
 end;
 end;
 
 
+
 class procedure TAssert.AssertEquals(Expected, Actual: string);
 class procedure TAssert.AssertEquals(Expected, Actual: string);
 begin
 begin
   AssertEquals('', Expected, Actual);
   AssertEquals('', Expected, Actual);
 end;
 end;
 
 
+
 class procedure TAssert.AssertNotNull(const AString: string);
 class procedure TAssert.AssertNotNull(const AString: string);
 begin
 begin
   AssertNotNull('', AString);
   AssertNotNull('', AString);
 end;
 end;
 
 
+
 class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual: integer);
 class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual: integer);
 begin
 begin
   AssertTrue(AMessage + ComparisonMsg(IntToStr(Expected), IntToStr(Actual)), Expected = Actual);
   AssertTrue(AMessage + ComparisonMsg(IntToStr(Expected), IntToStr(Actual)), Expected = Actual);
 end;
 end;
 
 
+
 class procedure TAssert.AssertEquals(Expected, Actual: integer);
 class procedure TAssert.AssertEquals(Expected, Actual: integer);
 begin
 begin
   AssertEquals('', Expected, Actual);
   AssertEquals('', Expected, Actual);
 end;
 end;
 
 
+
 class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual: int64);
 class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual: int64);
 begin
 begin
   AssertTrue(AMessage + ComparisonMsg(IntToStr(Expected), IntToStr(Actual)), Expected = Actual);
   AssertTrue(AMessage + ComparisonMsg(IntToStr(Expected), IntToStr(Actual)), Expected = Actual);
 end;
 end;
 
 
+
 class procedure TAssert.AssertEquals(Expected, Actual: int64);
 class procedure TAssert.AssertEquals(Expected, Actual: int64);
 begin
 begin
   AssertEquals('', Expected, Actual);
   AssertEquals('', Expected, Actual);
@@ -418,159 +469,190 @@ begin
   AssertTrue(AMessage + ComparisonMsg(FloatToStr(Expected), FloatToStr(Actual)), Expected = Actual);
   AssertTrue(AMessage + ComparisonMsg(FloatToStr(Expected), FloatToStr(Actual)), Expected = Actual);
 end;
 end;
 
 
+
 class procedure TAssert.AssertEquals(Expected, Actual: currency);
 class procedure TAssert.AssertEquals(Expected, Actual: currency);
 begin
 begin
    AssertEquals('', Expected, Actual);
    AssertEquals('', Expected, Actual);
 end;
 end;
 
 
+
 class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual, Delta: double);
 class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual, Delta: double);
 begin
 begin
   AssertTrue(AMessage + ComparisonMsg(FloatToStr(Expected),FloatToStr(Actual)),
   AssertTrue(AMessage + ComparisonMsg(FloatToStr(Expected),FloatToStr(Actual)),
     (Abs(Expected - Actual) <= Delta));
     (Abs(Expected - Actual) <= Delta));
 end;
 end;
 
 
+
 class procedure TAssert.AssertEquals(Expected, Actual, Delta: double);
 class procedure TAssert.AssertEquals(Expected, Actual, Delta: double);
 begin
 begin
   AssertEquals('', Expected, Actual, Delta);
   AssertEquals('', Expected, Actual, Delta);
 end;
 end;
 
 
+
 class procedure TAssert.AssertNotNull(const AMessage, AString: string);
 class procedure TAssert.AssertNotNull(const AMessage, AString: string);
 begin
 begin
   AssertTrue(AMessage, AString <> '');
   AssertTrue(AMessage, AString <> '');
 end;
 end;
 
 
+
 class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual: boolean);
 class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual: boolean);
 begin
 begin
   AssertTrue(AMessage + ComparisonMsg(BoolToStr(Expected), BoolToStr(Actual)), Expected = Actual);
   AssertTrue(AMessage + ComparisonMsg(BoolToStr(Expected), BoolToStr(Actual)), Expected = Actual);
 end;
 end;
 
 
+
 class procedure TAssert.AssertEquals(Expected, Actual: boolean);
 class procedure TAssert.AssertEquals(Expected, Actual: boolean);
 begin
 begin
   AssertEquals('', Expected, Actual);
   AssertEquals('', Expected, Actual);
 end;
 end;
 
 
+
 class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual: char);
 class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual: char);
 begin
 begin
   AssertTrue(AMessage + ComparisonMsg(Expected, Actual), Expected = Actual);
   AssertTrue(AMessage + ComparisonMsg(Expected, Actual), Expected = Actual);
 end;
 end;
 
 
+
 class procedure TAssert.AssertEquals(Expected, Actual: char);
 class procedure TAssert.AssertEquals(Expected, Actual: char);
 begin
 begin
   AssertEquals('', Expected, Actual);
   AssertEquals('', Expected, Actual);
 end;
 end;
 
 
+
 class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual: TClass);
 class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual: TClass);
 begin
 begin
   AssertTrue(AMessage + ComparisonMsg(Expected.ClassName, Actual.ClassName), Expected = Actual);
   AssertTrue(AMessage + ComparisonMsg(Expected.ClassName, Actual.ClassName), Expected = Actual);
 end;
 end;
 
 
+
 class procedure TAssert.AssertEquals(Expected, Actual: TClass);
 class procedure TAssert.AssertEquals(Expected, Actual: TClass);
 begin
 begin
   AssertEquals('', Expected, Actual);
   AssertEquals('', Expected, Actual);
 end;
 end;
 
 
+
 class procedure TAssert.AssertSame(const AMessage: string; Expected, Actual: TObject);
 class procedure TAssert.AssertSame(const AMessage: string; Expected, Actual: TObject);
 begin
 begin
   AssertTrue(AMessage + ComparisonMsg(IntToStr(PtrInt(Expected)), IntToStr(PtrInt(Actual))),
   AssertTrue(AMessage + ComparisonMsg(IntToStr(PtrInt(Expected)), IntToStr(PtrInt(Actual))),
     Expected = Actual);
     Expected = Actual);
 end;
 end;
 
 
+
 class procedure TAssert.AssertSame(Expected, Actual: TObject);
 class procedure TAssert.AssertSame(Expected, Actual: TObject);
 begin
 begin
   AssertSame('', Expected, Actual);
   AssertSame('', Expected, Actual);
 end;
 end;
 
 
+
 class procedure TAssert.AssertSame(const AMessage: string; Expected, Actual: Pointer);
 class procedure TAssert.AssertSame(const AMessage: string; Expected, Actual: Pointer);
 begin
 begin
   AssertTrue(AMessage + ComparisonMsg(IntToStr(PtrInt(Expected)), IntToStr(PtrInt(Actual))),
   AssertTrue(AMessage + ComparisonMsg(IntToStr(PtrInt(Expected)), IntToStr(PtrInt(Actual))),
     Expected = Actual);
     Expected = Actual);
 end;
 end;
 
 
+
 class procedure TAssert.AssertSame(Expected, Actual: Pointer);
 class procedure TAssert.AssertSame(Expected, Actual: Pointer);
 begin
 begin
   AssertSame('', Expected, Actual);
   AssertSame('', Expected, Actual);
 end;
 end;
 
 
+
 class procedure TAssert.AssertNotSame(const AMessage: string; Expected, Actual: TObject);
 class procedure TAssert.AssertNotSame(const AMessage: string; Expected, Actual: TObject);
 begin
 begin
   AssertFalse(SExpectedNotSame, Expected = Actual);
   AssertFalse(SExpectedNotSame, Expected = Actual);
 end;
 end;
 
 
+
 class procedure TAssert.AssertNotSame(Expected, Actual: TObject);
 class procedure TAssert.AssertNotSame(Expected, Actual: TObject);
 begin
 begin
   AssertNotSame('', Expected, Actual);
   AssertNotSame('', Expected, Actual);
 end;
 end;
 
 
+
 class procedure TAssert.AssertNotSame(const AMessage: string; Expected, Actual: Pointer);
 class procedure TAssert.AssertNotSame(const AMessage: string; Expected, Actual: Pointer);
 begin
 begin
   AssertFalse(SExpectedNotSame, Expected = Actual);
   AssertFalse(SExpectedNotSame, Expected = Actual);
 end;
 end;
 
 
+
 class procedure TAssert.AssertNotSame(Expected, Actual: Pointer);
 class procedure TAssert.AssertNotSame(Expected, Actual: Pointer);
 begin
 begin
   AssertNotSame('', Expected, Actual);
   AssertNotSame('', Expected, Actual);
 end;
 end;
 
 
+
 class procedure TAssert.AssertNotNull(const AMessage: string; AObject: TObject);
 class procedure TAssert.AssertNotNull(const AMessage: string; AObject: TObject);
 begin
 begin
   AssertTrue(AMessage, (AObject <> nil));
   AssertTrue(AMessage, (AObject <> nil));
 end;
 end;
 
 
+
 class procedure TAssert.AssertNotNull(AObject: TObject);
 class procedure TAssert.AssertNotNull(AObject: TObject);
 begin
 begin
   AssertNotNull('', AObject);
   AssertNotNull('', AObject);
 end;
 end;
 
 
+
 class procedure TAssert.AssertNotNullIntf(const AMessage: string; AInterface: IInterface);
 class procedure TAssert.AssertNotNullIntf(const AMessage: string; AInterface: IInterface);
 begin
 begin
   AssertTrue(AMessage, (AInterface <> nil));
   AssertTrue(AMessage, (AInterface <> nil));
 end;
 end;
 
 
+
 class procedure TAssert.AssertNotNullIntf(AInterface: IInterface);
 class procedure TAssert.AssertNotNullIntf(AInterface: IInterface);
 begin
 begin
   AssertNotNull('', AInterface);
   AssertNotNull('', AInterface);
 end;
 end;
 
 
+
 class procedure TAssert.AssertNotNull(const AMessage: string; APointer: Pointer);
 class procedure TAssert.AssertNotNull(const AMessage: string; APointer: Pointer);
 begin
 begin
   AssertTrue(AMessage, (APointer <> nil));
   AssertTrue(AMessage, (APointer <> nil));
 end;
 end;
 
 
+
 class procedure TAssert.AssertNotNull(APointer: Pointer);
 class procedure TAssert.AssertNotNull(APointer: Pointer);
 begin
 begin
   AssertNotNull('', APointer);
   AssertNotNull('', APointer);
 end;
 end;
 
 
+
 class procedure TAssert.AssertNull(const AMessage: string; AObject: TObject);
 class procedure TAssert.AssertNull(const AMessage: string; AObject: TObject);
 begin
 begin
   AssertTrue(AMessage, (AObject = nil));
   AssertTrue(AMessage, (AObject = nil));
 end;
 end;
 
 
+
 class procedure TAssert.AssertNull(AObject: TObject);
 class procedure TAssert.AssertNull(AObject: TObject);
 begin
 begin
   AssertNull('', AObject);
   AssertNull('', AObject);
 end;
 end;
 
 
+
 class procedure TAssert.AssertNullIntf(const AMessage: string; AInterface: IInterface);
 class procedure TAssert.AssertNullIntf(const AMessage: string; AInterface: IInterface);
 begin
 begin
   AssertTrue(AMessage, (AInterface = nil));
   AssertTrue(AMessage, (AInterface = nil));
 end;
 end;
 
 
+
 class procedure TAssert.AssertNullINtf(AInterface: IInterface);
 class procedure TAssert.AssertNullINtf(AInterface: IInterface);
 begin
 begin
   AssertNull('', AInterface);
   AssertNull('', AInterface);
 end;
 end;
 
 
+
 class procedure TAssert.AssertNull(const AMessage: string; APointer: Pointer);
 class procedure TAssert.AssertNull(const AMessage: string; APointer: Pointer);
 begin
 begin
   AssertTrue(AMessage, (APointer = nil));
   AssertTrue(AMessage, (APointer = nil));
 end;
 end;
 
 
+
 class procedure TAssert.AssertNull(APointer: Pointer);
 class procedure TAssert.AssertNull(APointer: Pointer);
 begin
 begin
   AssertNull('', APointer);
   AssertNull('', APointer);
 end;
 end;
 
 
+
 class procedure TAssert.AssertException(const AMessage: string; AExceptionClass: ExceptClass;
 class procedure TAssert.AssertException(const AMessage: string; AExceptionClass: ExceptClass;
   AMethod: TRunMethod);
   AMethod: TRunMethod);
 var
 var
@@ -593,23 +675,33 @@ begin
   AssertTrue(Format(SExceptionCompare, [AExceptionClass.ClassName, ExceptionName])+ ': ' + AMessage, Passed);
   AssertTrue(Format(SExceptionCompare, [AExceptionClass.ClassName, ExceptionName])+ ': ' + AMessage, Passed);
 end;
 end;
 
 
+
 class procedure TAssert.AssertException(AExceptionClass: ExceptClass;
 class procedure TAssert.AssertException(AExceptionClass: ExceptClass;
   AMethod: TRunMethod);
   AMethod: TRunMethod);
 begin
 begin
   AssertException('', AExceptionClass, AMethod);
   AssertException('', AExceptionClass, AMethod);
 end;
 end;
 
 
+
+{ DUnit compatibility interface }
+{$IFDEF DUnit}
+  {$I DUnitCompatibleInterface.inc}
+{$ENDIF DUnit}
+
+
 constructor TTestCase.Create;
 constructor TTestCase.Create;
 begin
 begin
   inherited Create;
   inherited Create;
 end;
 end;
 
 
+
 constructor TTestCase.CreateWithName(const AName: string);
 constructor TTestCase.CreateWithName(const AName: string);
 begin
 begin
   Create;
   Create;
   FName := AName;
   FName := AName;
 end;
 end;
 
 
+
 constructor TTestCase.CreateWith(const ATestName: string; const ATestSuiteName: string);
 constructor TTestCase.CreateWith(const ATestName: string; const ATestSuiteName: string);
 begin
 begin
   Create;
   Create;
@@ -617,16 +709,19 @@ begin
   FTestSuiteName := ATestSuiteName;
   FTestSuiteName := ATestSuiteName;
 end;
 end;
 
 
+
 function TTestCase.AsString: string;
 function TTestCase.AsString: string;
 begin
 begin
   Result := TestName + '(' + ClassName + ')';
   Result := TestName + '(' + ClassName + ')';
 end;
 end;
 
 
+
 function TTestCase.CountTestCases: integer;
 function TTestCase.CountTestCases: integer;
 begin
 begin
   Result := 1;
   Result := 1;
 end;
 end;
 
 
+
 function TTestCase.CreateResult: TTestResult;
 function TTestCase.CreateResult: TTestResult;
 begin
 begin
   Result := TTestResult.Create;
   Result := TTestResult.Create;
@@ -638,33 +733,39 @@ begin
   Result := FName;
   Result := FName;
 end;
 end;
 
 
+
 function TTestCase.GetTestSuiteName: string;
 function TTestCase.GetTestSuiteName: string;
 begin
 begin
   Result := FTestSuiteName;
   Result := FTestSuiteName;
 end;
 end;
 
 
+
 procedure TTestCase.SetTestSuiteName(const aName: string);
 procedure TTestCase.SetTestSuiteName(const aName: string);
 begin
 begin
   if FTestSuiteName <> aName then
   if FTestSuiteName <> aName then
     FTestSuiteName := aName;
     FTestSuiteName := aName;
 end;
 end;
 
 
+
 procedure TTestCase.SetTestName(const Value: string);
 procedure TTestCase.SetTestName(const Value: string);
 begin
 begin
   FName := Value;
   FName := Value;
 end;
 end;
 
 
+
 function TTestCase.CreateResultAndRun: TTestResult;
 function TTestCase.CreateResultAndRun: TTestResult;
 begin
 begin
   Result := CreateResult;
   Result := CreateResult;
   Run(Result);
   Run(Result);
 end;
 end;
 
 
+
 procedure TTestCase.Run(AResult: TTestResult);
 procedure TTestCase.Run(AResult: TTestResult);
 begin
 begin
   (AResult).Run(Self);
   (AResult).Run(Self);
 end;
 end;
 
 
+
 procedure TTestCase.RunBare;
 procedure TTestCase.RunBare;
 begin
 begin
   FLastStep := stSetUp;
   FLastStep := stSetUp;
@@ -679,6 +780,7 @@ begin
   FLastStep := stNothing;
   FLastStep := stNothing;
 end;
 end;
 
 
+
 procedure TTestCase.RunTest;
 procedure TTestCase.RunTest;
 var
 var
   m: TMethod;
   m: TMethod;
@@ -700,22 +802,26 @@ begin
     end;
     end;
 end;
 end;
 
 
+
 procedure TTestCase.SetUp;
 procedure TTestCase.SetUp;
 begin
 begin
-
+  { do nothing }
 end;
 end;
 
 
+
 procedure TTestCase.TearDown;
 procedure TTestCase.TearDown;
 begin
 begin
-
+  { do nothing }
 end;
 end;
 
 
+
 constructor TTestSuite.Create(AClass: TClass; AName: string);
 constructor TTestSuite.Create(AClass: TClass; AName: string);
 begin
 begin
   Create(AClass);
   Create(AClass);
   FName := AName;
   FName := AName;
 end;
 end;
 
 
+
 constructor TTestSuite.Create(AClass: TClass);
 constructor TTestSuite.Create(AClass: TClass);
 var
 var
   ml: TStringList;
   ml: TStringList;
@@ -743,6 +849,7 @@ begin
     AddTest(Warning(SNoValidTests + AClass.ClassName));
     AddTest(Warning(SNoValidTests + AClass.ClassName));
 end;
 end;
 
 
+
 constructor TTestSuite.Create(AClassArray: Array of TClass);
 constructor TTestSuite.Create(AClassArray: Array of TClass);
 var
 var
   i: integer;
   i: integer;
@@ -753,18 +860,21 @@ begin
       AddTest(TTestSuite.Create(AClassArray[i]));
       AddTest(TTestSuite.Create(AClassArray[i]));
 end;
 end;
 
 
+
 constructor TTestSuite.Create(AName: string);
 constructor TTestSuite.Create(AName: string);
 begin
 begin
   Create();
   Create();
   FName := AName;
   FName := AName;
 end;
 end;
 
 
+
 constructor TTestSuite.Create;
 constructor TTestSuite.Create;
 begin
 begin
   inherited Create;
   inherited Create;
   FTests := TFPList.Create;
   FTests := TFPList.Create;
 end;
 end;
 
 
+
 destructor TTestSuite.Destroy;
 destructor TTestSuite.Destroy;
 begin
 begin
   FreeObjects(FTests);
   FreeObjects(FTests);
@@ -772,32 +882,38 @@ begin
   inherited Destroy;
   inherited Destroy;
 end;
 end;
 
 
+
 function TTestSuite.GetTest(Index: integer): TTest;
 function TTestSuite.GetTest(Index: integer): TTest;
 begin
 begin
   Result := TTest(FTests[Index]);
   Result := TTest(FTests[Index]);
 end;
 end;
 
 
+
 function TTestSuite.GetTestName: string;
 function TTestSuite.GetTestName: string;
 begin
 begin
   Result := FName;
   Result := FName;
 end;
 end;
 
 
+
 function TTestSuite.GetTestSuiteName: string;
 function TTestSuite.GetTestSuiteName: string;
 begin
 begin
   Result := FTestSuiteName;
   Result := FTestSuiteName;
 end;
 end;
 
 
+
 procedure TTestSuite.SetTestName(const Value: string);
 procedure TTestSuite.SetTestName(const Value: string);
 begin
 begin
   FName := Value;
   FName := Value;
 end;
 end;
 
 
+
 procedure TTestSuite.SetTestSuiteName(const aName: string);
 procedure TTestSuite.SetTestSuiteName(const aName: string);
 begin
 begin
   if FTestSuiteName <> aName then
   if FTestSuiteName <> aName then
     FTestSuiteName := aName;
     FTestSuiteName := aName;
 end;
 end;
 
 
+
 function TTestSuite.CountTestCases: integer;
 function TTestSuite.CountTestCases: integer;
 var
 var
   i: integer;
   i: integer;
@@ -809,6 +925,7 @@ begin
   end;
   end;
 end;
 end;
 
 
+
 procedure TTestSuite.Run(AResult: TTestResult);
 procedure TTestSuite.Run(AResult: TTestResult);
 var
 var
   i: integer;
   i: integer;
@@ -817,11 +934,13 @@ begin
     RunTest(TTest(FTests[i]), AResult);
     RunTest(TTest(FTests[i]), AResult);
 end;
 end;
 
 
+
 procedure TTestSuite.RunTest(ATest: TTest; AResult: TTestResult);
 procedure TTestSuite.RunTest(ATest: TTest; AResult: TTestResult);
 begin
 begin
   ATest.Run(AResult);
   ATest.Run(AResult);
 end;
 end;
 
 
+
 procedure TTestSuite.AddTest(ATest: TTest);
 procedure TTestSuite.AddTest(ATest: TTest);
 begin
 begin
   FTests.Add(ATest);
   FTests.Add(ATest);
@@ -829,11 +948,13 @@ begin
     ATest.TestSuiteName := Self.TestName;
     ATest.TestSuiteName := Self.TestName;
 end;
 end;
 
 
+
 procedure TTestSuite.AddTestSuiteFromClass(ATestClass: TClass);
 procedure TTestSuite.AddTestSuiteFromClass(ATestClass: TClass);
 begin
 begin
   AddTest(TTestSuite.Create(ATestClass));
   AddTest(TTestSuite.Create(ATestClass));
 end;
 end;
 
 
+
 class function TTestSuite.Warning(const aMessage: string): TTestCase;
 class function TTestSuite.Warning(const aMessage: string): TTestCase;
 var
 var
   w: TTestWarning;
   w: TTestWarning;
@@ -843,6 +964,7 @@ begin
   Result := w;
   Result := w;
 end;
 end;
 
 
+
 constructor TTestResult.Create;
 constructor TTestResult.Create;
 begin
 begin
   inherited Create;
   inherited Create;
@@ -851,6 +973,7 @@ begin
   FListeners := TFPList.Create;
   FListeners := TFPList.Create;
 end;
 end;
 
 
+
 destructor TTestResult.Destroy;
 destructor TTestResult.Destroy;
 begin
 begin
   FreeObjects(FFailures);
   FreeObjects(FFailures);
@@ -860,6 +983,7 @@ begin
   FListeners.Free;
   FListeners.Free;
 end;
 end;
 
 
+
 procedure TTestResult.ClearErrorLists;
 procedure TTestResult.ClearErrorLists;
 begin
 begin
   FreeObjects(FFailures);
   FreeObjects(FFailures);
@@ -868,26 +992,31 @@ begin
   FErrors.Clear;
   FErrors.Clear;
 end;
 end;
 
 
+
 function TTestResult.GetNumErrors: integer;
 function TTestResult.GetNumErrors: integer;
 begin
 begin
   Result := FErrors.Count;
   Result := FErrors.Count;
 end;
 end;
 
 
+
 function TTestResult.GetNumFailures: integer;
 function TTestResult.GetNumFailures: integer;
 begin
 begin
   Result := FFailures.Count;
   Result := FFailures.Count;
 end;
 end;
 
 
+
 procedure TTestResult.AddListener(AListener: ITestListener);
 procedure TTestResult.AddListener(AListener: ITestListener);
 begin
 begin
   FListeners.Add(pointer(AListener));
   FListeners.Add(pointer(AListener));
 end;
 end;
 
 
+
 procedure TTestResult.RemoveListener(AListener: ITestListener);
 procedure TTestResult.RemoveListener(AListener: ITestListener);
 begin
 begin
   FListeners.Remove(pointer(AListener));
   FListeners.Remove(pointer(AListener));
 end;
 end;
 
 
+
 procedure TTestResult.AddFailure(ATest: TTest; E: EAssertionFailedError);
 procedure TTestResult.AddFailure(ATest: TTest; E: EAssertionFailedError);
 var
 var
   i: integer;
   i: integer;
@@ -901,6 +1030,7 @@ begin
   //unlock mutex
   //unlock mutex
 end;
 end;
 
 
+
 procedure TTestResult.AddError(ATest: TTest; E: Exception;
 procedure TTestResult.AddError(ATest: TTest; E: Exception;
   AUnitName: string; AFailedMethodName: string; ALineNumber: longint);
   AUnitName: string; AFailedMethodName: string; ALineNumber: longint);
 var
 var
@@ -918,6 +1048,7 @@ begin
   //unlock mutex
   //unlock mutex
 end;
 end;
 
 
+
 procedure TTestResult.EndTest(ATest: TTest);
 procedure TTestResult.EndTest(ATest: TTest);
 var
 var
   i: integer;
   i: integer;
@@ -926,11 +1057,13 @@ begin
     ITestListener(FListeners[i]).EndTest(ATest);
     ITestListener(FListeners[i]).EndTest(ATest);
 end;
 end;
 
 
+
 procedure ProtectTest(aTest: TTest; aResult: TTestResult);
 procedure ProtectTest(aTest: TTest; aResult: TTestResult);
 begin
 begin
   TTestCase(aTest).RunBare;
   TTestCase(aTest).RunBare;
 end;
 end;
 
 
+
 procedure TTestResult.Run(ATestCase: TTestCase);
 procedure TTestResult.Run(ATestCase: TTestCase);
 begin
 begin
   StartTest(ATestCase);
   StartTest(ATestCase);
@@ -938,6 +1071,7 @@ begin
   EndTest(ATestCase);
   EndTest(ATestCase);
 end;
 end;
 
 
+
 procedure TTestResult.RunProtected(ATestCase: TTest; protect: TProtect);
 procedure TTestResult.RunProtected(ATestCase: TTest; protect: TProtect);
 var
 var
   func, source: shortstring;
   func, source: shortstring;
@@ -961,6 +1095,7 @@ begin
   end;
   end;
 end;
 end;
 
 
+
 procedure TTestResult.StartTest(ATest: TTest);
 procedure TTestResult.StartTest(ATest: TTest);
 var
 var
   count: integer;
   count: integer;
@@ -974,6 +1109,7 @@ begin
   //unlock mutex
   //unlock mutex
 end;
 end;
 
 
+
 function TTestResult.WasSuccessful: boolean;
 function TTestResult.WasSuccessful: boolean;
 begin
 begin
 //lock mutex
 //lock mutex
@@ -982,3 +1118,4 @@ begin
 end;
 end;
 
 
 end.
 end.
+

+ 3 - 2
fcl/fpcunit/testdecorator.pp

@@ -1,5 +1,3 @@
-{$mode objfpc}
-{$h+}
 {
 {
     This file is part of the Free Component Library (FCL)
     This file is part of the Free Component Library (FCL)
     Copyright (c) 2005 by Dean Zobec
     Copyright (c) 2005 by Dean Zobec
@@ -17,6 +15,9 @@
 
 
 unit testdecorator; 
 unit testdecorator; 
 
 
+{$mode objfpc}
+{$h+}
+
 interface
 interface
 
 
 uses
 uses