Browse Source

* Try to avoid deadlocks with worker threads:
* Add three separate try/except blocks:
- Around thread create calls to handle fails in constructor
- Around ProcessThreadResult calls
- Around Terminate calls
Set ErrorState and ErrorMessage if an exception is raised
inside those try/except blocks.

git-svn-id: trunk@46684 -

pierre 5 years ago
parent
commit
4739762790
1 changed files with 59 additions and 22 deletions
  1. 59 22
      packages/fpmkunit/src/fpmkunit.pp

+ 59 - 22
packages/fpmkunit/src/fpmkunit.pp

@@ -8204,7 +8204,7 @@ procedure TBuildEngine.Compile(Packages: TPackages);
 Var
 Var
   I : integer;
   I : integer;
 {$ifndef NO_THREADING}
 {$ifndef NO_THREADING}
-  Thr : Integer;
+  Thr, ThreadCount : Integer;
   Finished : boolean;
   Finished : boolean;
   ErrorState: boolean;
   ErrorState: boolean;
   ErrorMessage: string;
   ErrorMessage: string;
@@ -8299,34 +8299,71 @@ begin
       ErrorState := False;
       ErrorState := False;
       Finished := False;
       Finished := False;
       I := 0;
       I := 0;
+      ThreadCount:=0;
       // This event is set by the worker-threads to notify the main/this thread
       // This event is set by the worker-threads to notify the main/this thread
       // that a package finished it's task.
       // that a package finished it's task.
       NotifyThreadWaiting := RTLEventCreate;
       NotifyThreadWaiting := RTLEventCreate;
       SetLength(Threads,Defaults.ThreadsAmount);
       SetLength(Threads,Defaults.ThreadsAmount);
-      // Create all worker-threads
-      for Thr:=0 to Defaults.ThreadsAmount-1 do
-        Threads[Thr] := TCompileWorkerThread.Create(self,NotifyThreadWaiting);
-      try
-        // When a thread notifies this thread that it is ready, loop on all
-        // threads to check their state and if possible assign a new package
-        // to them to compile.
-        while not Finished do
-          begin
-            RTLeventWaitFor(NotifyThreadWaiting);
-            for Thr:=0 to Defaults.ThreadsAmount-1 do if not Finished then
-              ProcessThreadResult(Threads[Thr]);
-          end;
-        // Compilation finished or aborted. Wait for all threads to end.
-        for thr:=0 to Defaults.ThreadsAmount-1 do
-          begin
-            Threads[Thr].Terminate;
-            RTLeventSetEvent(Threads[Thr].NotifyStartTask);
-            Threads[Thr].WaitFor;
-          end;
+      try 
+        // Create all worker-threads
+        try
+          for Thr:=0 to Defaults.ThreadsAmount-1 do
+            begin
+              Threads[Thr] := TCompileWorkerThread.Create(self,NotifyThreadWaiting);
+              if assigned(Threads[Thr]) then
+                inc(ThreadCount);
+            end;
+        except
+          on E: Exception do
+            begin
+              ErrorMessage := E.Message;
+              ErrorState:=true;
+            end;
+        end;
+        try
+          // When a thread notifies this thread that it is ready, loop on all
+          // threads to check their state and if possible assign a new package
+          // to them to compile.
+          while not Finished do
+            begin
+              RTLeventWaitFor(NotifyThreadWaiting);
+              for Thr:=0 to Defaults.ThreadsAmount-1 do
+                if assigned(Threads[Thr]) and not Finished then
+                  ProcessThreadResult(Threads[Thr]);
+            end;
+        except
+          on E: Exception do
+            begin
+              if not ErrorState then
+                ErrorMessage := E.Message;
+              ErrorState:=true;
+            end;
+        end;
+        try
+          // Compilation finished or aborted. Wait for all threads to end.
+          for thr:=0 to Defaults.ThreadsAmount-1 do
+            if assigned(Threads[Thr]) then
+              begin
+                Threads[Thr].Terminate;
+                RTLeventSetEvent(Threads[Thr].NotifyStartTask);
+                Threads[Thr].WaitFor;
+              end;
+        except
+          on E: Exception do
+            begin
+              if not ErrorState then
+                ErrorMessage := E.Message;
+              ErrorState:=true;
+            end;
+        end;
       finally
       finally
         RTLeventdestroy(NotifyThreadWaiting);
         RTLeventdestroy(NotifyThreadWaiting);
         for thr:=0 to Defaults.ThreadsAmount-1 do
         for thr:=0 to Defaults.ThreadsAmount-1 do
-          Threads[Thr].Free;
+          if assigned(Threads[Thr]) then
+            begin
+              Threads[Thr].Free;
+              dec(ThreadCount);
+            end;
       end;
       end;
     if ErrorState then
     if ErrorState then
       raise Exception.Create(ErrorMessage);
       raise Exception.Create(ErrorMessage);