/packages/fcl-fpcunit/src/DUnitCompatibleInterface.inc

  1{%MainUnit fpcunit.pp}
  2
  3{$IFDEF read_interface}
  4
  5    class procedure Check(pValue: boolean; pMessage: string = '');
  6    class procedure CheckEquals(expected, actual: extended; msg: string = ''); overload;
  7    class procedure CheckEquals(expected, actual: string; msg: string = ''); overload;
  8    class procedure CheckEquals(expected, actual: extended; delta: extended; msg: string = ''); overload;
  9    class procedure CheckEquals(expected, actual: integer; msg: string = ''); overload;
 10    class procedure CheckEquals(expected, actual: boolean; msg: string = ''); overload;
 11    class procedure CheckEquals(expected, actual: TClass; msg: string = ''); overload;
 12    class procedure CheckNotEquals(expected, actual: string; msg: string = ''); overload;
 13    class procedure CheckNotEquals(expected, actual: integer; msg: string = ''); overload; virtual;
 14    class procedure CheckNotEquals(expected, actual: boolean; msg: string = ''); overload; virtual;
 15    class procedure CheckNotEquals(expected: extended; actual: extended; delta: extended = 0; msg: string = ''); overload; virtual;
 16    class procedure CheckNull(obj: IUnknown; msg: string = ''); overload;
 17    class procedure CheckNull(obj: TObject; msg: string = ''); overload;
 18    class procedure CheckNotNull(obj: TObject; msg: string = ''); overload;
 19    class procedure CheckNotNull(obj: IUnknown; msg: string = ''); overload; virtual;
 20    class procedure CheckIs(obj :TObject; pClass: TClass; msg: string = ''); overload;
 21    class procedure CheckSame(expected, actual: TObject; msg: string = ''); overload;
 22    class procedure FailNotEquals(expected, actual: string; msg: string = ''; errorAddr: Pointer = nil); virtual;
 23    class procedure CheckTrue(condition: Boolean; msg: string = '');
 24    class procedure CheckFalse(condition: Boolean; msg: string = '');
 25    class procedure CheckException(AMethod: TRunMethod; AExceptionClass: ExceptClass; msg: string = '');
 26    class function  EqualsErrorMessage(const expected, actual: string; const ErrorMsg: string): string;
 27    class function  NotEqualsErrorMessage(const expected, actual: string; const ErrorMsg: string): string;
 28
 29    class function Suite: TTest;
 30
 31
 32    {
 33    *** TODO  ***
 34    procedure CheckEqualsBin(expected, actual: longword; msg: string = ''; digits: integer=32); virtual;
 35    procedure CheckEqualsHex(expected, actual: longword; msg: string = ''; digits: integer=8); virtual;
 36    procedure CheckNotEqualsBin(expected, actual: longword; msg: string = ''; digits: integer=32); virtual;
 37    procedure CheckNotEqualsHex(expected, actual: longword; msg: string = ''; digits: integer=8); virtual;
 38    procedure CheckNotNull(obj :IUnknown; msg :string = ''); overload; virtual;
 39    procedure CheckSame(expected, actual: IUnknown; msg: string = ''); overload; virtual;
 40    procedure CheckException(AMethod: TTestMethod; AExceptionClass: TClass; msg :string = '');
 41    procedure CheckInherits(expected, actual: TClass; msg: string = ''); overload; virtual;
 42    }
 43
 44{$ENDIF read_interface}
 45
 46
 47{$IFDEF read_implementation}
 48
 49class procedure TAssert.Check(pValue: boolean; pMessage: string);
 50begin
 51  AssertTrue(pMessage, pValue);
 52end;
 53
 54class procedure TAssert.CheckEquals(expected, actual: extended; msg: string);
 55begin
 56  AssertEquals(msg, expected, actual);
 57end;
 58
 59class procedure TAssert.CheckEquals(expected, actual: string; msg: string);
 60begin
 61  AssertEquals(msg, expected, actual);
 62end;
 63
 64class procedure TAssert.CheckEquals(expected, actual: extended;
 65  delta: extended; msg: string);
 66begin
 67  AssertEquals(msg, expected, actual, delta);
 68end;
 69
 70class procedure TAssert.CheckEquals(expected, actual: integer; msg: string);
 71begin
 72  AssertEquals(msg, expected, actual);
 73end;
 74
 75class procedure TAssert.CheckEquals(expected, actual: boolean; msg: string);
 76begin
 77  AssertEquals(msg, expected, actual);
 78end;
 79
 80class procedure TAssert.CheckEquals(expected, actual: TClass; msg: string);
 81begin
 82  AssertEquals(msg, expected, actual);
 83end;
 84
 85class procedure TAssert.CheckNotEquals(expected, actual: string; msg: string);
 86begin
 87  if AnsiCompareStr(Expected, Actual) = 0 then
 88    Fail(msg + ComparisonMsg(Expected, Actual));
 89end;
 90
 91class procedure TAssert.CheckNotEquals(expected, actual: integer; msg: string);
 92begin
 93  if (expected = actual) then
 94    Fail(msg + ComparisonMsg(IntToStr(expected), IntToStr(actual)));
 95end;
 96
 97class procedure TAssert.CheckNotEquals(expected, actual: boolean; msg: string);
 98begin
 99  if (expected = actual) then
