(includes missing part of 8266 mentioned in log of r8307)

Merged revisions 8248,8250,8257,8259-8260,8264-8265,8267,8529 via svnmerge from 
svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
r8248 | jonas | 2007-08-08 15:59:17 +0200 (Wed, 08 Aug 2007) | 4 lines

  * don't call runerror if a unix threading error occurs (because this
    immediately terminates the whole application), but instead call
    handleerrorframe (which can be converted into an exception) (#7954)

........
r8250 | jonas | 2007-08-09 09:38:13 +0200 (Thu, 09 Aug 2007) | 5 lines

  * adapted test so both throwing an exception and not throwing an exception
    is ok (only entercritialsection immediately terminating the problem with
    an error code is wrong), since several OSes apparently don't check the
    validity of the criticalsection

........
r8257 | jonas | 2007-08-10 22:20:44 +0200 (Fri, 10 Aug 2007) | 7 lines

  * fixed semaphore implementation based on file handles (select needs
    file descriptor + 1 as first parameter, select can also be EIntr)
  * changed IntbasiceventWaitFor (used by syncobjs) so it can emulate
    timeouts (using a loop and short sleeps) (mantis #9414)
  * also added wrAbandoned support to IntbasiceventWaitFor
  * enhanced tbrtlevt.pp to test new functionality

........
r8259 | jonas | 2007-08-11 10:07:44 +0200 (Sat, 11 Aug 2007) | 3 lines

  * check once more whether we can lock after we've waited
    for the entire timeout in IntbasiceventWaitFor

........
r8260 | jonas | 2007-08-11 10:13:36 +0200 (Sat, 11 Aug 2007) | 3 lines

  * return wrAbandoned rather than wrError from IntbasiceventWaitFor
    in case a sleep is interrupted while the event is being destroyed

........
r8264 | jonas | 2007-08-11 22:58:20 +0200 (Sat, 11 Aug 2007) | 2 lines

  - removed obsolete {$threading on} directive

........
r8265 | jonas | 2007-08-11 22:59:37 +0200 (Sat, 11 Aug 2007) | 3 lines

  * explicitly unmask SIGSEGV, SIGILL, SIGBUS and SIGFPE at the start
    of a new thread (should fix #9073)

........
r8267 | jonas | 2007-08-12 13:01:53 +0200 (Sun, 12 Aug 2007) | 2 lines

  + test for #9073

........
r8529 | peter | 2007-09-17 22:26:29 +0200 (Mon, 17 Sep 2007) | 2 lines

  * added cdecl for sigmask

........

git-svn-id: branches/fixes_2_2@8545 -

.gitattributes

@@ -8248,6 +8248,7 @@ tests/webtbs/tw7817b.pp svneol=native#text/plain
 tests/webtbs/tw7847.pp svneol=native#text/plain
 tests/webtbs/tw7851.pp svneol=native#text/plain
 tests/webtbs/tw7851a.pp svneol=native#text/plain
+tests/webtbs/tw7954.pp svneol=native#text/plain
 tests/webtbs/tw7963.pp svneol=native#text/plain
 tests/webtbs/tw7975.pp svneol=native#text/plain
 tests/webtbs/tw7975a.pp svneol=native#text/plain
@@ -8319,6 +8320,7 @@ tests/webtbs/tw8919.pp svneol=native#text/plain
 tests/webtbs/tw8935.pp svneol=native#text/plain
 tests/webtbs/tw8977.pp svneol=native#text/plain
 tests/webtbs/tw9054.pp svneol=native#text/plain
+tests/webtbs/tw9073.pp svneol=native#text/plain
 tests/webtbs/tw9076.pp svneol=native#text/plain
 tests/webtbs/tw9076a.pp svneol=native#text/plain
 tests/webtbs/tw9085.pp svneol=native#text/plain

rtl/darwin/pthread.inc

@@ -62,7 +62,7 @@ function  pthread_cond_init(_para1:Ppthread_cond_t;_para2:Ppthread_condattr_t):c
 function  pthread_cond_signal(_para1:Ppthread_cond_t):cint;cdecl;external 'c' name 'pthread_cond_signal';
 function  pthread_cond_wait(_para1:Ppthread_cond_t;_para2:Ppthread_mutex_t):cint;cdecl;external 'c' name 'pthread_cond_wait';
 function pthread_kill(__thread:pthread_t; __signo:cint):cint;cdecl;external 'c';
-
+function pthread_sigmask(how: cint; nset: psigset; oset: psigset): cint; cdecl; external 'c';
 
 // not yet implemented in Mac OS X 10.4.8!
 // function sem_init(__sem:Psem_t; __pshared:cint;__value:cuint):cint;cdecl; external 'c' name 'sem_init';

rtl/freebsd/pthread.inc

@@ -63,6 +63,7 @@ function pthread_cond_init(_para1:Ppthread_cond_t;_para2:Ppthread_condattr_t):ci
 function pthread_cond_signal(_para1:Ppthread_cond_t):cint;cdecl;external;
 function pthread_cond_wait(_para1:Ppthread_cond_t;_para2:Ppthread_mutex_t):cint;cdecl;external;
 function pthread_kill(__thread:pthread_t; __signo:cint):cint;cdecl;external;
+function pthread_sigmask(how: cint; nset: psigset; oset: psigset): cint; cdecl; external;
 
 function sem_init(__sem:Psem_t; __pshared:cint;__value:dword):cint;cdecl; external;
 function sem_destroy(__sem:Psem_t):cint;cdecl;external ;

rtl/inc/system.inc

@@ -563,6 +563,12 @@ begin
 end;
 
 
+procedure fpc_threaderror; [public,alias:'FPC_THREADERROR'];
+begin
+  HandleErrorFrame(6,get_frame);
+end;
+
+
 procedure fpc_iocheck;[public,alias:'FPC_IOCHECK']; compilerproc;
 var
   l : longint;

rtl/linux/pthread.inc

@@ -34,6 +34,13 @@ Type
    TSemaphore = sem_t;
    PSemaphore = ^TSemaphore;
 
+{$ifndef FPC_USE_LIBC}
+   tlibc_sigset = array[0..(1024 div 32)-1] of cuLong;
+   plibc_sigset = ^tlibc_sigset;
+{$else not FPC_USE_LIBC}
+   tlibc_sigset = tsigset;
+   plibc_sigset = psigset;
+{$endif not FPC_USE_LIBC}
 
      TThreadPriority = (tpIdle, tpLowest, tpLower, tpNormal, tpHigher, tpHighest, tpTimeCritical);
 
@@ -44,12 +51,6 @@ Type
        THREAD_PRIORITY_HIGHEST, THREAD_PRIORITY_TIME_CRITICAL
      );
 
-{
-  type
-     psigset_t = ^sigset_t;
-     sigset_t = DWORD; // unsigned long 32 bits
-}
-
   const
      _POSIX_THREAD_THREADS_MAX = 64;
      PTHREAD_THREADS_MAX = 512;
@@ -127,6 +128,8 @@ Type
     function pthread_attr_getschedpolicy(__attr:ppthread_attr_t; __policy:plongint):longint;cdecl;external;
     function pthread_attr_setinheritsched(__attr:ppthread_attr_t; __inherit:longint):longint;cdecl;external;
     function pthread_attr_getinheritsched(__attr:ppthread_attr_t; __inherit:plongint):longint;cdecl;external;
+    function pthread_attr_setstacksize(p: ppthread_attr_t;s:size_t):cint;cdecl;external;
+    function pthread_attr_getstacksize(p: ppthread_attr_t;s:psize_t):cint;cdecl;external;
     function pthread_attr_setscope(__attr:ppthread_attr_t; __scope:longint):longint;cdecl;external;
     function pthread_attr_getscope(__attr:ppthread_attr_t; __scope:plongint):longint;cdecl;external;
     function pthread_setschedparam(__target_thread:pthread_t; __policy:longint; __param:psched_param):longint;cdecl;external;
@@ -159,11 +162,12 @@ Type
     procedure pthread_testcancel;cdecl;external;
 {    procedure _pthread_cleanup_push(__buffer:p_pthread_cleanup_buffer;__routine:t_pthread_cleanup_push_routine; __arg:pointer);cdecl;external; }
 {    procedure _pthread_cleanup_push_defer(__buffer:p_pthread_cleanup_buffer;__routine:t_pthread_cleanup_push_defer_routine; __arg:pointer);cdecl;external;}
-{    function pthread_sigmask(__how:longint; __newmask:psigset_t; __oldmask:psigset_t):longint;cdecl;external;}
+{    function pthread_sigmask(__how:longint; __newmask:plibc_sigset; __oldmask:plibc_sigset):longint;cdecl;external;}
     function pthread_kill(__thread:pthread_t; __signo:longint):longint;cdecl;external;
-{    function sigwait(__set:psigset_t; __sig:plongint):longint;cdecl;external;}
+{    function sigwait(__set:plibc_sigset; __sig:plongint):longint;cdecl;external;}
     function pthread_atfork(__prepare:tprocedure ; __parent:tprocedure ; __child:tprocedure ):longint;cdecl;external;
     procedure pthread_kill_other_threads_np;cdecl;external;
+    function pthread_sigmask(how: cint; nset: plibc_sigset; oset: plibc_sigset): cint; cdecl; external;
 
     function sem_init (__sem:Psem_t; __pshared:longint; __value:dword):longint;cdecl;external;
     function sem_destroy  (__sem:Psem_t):longint;cdecl;external;
@@ -227,11 +231,12 @@ Var
     pthread_testcancel : Procedure ;cdecl;
 {    _pthread_cleanup_push : procedure (__buffer:p_pthread_cleanup_buffer;__routine:t_pthread_cleanup_push_routine; __arg:pointer);cdecl;}
 {    _pthread_cleanup_push_defer : procedure (__buffer:p_pthread_cleanup_buffer;__routine:t_pthread_cleanup_push_defer_routine; __arg:pointer);cdecl;}
-{    pthread_sigmask : Function(__how:longint; __newmask:psigset_t; __oldmask:psigset_t):longint;cdecl;}
+{    pthread_sigmask : Function(__how:longint; __newmask:plibc_sigset; __oldmask:plibc_sigset):longint;cdecl;}
     pthread_kill : Function(__thread:pthread_t; __signo:longint):longint;cdecl;
-{    sigwait : Function(__set:psigset_t; __sig:plongint):longint;cdecl;}
+{    sigwait : Function(__set:plibc_sigset; __sig:plongint):longint;cdecl;}
     pthread_atfork : Function(__prepare:tprocedure ; __parent:tprocedure ; __child:tprocedure ):longint;cdecl;
     pthread_kill_other_threads_np : procedure;cdecl;
+    pthread_sigmask: Function(how: cint; nset: plibc_sigset; oset: plibc_sigset): cint;cdecl;
 
     sem_init     :   function (__sem:Psem_t; __pshared:longint; __value:dword):longint;cdecl;
     sem_destroy  :   function (__sem:Psem_t):longint;cdecl;
@@ -308,6 +313,7 @@ begin
   Pointer(pthread_kill)  := dlsym(PthreadDLL,'pthread_kill');
   Pointer(pthread_atfork):= dlsym(PthreadDLL,'pthread_atfork');
   Pointer(pthread_kill_other_threads_np) := dlsym(PthreadDLL,'pthread_kill_other_threads_np');
+  Pointer(pthread_sigmask) := dlsym(PthreadDLL,'pthread_sigmask');
   Pointer(sem_init     ) := dlsym(PthreadDLL,'sem_init');
   Pointer(sem_destroy  ) := dlsym(PthreadDLL,'sem_destroy');
   Pointer(sem_close    ) := dlsym(PthreadDLL,'sem_close');

rtl/solaris/pthread.inc

@@ -99,6 +99,7 @@ function  pthread_cond_init(_para1:Ppthread_cond_t;_para2:Ppthread_condattr_t):c
 function  pthread_cond_signal(_para1:Ppthread_cond_t):cint;cdecl;external 'c' name 'pthread_cond_signal';
 function  pthread_cond_wait(_para1:Ppthread_cond_t;_para2:Ppthread_mutex_t):cint;cdecl;external 'c' name 'pthread_cond_wait';
 function pthread_kill(__thread:pthread_t; __signo:cint):cint;cdecl;external 'c';
+function pthread_sigmask(how: cint; nset: psigset; oset: psigset): cint; cdecl; external 'c';
 
 function sem_init(__sem:Psem_t; __pshared:cint;__value:cuint):cint;cdecl; external 'c' name 'sem_init';
 function sem_destroy(__sem:Psem_t):cint;cdecl;external 'c' name 'sem_destroy';

rtl/unix/cthreads.pp

@@ -3,7 +3,7 @@
     Copyright (c) 2002 by Peter Vreman,
     member of the Free Pascal development team.
 
-    Linux (pthreads) threading support implementation
+    pthreads threading support implementation
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -61,6 +61,12 @@ Uses
 {$endif}
   ;
 
+{*****************************************************************************
+                             System unit import
+*****************************************************************************}
+
+procedure fpc_threaderror; [external name 'FPC_THREADERROR'];
+
 {*****************************************************************************
                              Generic overloaded
 *****************************************************************************}
@@ -75,6 +81,8 @@ Type  PINTRTLEvent = ^TINTRTLEvent;
         isset: boolean;
        end;
 
+      TTryWaitResult = (tw_error, tw_semwasunlocked, tw_semwaslocked);
+
 {*****************************************************************************
                              Threadvar support
 *****************************************************************************}
@@ -184,6 +192,10 @@ Type  PINTRTLEvent = ^TINTRTLEvent;
     function ThreadMain(param : pointer) : pointer;cdecl;
       var
         ti : tthreadinfo;
+        nset: tsigset;
+{$if defined(linux) and not defined(FPC_USE_LIBC)}
+        nlibcset: tlibc_sigset;
+{$endif linux/no FPC_USE_LIBC}
 {$ifdef DEBUG_MT}
         // in here, don't use write/writeln before having called
         // InitThread! I wonder if anyone ever debugged these routines,
@@ -198,6 +210,24 @@ Type  PINTRTLEvent = ^TINTRTLEvent;
         s := 'New thread started, initing threadvars'#10;
         fpwrite(0,s[1],length(s));
 {$endif DEBUG_MT}
+        { unblock all signals we are interested in (may be blocked by }
+        { default in new threads on some OSes, see #9073)             }
+        fpsigemptyset(nset);
+        fpsigaddset(nset,SIGSEGV);
+        fpsigaddset(nset,SIGBUS);
+        fpsigaddset(nset,SIGFPE);
+        fpsigaddset(nset,SIGILL);
+{$if defined(linux) and not defined(FPC_USE_LIBC)}
+        { sigset_t has a different size for linux/kernel and linux/libc }
+        fillchar(nlibcset,sizeof(nlibcset),0);
+        if (sizeof(nlibcset)>sizeof(nset)) then
+          move(nset,nlibcset,sizeof(nset))
+        else
+          move(nset,nlibcset,sizeof(nlibcset));
+        pthread_sigmask(SIG_UNBLOCK,@nlibcset,nil);
+{$else linux}
+        pthread_sigmask(SIG_UNBLOCK,@nset,nil);
+{$endif linux}
         { Allocate local thread vars, this must be the first thing,
           because the exception management and io depends on threadvars }
         CAllocateThreadVars;
@@ -327,14 +357,12 @@ Type  PINTRTLEvent = ^TINTRTLEvent;
       CWaitForThreadTerminate := dword(LResultP);
     end;
 
-{$warning threadhandle can be larger than a dword}
     function  CThreadSetPriority (threadHandle : TThreadID; Prio: longint): boolean; {-15..+15, 0=normal}
     begin
       {$Warning ThreadSetPriority needs to be implemented}
     end;
 
 
-{$warning threadhandle can be larger than a dword}
   function  CThreadGetPriority (threadHandle : TThreadID): Integer;
     begin
       {$Warning ThreadGetPriority needs to be implemented}
@@ -371,19 +399,19 @@ Type  PINTRTLEvent = ^TINTRTLEvent;
         res:= pthread_mutex_init(@CS,NIL);
       pthread_mutexattr_destroy(@MAttr);
       if res <> 0 then
-        runerror(6);
+        fpc_threaderror;
     end;
 
     procedure CEnterCriticalSection(var CS);
       begin
          if pthread_mutex_lock(@CS) <> 0 then
-           runerror(6);
+           fpc_threaderror
       end;
 
     procedure CLeaveCriticalSection(var CS);
       begin
          if pthread_mutex_unlock(@CS) <> 0 then
-           runerror(6)
+           fpc_threaderror
       end;
 
     procedure CDoneCriticalSection(var CS);
@@ -394,7 +422,7 @@ Type  PINTRTLEvent = ^TINTRTLEvent;
            ;
 
          if pthread_mutex_destroy(@CS) <> 0 then
-           runerror(6);
+           fpc_threaderror;
       end;
 
 
@@ -402,7 +430,6 @@ Type  PINTRTLEvent = ^TINTRTLEvent;
                            Semaphore routines
 *****************************************************************************}
   
-
 procedure cSemaphoreWait(const FSem: Pointer);
 var
   res: cint;
@@ -424,6 +451,7 @@ begin
 {$endif}
 end;
 
+
 procedure cSemaphorePost(const FSem: Pointer);
 {$if defined(has_sem_init) or defined(has_sem_open)}
 begin
@@ -444,6 +472,50 @@ end;
 {$endif}
 
 
+function cSemaphoreTryWait(const FSem: pointer): TTryWaitResult;
+var
+  res: cint;
+  err: cint;
+{$if defined(has_sem_init) or defined(has_sem_open)}
+begin
+  repeat
+    res:=sem_trywait(FSem);
+    err:=fpgetCerrno;
+  until (res<>-1) or (err<>ESysEINTR);
+  if (res=0) then
+    result:=tw_semwasunlocked
+  else if (err=ESysEAgain) then
+    result:=tw_semwaslocked
+  else
+    result:=tw_error;
+{$else has_sem_init or has_sem_open}
+var
+  fds: TFDSet;
+  tv : timeval;
+begin
+  tv.tv_sec:=0;
+  tv.tv_usec:=0;
+  fpFD_ZERO(fds);
+  fpFD_SET(PFilDes(FSem)^[0],fds);
+  repeat
+    res:=fpselect(PFilDes(FSem)^[0]+1,@fds,nil,nil,@tv);
+    err:=fpgeterrno;
+  until (res>=0) or ((res=-1) and (err<>ESysEIntr));
+  if (res>0) then
+    begin
+      cSemaphoreWait(FSem);
+      result:=tw_semwasunlocked
+    end
+  else if (res=0) then
+    result:=tw_semwaslocked
+  else
+    result:=tw_error;
+{$endif has_sem_init or has_sem_open}
+end;
+
+
+
+
 {$if defined(has_sem_open) and not defined(has_sem_init)}
 function cIntSemaphoreOpen(const name: pchar; initvalue: boolean): Pointer;
 var
@@ -568,7 +640,9 @@ type
      Tbasiceventstate=record
          FSem: Pointer;
          FEventSection: TPthreadMutex;
-         FManualReset: Boolean;
+         FWaiters: longint;
+         FManualReset,
+         FDestroying: Boolean;
         end;
      plocaleventstate = ^tbasiceventstate;
 //     peventstate=pointer;
@@ -587,12 +661,14 @@ var
 begin
   new(plocaleventstate(result));
   plocaleventstate(result)^.FManualReset:=AManualReset;
+  plocaleventstate(result)^.FWaiters:=0;
+  plocaleventstate(result)^.FDestroying:=False;
 {$ifdef has_sem_init}
   plocaleventstate(result)^.FSem:=cIntSemaphoreInit(true);
   if plocaleventstate(result)^.FSem=nil then
     begin
       FreeMem(result);
-      runerror(6);
+      fpc_threaderror;
     end;
 {$else}
 {$ifdef has_sem_open}
@@ -600,14 +676,14 @@ begin
   if (plocaleventstate(result)^.FSem = NIL) then
     begin
       FreeMem(result);
-      runerror(6);
+      fpc_threaderror;
     end;
 {$else}
   plocaleventstate(result)^.FSem:=cSemaphoreInit;
   if (plocaleventstate(result)^.FSem = NIL) then
     begin
       FreeMem(result);
-      runerror(6);
+      fpc_threaderror;
     end;
   if InitialState then
     cSemaphorePost(plocaleventstate(result)^.FSem);
@@ -630,54 +706,54 @@ begin
     begin
       cSemaphoreDestroy(plocaleventstate(result)^.FSem);
       FreeMem(result);
-      runerror(6);
+      fpc_threaderror;
     end;
 end;
 
 procedure Intbasiceventdestroy(state:peventstate);
-
+var
+  i: longint;
 begin
+  { safely mark that we are destroying this event }
+  pthread_mutex_lock(@plocaleventstate(state)^.feventsection);
+  plocaleventstate(state)^.FDestroying:=true;
+  { wake up everyone who is waiting }
+  for i := 1 to plocaleventstate(state)^.FWaiters do
+    cSemaphorePost(plocaleventstate(state)^.FSem);
+  pthread_mutex_unlock(@plocaleventstate(state)^.feventsection);
+  { now wait until they've finished their business }
+  while (plocaleventstate(state)^.FWaiters <> 0) do
+    cThreadSwitch;
+
+  { and clean up }
   cSemaphoreDestroy(plocaleventstate(state)^.FSem);
-  FreeMem(state);
+  dispose(plocaleventstate(state));
 end;
 
+
 procedure IntbasiceventResetEvent(state:peventstate);
 
-{$if defined(has_sem_init) or defined(has_sem_open)}
-var
-  res: cint;
-  err: cint;
 begin
-  repeat
-    res:=sem_trywait(psem_t(plocaleventstate(state)^.FSem));
-    err:=fpgeterrno;
-  until (res<>0) and ((res<>-1) or (err<>ESysEINTR));
-{$else has_sem_init or has_sem_open}
-var
-  fds: TFDSet;
-  tv : timeval;
-begin
-  tv.tv_sec:=0;
-  tv.tv_usec:=0;
-  fpFD_ZERO(fds);
-  fpFD_SET(PFilDes(plocaleventstate(state)^.FSem)^[0],fds);
+{$if not defined(has_sem_init) and not defined(has_sem_open)}
   pthread_mutex_lock(@plocaleventstate(state)^.feventsection);
-  Try
-    while fpselect(PFilDes(plocaleventstate(state)^.FSem)^[0],@fds,nil,nil,@tv) > 0 do
-      cSemaphoreWait(plocaleventstate(state)^.FSem);
+  try
+{$endif}
+    while (cSemaphoreTryWait(plocaleventstate(state)^.FSem) = tw_semwasunlocked) do
+      ;
+{$if not defined(has_sem_init) and not defined(has_sem_open)}
   finally
     pthread_mutex_unlock(@plocaleventstate(state)^.feventsection);
   end;
-{$endif has_sem_init or has_sem_open}
+{$endif}
 end;
 
 procedure IntbasiceventSetEvent(state:peventstate);
 
 Var
-{$if defined(has_sem_init) or defined(has_sem_open)}
-  Value : Longint;
   res : cint;
   err : cint;
+{$if defined(has_sem_init) or defined(has_sem_open)}
+  Value : Longint;
 {$else}
   fds: TFDSet;
   tv : timeval;
@@ -705,13 +781,17 @@ begin
         cSemaphorePost(plocaleventstate(state)^.FSem);
       end
     else
-      runerror(6);
+      fpc_threaderror;
 {$else has_sem_init or has_sem_open}
     tv.tv_sec:=0;
     tv.tv_usec:=0;
     fpFD_ZERO(fds);
     fpFD_SET(PFilDes(plocaleventstate(state)^.FSem)^[0],fds);
-    if fpselect(PFilDes(plocaleventstate(state)^.FSem)^[0],@fds,nil,nil,@tv)=0 then
+    repeat
+      res:=fpselect(PFilDes(plocaleventstate(state)^.FSem)^[0]+1,@fds,nil,nil,@tv);
+      err:=fpgeterrno;
+    until (res>=0) or ((res=-1) and (err<>ESysEIntr));
+    if (res=0) then
       cSemaphorePost(plocaleventstate(state)^.FSem);
 {$endif has_sem_init or has_sem_open}
   finally
@@ -719,15 +799,112 @@ begin
   end;
 end;
 
-function IntbasiceventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
 
+function IntbasiceventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
+var
+  i, loopcnt: cardinal;
+  timespec, timetemp, timeleft: ttimespec;
+  nanores, nanoerr: cint;
+  twres: TTryWaitResult;
+  lastloop: boolean;
 begin
-  If TimeOut<>Cardinal($FFFFFFFF) then
-    result:=wrError
-  else
+  { safely check whether we are being destroyed, if so immediately return. }
+  { otherwise (under the same mutex) increase the number of waiters        }
+  pthread_mutex_lock(@plocaleventstate(state)^.feventsection);
+  if (plocaleventstate(state)^.FDestroying) then
+    begin
+      pthread_mutex_unlock(@plocaleventstate(state)^.feventsection);
+      result := wrAbandoned;
+      exit;
+    end;
+  inc(plocaleventstate(state)^.FWaiters);
+  pthread_mutex_unlock(@plocaleventstate(state)^.feventsection);
+
+  if TimeOut=Cardinal($FFFFFFFF) then
     begin
+      { if no timeout, just wait until we are woken up }
       cSemaphoreWait(plocaleventstate(state)^.FSem);
-      result:=wrSignaled;
+      if not(plocaleventstate(state)^.FDestroying) then
+        result:=wrSignaled
+      else
+        result:=wrAbandoned;
+    end
+  else
+    begin
+      timespec.tv_sec:=0;
+      { 500 miliseconds or less -> wait once for this duration }
+      if (timeout <= 500) then
+        loopcnt:=1
+      { otherwise wake up every 500 msecs to check   }
+      { (we'll wait a little longer in total because }
+      {  we don't take into account the overhead)    }
+      else
+        begin
+          loopcnt := timeout div 500;
+          timespec.tv_nsec:=500*1000000;
+        end;
+      result := wrTimeOut;
+      nanores := 0;
+
+      for i := 1 to loopcnt do
+        begin
+          { in the last iteration, wait for the amount of time left }
+          if (i = loopcnt) then
+            timespec.tv_nsec:=(timeout mod 500) * 1000000;
+          timetemp:=timespec;
+          lastloop:=false;
+          { every time our sleep is interrupted for whatever reason, }
+          { also check whether the semaphore has been posted in the  }
+          { mean time                                                }
+          repeat
+          {$if not defined(has_sem_init) and not defined(has_sem_open)}
+            pthread_mutex_lock(@plocaleventstate(state)^.feventsection);
+            try
+          {$endif}
+              twres := cSemaphoreTryWait(plocaleventstate(state)^.FSem);
+          {$if not defined(has_sem_init) and not defined(has_sem_open)}
+            finally
+              pthread_mutex_unlock(@plocaleventstate(state)^.feventsection);
+            end;
+          {$endif}
+            case twres of
+              tw_error:
+                begin
+                  result := wrError;
+                  break;
+                end;
+              tw_semwasunlocked:
+                begin
+                  result := wrSignaled;
+                  break;
+                end;
+            end;
+            if (lastloop) then
+              break;
+            nanores:=fpnanosleep(@timetemp,@timeleft);
+            nanoerr:=fpgeterrno;
+            timetemp:=timeleft;
+            lastloop:=(i=loopcnt);
+          { loop until 1) we slept complete interval (except if last for-loop }
+          { in which case we try to lock once more); 2) an error occurred;    }
+          { 3) we're being destroyed                                          }
+          until ((nanores=0) and not lastloop) or ((nanores<>0) and (nanoerr<>ESysEINTR)) or plocaleventstate(state)^.FDestroying;
+          { adjust result being destroyed or error (in this order, since   }
+          { if we're being destroyed the "error" could be ESysEINTR, which }
+          { is not a real error                                            }
+          if plocaleventstate(state)^.FDestroying then
+            result := wrAbandoned
+          else if (nanores <> 0) then
+            result := wrError;
+          { break out of greater loop when we got the lock, when an error }
+          { occurred, or when we are being destroyed                      }
+          if (result<>wrTimeOut) then
+            break;
+        end;
+    end;
+  
+  if (result=wrSignaled) then
+    begin
       if plocaleventstate(state)^.FManualReset then
         begin
           pthread_mutex_lock(@plocaleventstate(state)^.feventsection);
@@ -736,9 +913,14 @@ begin
             cSemaphorePost(plocaleventstate(state)^.FSem);
           Finally
             pthread_mutex_unlock(@plocaleventstate(state)^.feventsection);
+          end;
         end;
-      end;
     end;
+  { don't put this above the previous if-block, because otherwise   }
+  { we can get errors in case an object is destroyed between the    }
+  { end of the wait/sleep loop and the signalling above.            }
+  { The pthread_mutex_unlock above takes care of the memory barrier }
+  interlockeddecrement(plocaleventstate(state)^.FWaiters);
 end;
 
 function intRTLEventCreate: PRTLEvent;

tests/test/tbrtlevt.pp

@@ -7,15 +7,71 @@ uses
   sysutils,
   classes;
 
+Const
+        wrSignaled = 0;
+        wrTimeout  = 1;
+        wrAbandoned= 2;
+        wrError    = 3;
+
 type
   tc = class(tthread)
     procedure execute; override;
   end;
 
+  torder = (o_destroy, o_post, o_sleeppost, o_waittimeoutabandon, o_waittimeoutsignal);
+  thelper = class(tthread)
+   private
+    forder: torder;
+   public
+    constructor create(order: torder);
+    procedure execute; override;
+  end;
+
 var
   event: pEventState;
   waiting: boolean;
 
+constructor thelper.create(order: torder);
+  begin
+    forder:=order;
+    inherited create(false);
+  end;
+
+procedure thelper.execute;
+var
+  res: longint;
+begin
+  case forder of
+    o_destroy:
+      basiceventdestroy(event);
+    o_post:
+      basiceventsetevent(event);
+    o_sleeppost:
+      begin
+        sleep(1000);
+        basiceventsetevent(event);
+      end;
+    o_waittimeoutabandon:
+      begin
+        res:=basiceventWaitFor(1000,event);
+        if (res<>wrAbandoned) then
+          begin
+            writeln('error 1');
+            halt(1);
+          end;
+      end;
+    o_waittimeoutsignal:
+      begin
+        res:=basiceventWaitFor(1000,event);
+        if (res<>wrSignaled) then
+          begin
+            writeln('error 2');
+            halt(2);
+          end;
+      end;
+  end;
+end;
+
 procedure tc.execute;
 begin
   { make sure we don't exit before this thread has initialised, since    }
@@ -23,32 +79,59 @@ begin
   { problems for heaptrc as it goes over the memory map in its exit code }
   waiting:=true;
   { avoid deadlocks/bugs from causing this test to never quit }
-  sleep(1000*20);
-  halt(1);
+  sleep(1000*10);
+  writeln('error 3');
+  halt(3);
 end;
 
-
+var
+  help: thelper;
 begin
   waiting:=false;
   tc.create(false);
-  event := BasicEventCreate(nil,false,false,'bla');;
+  event := BasicEventCreate(nil,false,false,'bla');
+  basiceventSetEvent(event);
+  if (basiceventWaitFor(cardinal(-1),event) <> wrSignaled) then
+    begin
+      writeln('error 4');
+      halt(4);
+    end;
   basiceventSetEvent(event);
-  if (basiceventWaitFor(cardinal(-1),event) <> 0) then
+  if (basiceventWaitFor(1000,event) <> wrSignaled) then
     begin
-      writeln('error');
-      halt(1);
+      writeln('error 5');
+      halt(5);
     end;
   { shouldn't change anything }
   basiceventResetEvent(event);
   basiceventSetEvent(event);
   { shouldn't change anything }
   basiceventSetEvent(event);
-  if (basiceventWaitFor(cardinal(-1),event) <> 0) then
+  if (basiceventWaitFor(cardinal(-1),event) <> wrSignaled) then
+    begin
+      writeln('error 6');
+      halt(6);
+    end;
+
+  { make sure the two BasicSetEvents aren't cumulative }
+  if (basiceventWaitFor(1000,event) <> wrTimeOut) then
     begin
-      writeln('error');
-      halt(1);
+      writeln('error 7');
+      halt(7);
     end;
+
+  help:=thelper.create(o_waittimeoutabandon);
+  basiceventdestroy(event);
+  help.waitfor;
+  help.free;
+
+  event := BasicEventCreate(nil,false,false,'bla');
+  help:=thelper.create(o_waittimeoutsignal);
+  basiceventSetEvent(event);
+  help.waitfor;
+  help.free;
   basiceventdestroy(event);
+
   while not waiting do
     sleep(20);
 end.

tests/test/tmt1.pp

@@ -1,7 +1,6 @@
 { %version=1.1 }
 
 {$mode objfpc}
-{$threading on}
 
 uses
   sysutils

tests/webtbs/tw7954.pp

@@ -0,0 +1,20 @@
+{$ifdef fpc}
+{$mode delphi}
+{$endif}
+
+uses
+{$ifdef unix}
+  cthreads,
+{$endif}
+  Classes, SysUtils;
+
+var
+  cs: trtlcriticalsection;
+begin
+  fillchar(cs,sizeof(cs),#255);
+  try
+    leavecriticalsection(cs);
+  except on Exception do
+    halt(0);
+  end;
+end.

tests/webtbs/tw9073.pp

@@ -0,0 +1,40 @@
+{$mode objfpc}
+
+uses
+{$ifdef unix}
+  cthreads,
+{$endif}
+  SysUtils, Classes;
+
+type
+  tc = class(tthread)
+    procedure execute; override;
+  end;
+
+var
+  caught: boolean;
+
+procedure tc.execute;
+type
+  plongint = ^longint;
+var
+  p: plongint;
+begin
+  p:=nil;
+  try
+    writeln(p^);
+  except
+    caught:=true;
+  end;
+end;
+
+var
+  c: tc;
+begin
+  caught:=false;
+  c:=tc.create(false);
+  c.waitfor;
+  c.free;
+  halt(ord(not caught));
+end.
+