mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 17:47:56 +02:00
2b3edb2c53
+ added test (needs to work with any exception handling mechanism; currently tested with SetJmp/LongJmp, SEH 32-bit and SEH 64-bit based exception handling) git-svn-id: trunk@49486 -
26 lines
412 B
ObjectPascal
26 lines
412 B
ObjectPascal
program texception11;
|
|
|
|
{$mode objfpc}
|
|
|
|
uses
|
|
SysUtils;
|
|
|
|
type
|
|
ETest = class(Exception);
|
|
|
|
procedure TestExcept(Obj : TObject; Addr : CodePointer; FrameCount:Longint; Frame: PCodePointer);
|
|
begin
|
|
if not (Obj is ETest) then
|
|
Halt(1);
|
|
if not (ExceptObject is ETest) then
|
|
Halt(2);
|
|
{ explicitely halt with exit code 0 }
|
|
Halt(0);
|
|
end;
|
|
|
|
begin
|
|
ExceptProc := @TestExcept;
|
|
|
|
raise ETest.Create('');
|
|
end.
|