100    Fail(msg + ComparisonMsg(BoolToStr(expected), BoolToStr(actual)));
101end;
102
103class procedure TAssert.CheckNotEquals(expected: extended; actual: extended;
104  delta: extended; msg: string);
105begin
106  if (abs(expected-actual) <= delta) then
107      FailNotEquals(FloatToStr(expected), FloatToStr(actual), msg, nil);
108end;
109
110class procedure TAssert.CheckNull(obj: IUnknown; msg: string);
111begin
112  AssertNullIntf(msg, obj);
113end;
114
115class procedure TAssert.CheckNull(obj: TObject; msg: string);
116begin
117  AssertNull(msg, obj);
118end;
119
120class procedure TAssert.CheckNotNull(obj: TObject; msg: string);
121begin
122  AssertNotNull(msg, obj);
123end;
124
125class procedure TAssert.CheckNotNull(obj: IUnknown; msg: string);
126begin
127  AssertNotNullIntf(msg, obj);
128end;
129
130class procedure TAssert.CheckIs(obj: TObject; pClass: TClass; msg: string);
131begin
132  Assert(pClass <> nil);
133  if obj = nil then
134    Fail(ComparisonMsg(pClass.ClassName, 'nil'))
135  else if not obj.ClassType.InheritsFrom(pClass) then
136    Fail(ComparisonMsg(pClass.ClassName, obj.ClassName));
137end;
138
139class procedure TAssert.CheckSame(expected, actual: TObject; msg: string);
140begin
141   AssertSame(msg, expected, actual);
142end;
143
144class procedure TAssert.FailNotEquals(expected, actual: string; msg: string;
145  errorAddr: Pointer);
146begin
147  Fail(msg + ComparisonMsg(Expected, Actual));
148end;
149
150class procedure TAssert.CheckTrue(condition: Boolean; msg: string);
151begin
152  if (not condition) then
153      FailNotEquals(BoolToStr(true, true), BoolToStr(false, true), msg, nil);
154end;
155
156class procedure TAssert.CheckFalse(condition: Boolean; msg: string);
157begin
158  if (condition) then
159      FailNotEquals(BoolToStr(false, true), BoolToStr(true, true), msg, nil);
160end;
161
162
163class procedure TAssert.CheckException(AMethod: TRunMethod; AExceptionClass: ExceptClass; msg: string = '');
164begin
165  AssertException(msg, AExceptionClass, AMethod);
166end;
167
168class function TAssert.EqualsErrorMessage(const expected, actual: string;
169    const ErrorMsg: string): string;
170begin
171  if (ErrorMsg <> '') then
172    Result := Format(sMsgActualEqualsExpFmt, [ErrorMsg + ', ', expected, actual])
173  else
174    Result := Format(sActualEqualsExpFmt, [expected, actual])
175end;
176
177class function TAssert.NotEqualsErrorMessage(const expected, actual: string;
178    const ErrorMsg: string): string;
179begin
180  if (ErrorMsg <> '') then
181    Result := Format(sExpectedButWasAndMessageFmt, [ErrorMsg, expected, actual])
182  else
183    Result := Format(sExpectedButWasFmt, [expected, actual]);
184end;
185
186class function TAssert.Suite: TTest;
187begin
188  result := TTestSuite.Create(self);
189end;
190
191{$ENDIF read_implementation}
192