Delphi: Kill threads when application quits?

Question

Background: I need to perform checks whether a bunch of network drives or remote computers are available. Since each DirectoryExists() needs a lot of time until a potential timeout, I perform the checks in separate threads. It can happen, that an end-user closes the application while some of the checks are still running. Since DirectoryExists() blocks, I have no chance of using the classical while not Terminated approach.

procedure TMyThread.Execute;
begin
  AExists := DirectoryExists(AFilepath);
end;

Question 1: Is it a problem that some threads are still running when the application quits? Will Windows simply tidy up after me and that's it? Inside the IDE I get notification of un-freed objects, but outside IDE it just appears to be peaceful.

Question 2: Is it possible to terminate such simple threads with TerminateThread or is this potentially harmful in THIS case?

Question 3: I usually take the results from the threads in OnTerminate() event and let the threads FreeOnTerminate afterwards. If I wanted to free them myself, when should I do it? Can I free a thread in its OnTerminate event or is this a tiny bit too early? How would a thread inform me that it is done if not with OnTerminate?

Answer 1

Is it a problem that some threads are still running when the application quits?

Possibly, yes. It depends on what your code does after DirectoryExists() exits. You might end up trying to access things that no longer exist.

Will Windows simply tidy up after me and that's it?

To ensure everything is cleaned up properly, you are responsible for terminating your own threads. When the main VCL thread is done running, it will call ExitProcess(), which will forcibly terminate any secondary threads that are still running, which will not allow them to clean up after themselves, or notify any loaded DLLs that they are being detached from the threads.

Is it possible to terminate such simple threads with TerminateThread or is this potentially harmful in THIS case?

TerminateThread() is ALWAYS potentially harmful. NEVER use it.

I usually take the results from the Threads in OnTerminate() event and let the threads FreeOnTerminate afterwards.

That will not work if the main message loop has exited before the thread terminates. By default, the TThread.OnTerminate event is fired via a call to TThread.Synchronize(). Once the main message loop stops running, there won't be anything to process the pending Synchronize() requests, unless you run your own loop at app exit to call the RTL's CheckSynchronize() procedure until all of your threads have fully terminated.

if I wanted to free them myself, when should I do it?

Before your app wants to exit.

Can I free a thread in its OnTerminate event

No.

or is this a tiny bit too early?

That, and because it is always unsafe to free an object inside an event fired by that same object. The RTL still needs access to the object after the event handler exits.

That being said, since you don't have a clean way to terminate the threads safely, I suggest NOT allowing your app to exit when there are threads still running. When the user requests the app to exit, check if there are threads running, and if so then display a busy UI to the user, wait for all of the threads to terminate, and then exit the app.

For example:

constructor TMyThread.Create(...);
begin
  inherited Create(False);
  FreeOnTerminate := True;
  ...
end;

procedure TMyThread.Execute;
begin
  ...
  if Terminated then Exit;
  AExists := DirectoryExists(AFilepath);
  if Terminated then Exit;
  ...
end;

type
  TMainForm = class(TForm)
    ...
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    ...
  private
    ThreadsRunning: Integer;
    procedure StartAThread;
    procedure ThreadTerminated(Sender: TObject);
    ...
  end;

...

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if ThreadsRunning = 0 then Exit;

  // signal threads to terminate themselves...

  if CheckWin32Version(6) then
    ShutdownBlockReasonCreate(Handle, 'Waiting for Threads to Terminate');

  try
    // display busy UI to user ...

    repeat    
      case MsgWaitForMultipleObjects(1, System.Classes.SyncEvent, False, INFINITE, QS_ALLINPUT) of
        WAIT_OBJECT_0   : CheckSynchronize;
        WAIT_OBJECT_0+1 : Application.ProcessMessages;
        WAIT_FAILED     : RaiseLastOSError;
      end;
    until ThreadsRunning = 0;

    // hide busy UI ...
  finally
    if CheckWin32Version(6) then
      ShutdownBlockReasonDestroy(Handle);
  end;
