tsafecall4.pp 985 B

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253
  1. { %TARGET=win32,win64,wince,linux}
  2. program tsafecall4;
  3. {$mode objfpc}{$H+}
  4. uses
  5. Classes, SysUtils;
  6. procedure SafecallProcedure(AParam1,AParam2: integer); safecall;
  7. var i,j: double;
  8. begin
  9. if (AParam1<>$123456) or (AParam2<>$654321) then
  10. halt(1);
  11. i := 1;
  12. j := 0;
  13. // division by zero, but no exception should be raised. Instead the function
  14. // result has to be <> 0
  15. i := i/j;
  16. end;
  17. function SafecallFunction(AParam1,AParam2: integer): string; safecall;
  18. begin
  19. if (AParam1<>$123456) or (AParam2<>$654321) then
  20. halt(2);
  21. raise exception.create('Ignore and return non-zero');
  22. end;
  23. var
  24. s : string;
  25. pass : boolean;
  26. begin
  27. pass := false;
  28. try
  29. SafecallProcedure($123456,$654321);
  30. except
  31. on E: ESafecallException do
  32. pass := true;
  33. end;
  34. if not pass then
  35. halt(11);
  36. pass := false;
  37. try
  38. s := SafecallFunction($123456,$654321);
  39. except
  40. on E: ESafecallException do
  41. pass := true;
  42. end;
  43. if not pass then
  44. halt(12);
  45. end.