Sign in Join

Live chat for Free Pascal, Lazarus, Delphi and every Pascal programmer.

Mailing lists / fpc-devel / 2006-07

bug 6039 (old number 4090)

1 message · 1 person ·

Reply by email Subscribe to this list Your subscription

Read-only archive. Use j and k to move between messages.

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,@blockset,nil);
    sigaction(signal,@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.

Reply by email