traise5.pp 1.9 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667
  1. { %RESULT=217 }
  2. {****************************************************************}
  3. { CODE GENERATOR TEST PROGRAM }
  4. { By Carl Eric Codere }
  5. {****************************************************************}
  6. { NODE TESTED : secondraise() }
  7. {****************************************************************}
  8. { PRE-REQUISITES: secondload() }
  9. { secondassign() }
  10. { secondtypeconv() }
  11. { secondtryexcept() }
  12. { secondcalln() }
  13. { secondadd() }
  14. {****************************************************************}
  15. { DEFINES: }
  16. { FPC = Target is FreePascal compiler }
  17. {****************************************************************}
  18. { REMARKS : Tested with Delphi 3 as reference implementation }
  19. {****************************************************************}
  20. program traise5;
  21. {$ifdef fpc}
  22. {$mode objfpc}
  23. {$endif}
  24. Type
  25. TAObject = class(TObject)
  26. a : longint;
  27. end;
  28. TBObject = Class(TObject)
  29. b : longint;
  30. constructor create(c: longint);
  31. end;
  32. { The test cases were taken from the SAL internal architecture manual }
  33. procedure fail;
  34. begin
  35. WriteLn('Failure.');
  36. halt(1);
  37. end;
  38. constructor tbobject.create(c:longint);
  39. begin
  40. inherited create;
  41. b:=c;
  42. end;
  43. procedure MyRoutine;
  44. Begin
  45. WriteLn('hello world!');
  46. end;
  47. var
  48. bobj: TBobject;
  49. i: integer;
  50. Begin
  51. i:=$7f;
  52. {$ifdef ver1_0}
  53. raise TBobject.create(i) at longint(@MyRoutine);
  54. {$else}
  55. raise TBobject.create(i) at @MyRoutine;
  56. {$endif}
  57. end.