tassert2.pp 1.2 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182
  1. {$C+}
  2. program tassert2;
  3. var
  4. global_boolean : boolean;
  5. counter : longint;
  6. const
  7. RESULT_BOOLEAN = false;
  8. procedure fail;
  9. begin
  10. Writeln('Failure!');
  11. Halt(1);
  12. end;
  13. function get_boolean : boolean;
  14. begin
  15. get_boolean := RESULT_BOOLEAN;
  16. end;
  17. procedure test_assert_reference_global;
  18. begin
  19. global_boolean:=RESULT_BOOLEAN;
  20. assert(global_boolean);
  21. end;
  22. procedure test_assert_reference_local;
  23. var
  24. b: boolean;
  25. begin
  26. b:=RESULT_BOOLEAN;
  27. assert(b);
  28. end;
  29. procedure test_assert_register;
  30. begin
  31. assert(get_boolean);
  32. end;
  33. procedure test_assert_flags;
  34. var
  35. i,j : integer;
  36. begin
  37. i:=0;
  38. j:=-12;
  39. assert(i < j);
  40. end;
  41. procedure test_assert_constant;
  42. begin
  43. assert(RESULT_BOOLEAN);
  44. end;
  45. { Handle the assertion failed ourselves, so we can test everything in
  46. one shot.
  47. }
  48. Procedure MyAssertRoutine(const msg,fname:ShortString;lineno:longint;erroraddr:{$ifdef VER1_0}longint{$else}pointer{$endif});
  49. begin
  50. Inc(counter);
  51. end;
  52. begin
  53. counter:=0;
  54. AssertErrorProc := @MyAssertRoutine;
  55. Write('Assert test (FALSE)...');
  56. test_assert_reference_global;
  57. test_assert_reference_local;
  58. test_assert_register;
  59. test_assert_flags;
  60. test_assert_constant;
  61. if counter <> 5 then
  62. fail
  63. else
  64. WriteLn('Success!');
  65. end.