[fpc-devel] bug 6039 (old number 4090)

[peter green]

this bug was closed a while back as "no change required" with the comment
"Add sa_flags:sa_siginfo if you want to get the siginfo and sigcontext"
(this comment didn't make it into the new bugtracker when the import was
made however).
This change did not fix the issue.

i've updated the test app so it will compile without any other files and to
make the
change suggested in the closure comment, the new version is pasted below and
still crashes on signal reception when using freepascal 2.0.2. To reproduce
the issue run the app and then send it a sigterm (e.g. killall irc)

program irc;


uses
    baseunix, unix, unixutil,
  classes, sysutils;//, inifiles;

    {$macro on}
    {$define sigprocmask := fpsigprocmask}
    {$define sigaction   := fpsigaction}
    {$define fdclose     := fpclose}
    {$define fcntl       := fpfcntl}
    {$define fdwrite     := fpwrite}
    {$define fdread      := fpread}
    {$define fdopen      := fpopen}
    {$define select      := fpselect}
    {$define linuxerror  := fpgeterrno}
    {$define fork        := fpfork}
    {$define getpid      := fpgetpid}
    {$define getenv      := fpgetenv}
    {$define chmod       := fpchmod}
    {$define dup2        := fpdup2}


procedure dofork(const programname:string);
var
  a:integer;
begin
  //writeln('dofork entered');
  //if (paramstr(1) = 'foreground') or (paramstr(1)='debug') then exit; {no
fork}
  a := fork;
  if a = 0 then exit; {i'm the child}
  if a < 0 then begin
    writeln('failed to run in background, try "'+programname+' foreground"
if it doesnt work otherwise');
    halt; {failed}
  end;

  halt; {i'm the parent}
end;
procedure lsignal_handler( Sig : Integer{$ifndef VER1_0}{$ifndef
VER1_9_4}{$ifndef
VER1_9_6};fucking:psiginfo;compiler:psigcontext{$endif}{$endif}{$endif});cde
cl;

begin

  writeln('got signal',sig);
end;

const


  saction : sigactionrec =
(sa_handler:lsignal_handler;sa_mask:(longint($FFFFFFFF - (1 shr sigstop) -
(1 shr sigkill)),0,0,0);sa_flags:sa_siginfo);


procedure starthandlesignal(signal:integer);

begin
  if signal in ([0..31]-[sigkill,sigstop]) then begin
    //sigprocmask(SIG_BLOCK, at blockset,nil);
    sigaction(signal, at saction,nil)
  end else begin
    raise exception.create('invalid signal number')
  end;
end;


begin


  {$ifdef unix}
    writeln('irc: Forking...');
    dofork('irc');
    starthandlesignal(sigterm);
    starthandlesignal(sighup);

  {$endif}

while true do;

end.