end;

procedure TMainForm.StartAThread;
var
  Thread: TMyThread;
begin
  Thread := TMyThread.Create(...);
  Thread.OnTerminate := ThreadTerminated;
  Thread.Start;
  Inc(ThreadsRunning);
end;

procedure TMainForm.ThreadTerminated(Sender: TObject);
begin
  Dec(ThreadsRunning);
  ...
end;

Alternatively:

type
  TMainForm = class(TForm)
    ...
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    ...
  private
    ThreadsRunning: Integer;
    WaitingForClose: Boolean;
    procedure StartAThread;
    procedure ThreadTerminated(Sender: TObject);
    ...
  end;

...

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := (ThreadsRunning = 0);
  if CanClose or WaitingForClose then Exit;

  // signal threads to terminate themselves...

  WaitingForClose := True;

  // display busy UI to user ...

  if CheckWin32Version(6) then
    ShutdownBlockReasonCreate(Handle, 'Waiting for Threads to Terminate');
end;

procedure TMainForm.StartAThread;
var
  Thread: TMyThread;
begin
  Thread := TMyThread.Create(...);
  Thread.OnTerminate := ThreadTerminated;
  Thread.Start;
  Inc(ThreadsRunning);
end;

procedure TMainForm.ThreadTerminated(Sender: TObject);
begin
  Dec(ThreadsRunning);

  ...

  if WaitingForClose and (ThreadsRunning = 0) then
  begin
    WaitingForClose := False;

    // hide busy UI ...

    if CheckWin32Version(6) then
      ShutdownBlockReasonDestroy(Handle);

    Close;
  end;
end;

Answer 2

Is it a problem that some threads are still running when the application quits?

When taken literally, this question is a little bit malformed. That is because after ExitProcess is called, which is how a Delphi application is ended by default, no threads are running.

The answer to the question "is it a problem that some threads didn't have a chance to finish" depends on what these threads failed to complete. You would have to carefully analyze thread code, but generally speaking this might be prone to errors.

Will Windows simply tidy up after me and that's it? Inside the IDE I get notification of un-freed objects, but outside IDE it just appears to be peaceful.

The OS will reclaim allocated memory when the process address space is destroyed, all object handles will be closed when the process handle table is destroyed, entry points of all loaded libraries will be called with DLL_PROCESS_DETACH. I can't find any documentation on this but I also presume pending IO requests would be called to cancel.

But all of this does not mean there won't be any problems. Things can get messy, for instance, involving interprocess communications or synchronization objects. Documentation for ExitProcess details one such example: if a thread vanishes before releasing a lock that one of the libraries tries to acquire while detaching, there's a deadlock. This blog post gives another specific example where the exiting process is forcibly terminated by the OS if a thread attempts to enter a critical section that is orphaned by another already terminated thread.

While it may make sense to let go of resource releasing at exit time, particularly if cleanup is taking a considerable amount of time, it is possible to get it wrong for a non-trivial application. A robust strategy is to clean up everything before ExitProcess is called. OTOH if you find yourself in a situation where ExitProcess is already called, such as the process is detaching from your dll because of termination, the nearly only safe thing to do is to leave everything behind and return - every other dll could have already been unloaded and every other thread terminated.

Is it possible to terminate such simple threads with TerminateThread or is this potentially harmful in THIS case?

TerminateThread is advised to be used only in most extreme cases but since the question has a bold "THIS" what the code really does should be examined. Looking at the RTL code we can see that the worst that can happen is leaving a file handle open which is accessed for reading only. THIS is not a problem at process termination time since the handle will be closed shortly.

I usually take the results from the threads in OnTerminate() event and let the threads FreeOnTerminate afterwards. If I wanted to free them myself, when should I do it?

