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

https://github.com/slibre/freepascal · Pascal · 192 lines · 141 code · 35 blank · 16 comment · 11 complexity · 57d18ece1669becc29901524d8ccbb42 MD5 · raw file

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