* 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)

git-svn-id: trunk@8248 -

.gitattributes

@@ -8259,6 +8259,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

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/unix/cthreads.pp

@@ -60,6 +60,12 @@ Uses
 {$endif}
   ;
 
+{*****************************************************************************
+                             System unit import
+*****************************************************************************}
+
+procedure fpc_threaderror; [external name 'FPC_THREADERROR'];
+
 {*****************************************************************************
                              Generic overloaded
 *****************************************************************************}
@@ -363,19 +369,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);
@@ -386,7 +392,7 @@ Type  PINTRTLEvent = ^TINTRTLEvent;
            ;
 
          if pthread_mutex_destroy(@CS) <> 0 then
-           runerror(6);
+           fpc_threaderror;
       end;
 
 
@@ -543,7 +549,7 @@ begin
   if plocaleventstate(result)^.FSem=nil then
     begin
       FreeMem(result);
-      runerror(6);
+      fpc_threaderror;
     end;
 {$else}
 {$ifdef has_sem_open}
@@ -551,14 +557,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);
@@ -581,7 +587,7 @@ begin
     begin
       cSemaphoreDestroy(plocaleventstate(result)^.FSem);
       FreeMem(result);
-      runerror(6);
+      fpc_threaderror;
     end;
 end;
 
@@ -656,7 +662,7 @@ 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;

tests/webtbs/tw7954.pp

@@ -0,0 +1,21 @@
+{$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;
+  halt(1);
+end.