How to wait that all anonymous thread are terminated before closing the app?

Question

I encounter an awkward problem. In my app I often do

TThread.createAnonymousThread(
  procedure
    ....
  end).start

The problem I have is that when I close the main form of my app, then sometime some of those AnonymousThread are still alive after the Tform.destroy finished . Is their a way in my Tform.destroy to wait that all those AnonymousThread (created a little everywhere in the whole app) are successfully terminated before to continue ?

I found this way to list all running thread (from How can I get a list with all the threads created by my application) :

program ListthreadsofProcess;

{$APPTYPE CONSOLE}

uses
  PsAPI,
  TlHelp32,
  Windows,
  SysUtils;

function GetTthreadsList(PID:Cardinal): Boolean;
var
  SnapProcHandle: THandle;
  NextProc      : Boolean;
  TThreadEntry  : TThreadEntry32;
begin
  SnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0); //Takes a snapshot of the all threads
  Result := (SnapProcHandle <> INVALID_HANDLE_VALUE);
  if Result then
  try
    TThreadEntry.dwSize := SizeOf(TThreadEntry);
    NextProc := Thread32First(SnapProcHandle, TThreadEntry);//get the first Thread
    while NextProc do
    begin
      if TThreadEntry.th32OwnerProcessID = PID then //Check the owner Pid against the PID requested
      begin
        Writeln('Thread ID      '+inttohex(TThreadEntry.th32ThreadID,8));
        Writeln('base priority  '+inttostr(TThreadEntry.tpBasePri));
        Writeln('');
      end;

      NextProc := Thread32Next(SnapProcHandle, TThreadEntry);//get the Next Thread
    end;
  finally
    CloseHandle(SnapProcHandle);//Close the Handle
  end;
end;

begin
  { TODO -oUser -cConsole Main : Insert code here }
  GettthreadsList(GetCurrentProcessId); //get the PID of the current application
  //GettthreadsList(5928);
  Readln;
end.

but it's look like that in this list their is some threads that are not really made by my code and that those threads never close. For example for a blank project this is the list of threads :

Answer 1

Core problem you are facing does not come from the anonymous threads as such, but from self-destroying anonymous threads - the ones that have FreeOnTerminate set.

In order to wait on a thread, you need to have reference to a thread or its handle (Windows platform). Because you are dealing with self-destroying threads, taking reference to a thread is not an option, because as soon as you start the thread you are no longer allowed to touch that reference.

Delphi RTL does not perform any cleanup for the self destroying anonymous threads during application shutdown, so those threads will be just killed by the OS after your application main form is destroyed, hence your problem.

One of the solutions that will allow you to wait for anonymous threads, that does not require any complicated housekeeping and maintaining any kind of lists, and that also requires minimal changes to the code that can be done with simple find and replace, is using TCountdownEvent to count threads.

This requires replacing TThread.CreateAnonymousThread with constructing custom thread class TAnoThread.Create (you can add static factory method if you like, instead of directly calling constructor) that will have same behavior as anonymous thread, except its instances will be counted and you will be able to wait on all such threads to finish running.

type
  TAnoThread = class(TThread)
  protected
    class var
      fCountdown: TCountdownEvent;
    class constructor ClassCreate;
    class destructor ClassDestroy;
  public
    class procedure Shutdown; static;
    class function WaitForAll(Timeout: Cardinal = INFINITE): TWaitResult; static;
  protected
    fProc: TProc;
    procedure Execute; override;
  public
    constructor Create(const aProc: TProc);
  end;

class constructor TAnoThread.ClassCreate;
begin
  fCountdown := TCountdownEvent.Create(1);
end;

class destructor TAnoThread.ClassDestroy;
begin
  fCountdown.Free;
end;

class procedure TAnoThread.Shutdown;
begin
  fCountdown.Signal;
end;

class function TAnoThread.WaitForAll(Timeout: Cardinal): TWaitResult;
begin
  Result := fCountdown.WaitFor(Timeout);
end;

constructor TAnoThread.Create(const aProc: TProc);
begin
  inherited Create(True);
  fProc := aProc;
  FreeOnTerminate := True;
end;

procedure TAnoThread.Execute;
begin
  if fCountdown.TryAddCount then
    try
      fProc;
    finally
      fCountdown.Signal;
    end;
end;

And then you can add following code in your form destructor or any other appropriate place and wait for all anonymous threads to finish running.

destructor TForm1.Destroy;
begin
  TAnoThread.Shutdown;
  while TAnoThread.WaitForAll(100) <> wrSignaled do
    CheckSynchronize;
  inherited;
end;

Principle is following: countdown event is created with value 1, and when that value reaches 0, event will be signaled. To initiate shutdown, you call Shutdown method which will decrease initial count. You cannot call this method more than once because it would mess up the count.

When anonymous thread Execute method starts, it will first attempt to increase the count. If it cannot do that, it means countdown event is already signaled and thread will just terminate without calling its anonymous method, otherwise anonymous method will run and after it finishes count will be decreased.

If anonymous threads use TThread.Synchronize calls, you cannot just call WaitForAll because calling it from the main thread will deadlock. In order to prevent deadlock while you are waiting for the threads to finish, you need to call CheckSynchronize to process pending synchronization requests.

This solution counts all threads of the TAnoThread class regardless of whether they are self-destroying or not. This can be easily changed to count only those that have FreeOnTerminate set.

Also, when you call Shutdown, and you still have some running threads, new threads will still be able to start at that point because countdown even is not signaled. If you want to prevent new threads from that point on, you will need to add a Boolean flag that will indicate you have initiated shutdown process.

Answer 2

Reading all threads from the process and then trying to figure out which ones to wait for sounds like the path to a lot of pain.

If you really don't want to store the references of the anonymous threads (which then by the way should not be FreeOnTerminate as that would cause dangling references if the thread ends before you wait for it) then build a wrapper around TThread.CreateAnonymousThread or TTask.Run which does the storage internally and encapsulates the WaitFor. You could even be fancy and add an additional group key so you can create and wait for different set of threads/tasks instead of all.

Answer 3

Push in a thread-safe list the TThread references returned by CreateAnonymousThread, make sure to keep it in sync when a thread terminates and implement your own WaitForAll.

Or, consider to use TTask class for a simple parallel threads management. It have already implemented WaitForAll method.

Sample code took from Delphi help:

procedure TForm1.MyButtonClick(Sender: TObject);
var 
  tasks: array of ITask; 
  value: Integer; 
begin 
  Setlength (tasks ,2); 
  value := 0; 

 tasks[0] := TTask.Create (procedure () 
  begin 
   sleep(3000);
   TInterlocked.Add (value, 3000); 
  end); 
 tasks[0].Start; 

 tasks[1] := TTask.Create (procedure () 
   begin 
   sleep (5000);
   TInterlocked.Add (value, 5000);
 end); 
 tasks[1].Start; 

 TTask.WaitForAll(tasks); 
 ShowMessage ('All done: ' + value.ToString); 
end;