tmacpas2.pp 1.3 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980
  1. {$MODE MACPAS}
  2. {Tests of mac pascal constructs}
  3. program tmacpas2;
  4. var
  5. success: Boolean = true;
  6. type
  7. {Since we do not want to compile in the whole mac api, we
  8. simulate decl of FourCharCode here:}
  9. MyFourCharCodeType = Longword;
  10. procedure Proc;
  11. begin
  12. {** Exit with proc name as argument **}
  13. Exit(Proc);
  14. end;
  15. procedure TestFourCharCode(myFCC: MyFourCharCodeType);
  16. begin
  17. Writeln('FPC creator code as number: ', hexstr(myFCC,8));
  18. if myFCC <> $46506173 then
  19. success := false;
  20. end;
  21. const
  22. myFCCconst = 'FPas'; {Free Pascals Creator code :) }
  23. var
  24. p: pointer;
  25. l,i: longint;
  26. a,b,c : Boolean;
  27. begin
  28. a := true;
  29. b := true;
  30. c := false;
  31. {** Test & and | as alias for AND and OR **}
  32. if not (a & b) then
  33. success:= false;
  34. if not (c | b) then
  35. success:= false;
  36. {** Test that Ord() can take pointer values **}
  37. p:= pointer(4711);
  38. l:= Ord(p);
  39. if l <> 4711 then
  40. success:= false;
  41. {** Test cycle and leave **}
  42. i:= 0;
  43. while true do
  44. begin
  45. i:= i+1;
  46. if i = 1 then
  47. Cycle;
  48. Leave;
  49. end;
  50. if i<> 2 then
  51. success:= false;
  52. {** Does literal four char codes work**}
  53. {Both directly and indirectly}
  54. TestFourCharCode('FPas');
  55. TestFourCharCode(myFCCconst);
  56. if success then
  57. Writeln('Whole test succeded')
  58. else
  59. begin
  60. Writeln('Whole test failed');
  61. halt(1);
  62. end;
  63. end.