The only strict rule is after they are finished executing. The choice would probably be guided by the design of the application. What would be different is, you wouldn't be able to use FreeOnTerminate and you would keep references to your threads to be able to free them. In the test case I worked on for answering this question, the worker threads which are finished are freed when a timer fires, kind of like a garbage collector.

Can I free a thread in its OnTerminate event or is this a tiny bit too early?

Freeing an object in one of its own event handlers induces a risk of operating on freed instance memory. The documentation specifically warns against this for components but in general this is applicable to all classes.

Even if you'd want to disregard the warning, this is a deadlock. Although the handler is called after Execute returns, OnTerminate is still synchronized from the ThreadProc. If you attempt to free the thread in the handler, it will cause a wait from the main thread for the thread to finish - which is waiting for the main thread to return from OnTerminate, which is a deadlock.

How would a thread inform me that it is done if not with OnTerminate?

OnTerminate is fine for informing that a thread has done its job, although you can use other means like using synchronization objects or queuing a procedure or posting a message etc.. Also worth noting that it's possible to wait on a thread handle, which is what TThread.WaitFor does.

---

In my test program I tried to determine application termination time depending on various exit strategies. All test results are dependent on my testing environment.

Termination time is measured starting from when the OnClose handler of a VCL form is called and ending with just before ExitProcess is called by the RTL. Also, this method does not account for how long ExitProcess takes, which I presume would be different when there are dangling threads. But I didn't try to measure it anyway.

Worker threads query the existence of a directory on a non-existing host. This is the most I could come up on waiting time. Every query is on a new non-existing host, otherwise DirectoryExists returns immediately.

A timer starts and collects worker threads. Depending on the time the IO query takes (which is around 550ms) the timer interval effects the total count of threads at any given time. I tested on around 10 threads with a timer interval of 250ms.

Various debug outputs allow to follow the flow in the event log of the IDE.

• My first test was to leave the worker threads behind - just quit the application. The time I measured was 30-65ms. Again, this could have caused ExitProcess itself to take longer.

• Next, I tested terminating the threads with TerminateThread. This took 140-160ms. I believe this is actually closer to what the previous test would come up if the time ExitProcess takes could be accounted for. But I have no proof on that.

• Next, I tested cancelling the IO request on running threads and then leaving them behind.This considerably decreased the amount of leaked memory, in fact completely eliminated in most of the runs. Although the cancellation request is asynchronous, nearly all of the threads return immediately and find the time to finish. Anyway, this took 160-190ms.

I should note here that the code in DirectoryExists is defective, at least in XE2. The first thing the function does is to call GetFileAttributes. An INVALID_FILE_ATTRIBUTES return denotes the function failed. This is how the RTL handles the fail:

function DirectoryExists(const Directory: string; FollowLink: Boolean = True): Boolean;
...
  ...
  Result := False;
  Code := GetFileAttributes(PChar(Directory));

  if Code <> INVALID_FILE_ATTRIBUTES then
  begin
    ...
  end
  else
  begin
    LastError := GetLastError;
    Result := (LastError <> ERROR_FILE_NOT_FOUND) and
      (LastError <> ERROR_PATH_NOT_FOUND) and
      (LastError <> ERROR_INVALID_NAME) and
      (LastError <> ERROR_BAD_NETPATH);
  end;
end;

This code assumes that unless GetLastError returns one of the above error codes the directory exists. This reasoning is flawed. Indeed, when you cancel the IO request, GetLastError returns ERROR_OPERATION_ABORTED (995) as documented but DirectoryExists returns true whether the directory exists or not.

• Waiting for the threads to finish without cancelling IO takes 330-530ms. This completely eliminates memory leaks.

• Cancelling IO requests and then waiting for the threads to finish takes 170-200ms. Of course no memory leaks here either. Considering there are no significant timing difference in any of the options, this would be the one I choose.

