tw1152.pp 792 B

123456789101112131415161718192021222324252627282930313233343536373839404142434445
  1. { %SKIPEMU=qemu-arm }
  2. { %SKIPTARGET=wince }
  3. { Source provided for Free Pascal Bug Report 1152 }
  4. { Submitted by "Dirk Verwiebe" on 2000-09-30 }
  5. { e-mail: [email protected] }
  6. {$mode objfpc}
  7. program exception;
  8. uses sysutils,crt;
  9. var
  10. saveexit : codepointer;
  11. finally_called : boolean;
  12. procedure my_exit;
  13. begin
  14. exitproc:=saveexit;
  15. if not finally_called then
  16. begin
  17. Writeln('Problem with exception handling if crt unit is used');
  18. RunError(1);
  19. end
  20. else
  21. begin
  22. Writeln('Exception handling works');
  23. exitcode:=0;
  24. end;
  25. end;
  26. var
  27. p : pointer;
  28. BEGIN
  29. saveexit:=exitproc;
  30. exitproc:=@my_exit;
  31. finally_called:=false;
  32. try
  33. p:=pointer(-1);
  34. longint(p^):=0;
  35. finally
  36. finally_called:=true;
  37. writeln('Error !!!');
  38. end;
  39. END.