mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-03 20:38:28 +02:00
f6d452c2c0
unit's initialization code in case we're in a library
+ implemented InquireSignal(), AbandonSignalHandler(), HookSignal() and
UnhookSignal() in the sysutils unit
* for Kylix compatibility, these routines support operating on
SIGINT and SIGQUIT as well, although they are not hooked by default
by FPC. The run time errors/exception codes for these signals are
resp. 217 and 233 (same as in Kylix; I changed ENoWideStringSupport
to 234).
* changed the BSD syscall version of fpsigaction to use pointer
rather than "var" arguments (compatible with other targets, and
required to be able to pass nil arguments inside the system unit)
-> together fixes mantis #12704
git-svn-id: trunk@13077 -
50 lines
820 B
ObjectPascal
50 lines
820 B
ObjectPascal
{ %target=darwin,linux,freebsd,solaris,beos,haiku }
|
|
{ %NEEDLIBRARY }
|
|
|
|
{$mode delphi}
|
|
program MainApp;
|
|
|
|
uses
|
|
sysutils;
|
|
|
|
const
|
|
{$ifdef windows}
|
|
libname='tw12704a.dll';
|
|
{$else}
|
|
libname='tw12704a';
|
|
{$linklib tw12704a}
|
|
{$endif}
|
|
|
|
procedure testsignals; cdecl; external libname;
|
|
|
|
procedure initsignals;
|
|
var
|
|
p: pointer;
|
|
i: longint;
|
|
begin
|
|
// check that standard signals are hooked
|
|
for i:=RTL_SIGINT to RTL_SIGLAST do
|
|
case i of
|
|
RTL_SIGINT,
|
|
RTL_SIGQUIT:
|
|
if (InquireSignal(i) <> ssNotHooked) then
|
|
halt(102);
|
|
RTL_SIGFPE,
|
|
RTL_SIGSEGV,
|
|
RTL_SIGILL,
|
|
RTL_SIGBUS:
|
|
if (InquireSignal(i) <> ssHooked) then
|
|
halt(103);
|
|
else
|
|
halt(104);
|
|
end;
|
|
|
|
// unhook sigbus
|
|
UnhookSignal(RTL_SIGBUS);
|
|
end;
|
|
|
|
begin
|
|
initsignals;
|
|
testsignals
|
|
end.
|