2
0

DUnitCompatibleInterface.inc 5.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137
  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 CheckIs(obj :TObject; pClass: TClass; msg: string = ''); overload;
  18. class procedure CheckSame(expected, actual: TObject; msg: string = ''); overload;
  19. class procedure FailNotEquals(expected, actual: string; msg: string = ''; errorAddr: Pointer = nil); virtual;
  20. {
  21. *** TODO ***
  22. procedure CheckEqualsBin(expected, actual: longword; msg: string = ''; digits: integer=32); virtual;
  23. procedure CheckEqualsHex(expected, actual: longword; msg: string = ''; digits: integer=8); virtual;
  24. procedure CheckNotEqualsBin(expected, actual: longword; msg: string = ''; digits: integer=32); virtual;
  25. procedure CheckNotEqualsHex(expected, actual: longword; msg: string = ''; digits: integer=8); virtual;
  26. procedure CheckNotNull(obj :IUnknown; msg :string = ''); overload; virtual;
  27. procedure CheckSame(expected, actual: IUnknown; msg: string = ''); overload; virtual;
  28. procedure CheckException(AMethod: TTestMethod; AExceptionClass: TClass; msg :string = '');
  29. procedure CheckInherits(expected, actual: TClass; msg: string = ''); overload; virtual;
  30. }
  31. {$ENDIF read_interface}
  32. {$IFDEF read_implementation}
  33. class procedure TAssert.Check(pValue: boolean; pMessage: string);
  34. begin
  35. AssertTrue(pMessage, pValue);
  36. end;
  37. class procedure TAssert.CheckEquals(expected, actual: extended; msg: string);
  38. begin
  39. AssertEquals(msg, expected, actual);
  40. end;
  41. class procedure TAssert.CheckEquals(expected, actual: string; msg: string);
  42. begin
  43. AssertEquals(msg, expected, actual);
  44. end;
  45. class procedure TAssert.CheckEquals(expected, actual: extended;
  46. delta: extended; msg: string);
  47. begin
  48. AssertEquals(msg, expected, actual, delta);
  49. end;
  50. class procedure TAssert.CheckEquals(expected, actual: integer; msg: string);
  51. begin
  52. AssertEquals(msg, expected, actual);
  53. end;
  54. class procedure TAssert.CheckEquals(expected, actual: boolean; msg: string);
  55. begin
  56. AssertEquals(msg, expected, actual);
  57. end;
  58. class procedure TAssert.CheckEquals(expected, actual: TClass; msg: string);
  59. begin
  60. AssertEquals(msg, expected, actual);
  61. end;
  62. class procedure TAssert.CheckNotEquals(expected, actual: string; msg: string);
  63. begin
  64. if AnsiCompareStr(Expected, Actual) = 0 then
  65. Fail(msg + ComparisonMsg(Expected, Actual));
  66. end;
  67. class procedure TAssert.CheckNotEquals(expected, actual: integer; msg: string);
  68. begin
  69. if (expected = actual) then
  70. Fail(msg + ComparisonMsg(IntToStr(expected), IntToStr(actual)));
  71. end;
  72. class procedure TAssert.CheckNotEquals(expected, actual: boolean; msg: string);
  73. begin
  74. if (expected = actual) then
  75. Fail(msg + ComparisonMsg(BoolToStr(expected), BoolToStr(actual)));
  76. end;
  77. class procedure TAssert.CheckNotEquals(expected: extended; actual: extended;
  78. delta: extended; msg: string);
  79. begin
  80. if (abs(expected-actual) <= delta) then
  81. FailNotEquals(FloatToStr(expected), FloatToStr(actual), msg, nil);
  82. end;
  83. class procedure TAssert.CheckNull(obj: IUnknown; msg: string);
  84. begin
  85. AssertNullIntf(msg, obj);
  86. end;
  87. class procedure TAssert.CheckNull(obj: TObject; msg: string);
  88. begin
  89. AssertNull(msg, obj);
  90. end;
  91. class procedure TAssert.CheckNotNull(obj: TObject; msg: string);
  92. begin
  93. AssertNotNull(msg, obj);
  94. end;
  95. class procedure TAssert.CheckIs(obj: TObject; pClass: TClass; msg: string);
  96. begin
  97. Assert(pClass <> nil);
  98. if obj = nil then
  99. Fail(ComparisonMsg(pClass.ClassName, 'nil'))
  100. else if not obj.ClassType.InheritsFrom(pClass) then
  101. Fail(ComparisonMsg(pClass.ClassName, obj.ClassName));
  102. end;
  103. class procedure TAssert.CheckSame(expected, actual: TObject; msg: string);
  104. begin
  105. AssertSame(msg, expected, actual);
  106. end;
  107. class procedure TAssert.FailNotEquals(expected, actual: string; msg: string;
  108. errorAddr: Pointer);
  109. begin
  110. Fail(msg + ComparisonMsg(Expected, Actual));
  111. end;
  112. {$ENDIF read_implementation}