/packages/fcl-fpcunit/src/DUnitCompatibleInterface.inc
Pascal | 192 lines | 141 code | 35 blank | 16 comment | 11 complexity | 57d18ece1669becc29901524d8ccbb42 MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
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