Testing code I used is below:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes,
  Vcl.Controls, Vcl.Forms, Vcl.ExtCtrls,
  generics.collections;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
  private
    FThreads: TList<TThread>;
  end;

var
  Form1: TForm1;

implementation

uses
  diagnostics;

{$R *.dfm}

type
  TIOThread = class(TThread)
  private
    FTarget: string;
  protected
    constructor Create(Directory: string);
    procedure Execute; override;
  public
    destructor Destroy; override;
  end;

constructor TIOThread.Create(Directory: string);
begin
  FTarget := Directory;
  inherited Create;
end;

destructor TIOThread.Destroy;
begin
  inherited;
  OutputDebugString(PChar(Format('Thread %d destroyed', [ThreadID])));
end;

procedure TIOThread.Execute;
var
  Watch: TStopwatch;
begin
  OutputDebugString(PChar(Format('Thread Id: %d executing', [ThreadID])));
  Watch := TStopwatch.StartNew;
  ReturnValue := Ord(DirectoryExists(FTarget));
  Watch.Stop;
  OutputDebugString(PChar(Format('Thread Id: %d elapsed time: %dms, return: %d',
      [ThreadID, Watch.Elapsed.Milliseconds, ReturnValue])));
end;

//-----------------------

procedure TForm1.FormCreate(Sender: TObject);
begin
  FThreads := TList<TThread>.Create;
  Timer1.Interval := 250;
  Timer1.Enabled := True;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FThreads.Free;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  ShareName: array [0..12] of Char;
  i: Integer;
  H: THandle;
begin
  for i := FThreads.Count - 1 downto 0 do
    if FThreads[i].Finished then begin
      FThreads[i].Free;
      FThreads.Delete(i);
    end;

  for i := Low(ShareName) to High(ShareName) do
    ShareName[i] := Chr(65 + Random(26));
  FThreads.Add(TIOThread.Create(Format('\\%s\share', [string(ShareName)])));
  OutputDebugString(PChar(Format('Possible thread count: %d', [FThreads.Count])));
end;

var
  ExitWatch: TStopwatch;

// not declared in XE2
function CancelSynchronousIo(hThread: THandle): Bool; stdcall; external kernel32;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  i: Integer;
  Handles: TArray<THandle>;
  IOPending: Bool;
  Ret: DWORD;
begin
  ExitWatch := TStopwatch.StartNew;
//  Exit;

  Timer1.Enabled := False;

{
  for i := 0 to FThreads.Count - 1 do
    TerminateThread(FThreads[i].Handle, 0);
  Exit;
//}

  if FThreads.Count > 0 then begin

    SetLength(Handles, FThreads.Count);
    for i := 0 to FThreads.Count - 1 do
      Handles[i] := FThreads[i].Handle;

//{
    OutputDebugString(PChar(Format('Cancelling at most %d threads', [Length(Handles)])));
    for i := 0 to Length(Handles) - 1 do
      if GetThreadIOPendingFlag(Handles[i], IOPending) and IOPending then
          CancelSynchronousIo(Handles[i]);
//}
//{
    Assert(FThreads.Count <= MAXIMUM_WAIT_OBJECTS);
    OutputDebugString(PChar(Format('Will wait on %d threads', [FThreads.Count])));

    Ret := WaitForMultipleObjects(Length(Handles), @Handles[0], True, INFINITE);
    case Ret of
      WAIT_OBJECT_0: OutputDebugString('wait success');
      WAIT_FAILED: OutputDebugString(PChar(SysErrorMessage(GetLastError)));
    end;
//}
    for i := 0 to FThreads.Count - 1 do
      FThreads[i].Free;
  end;
end;

procedure Exiting;
begin
  ExitWatch.Stop;
  OutputDebugString(PChar(
      Format('Total exit time:%d', [ExitWatch.Elapsed.Milliseconds])));
end;

initialization

  ReportMemoryLeaksOnShutdown := True;
  ExitProcessProc := Exiting;

end.