How do I reliably wait on a thread that has just been created?

Question

Consider the following program:

program TThreadBug;
{$APPTYPE CONSOLE}

uses
  SysUtils, Classes, Windows;

type
  TMyThread = class(TThread)
  protected
    procedure Execute; override;
  end;

procedure TMyThread.Execute;
var
  i: Integer;
begin
  for i := 1 to 5 do begin
    Writeln(i);
    Sleep(100);
  end;
end;

procedure UseTThread;
var
  Thread: TMyThread;
begin
  Writeln('TThread');
  Thread := TMyThread.Create;
  Thread.Terminate;
  Thread.WaitFor;
  Thread.Free;
  Writeln('Finished');
  Writeln;
end;

procedure UseTThreadWithSleep;
var
  Thread: TMyThread;
begin
  Writeln('TThreadWithSleep');
  Thread := TMyThread.Create;
  Sleep(100);
  Thread.Terminate;
  Thread.WaitFor;
  Thread.Free;
  Writeln('Finished');
  Writeln;
end;

begin
  UseTThread;
  UseTThreadWithSleep;
  Readln;
end.

The output is:

TThread
Finished

TThreadWithSleep
1
2
3
4
5
Finished

So it seems that, for some reason, the main thread has to wait some arbitrary amount of time before terminating and waiting for the worker thread. Am I right in thinking that this is a bug in TThread? Is there any way I can work around this? I expect that if I get my thread to signal that it has started (using an event), then that would work around the issue. But that makes me feel dirty.

Answer 1

You can call it a bug or a TThread design flaw, the problem was discussed many times. See for example http://sergworks.wordpress.com/2011/06/25/sleep-sort-and-tthread-corner-case/

The problem is that if TThread.Terminated flag is set too early TThread.Execute method is never called. So in your case just don't call TThread.Terminate before TThread.WaitFor.

Answer 2

I think the reason why this happens, has been sufficiently answered by Serg's answer, but I think you should not normally call Thread.Terminate anyway. The only reason to call it, if you want the thread to terminate, for instance when the application is closing. If you just want to wait until it is finished, you can call WaitFor (or WaitForSingleObject). This is possible, because the handle for the thread is already created in its constructor, so you can call it right away.

Also, I set FreeOnTerminate to true on these threads. Just let them run and free themselves. If I want a notification of them to be done, I can use either WaitFor or the OnTerminate event.

Here's just an example of a bunch of worker threads emptying a queue in a blocking way.

I would think you shouldn't need this, David, but maybe someone else may be happy with an example. On the other hand, you probably didn't ask this question just to have a change to rant about TThread's poor implementation, right? ;-)

First the Queue class. It's not really a traditional queue, I think. In a real multi-threaded queue, you should be able to add to the queue at any point, even when the processing is active. This queue requires you to fill its items upfront, then call the -blocking- run method. Also, the processed items are saved back to the queue.

type
  TQueue = class
  strict private
    FNextItem: Integer;
    FRunningThreads: Integer;
    FLock: TCriticalSection;
    FItems: TStrings; // Property...
  private

    // Signal from the thread that it is started or stopped.
    // Used just for indication, no real functionality depends on this.
    procedure ThreadStarted;
    procedure ThreadEnded;

    // Pull the next item from the queue.
    function Pull(out Item: Integer; out Value: string): Boolean;

    // Save the modified value back in the queue.
    procedure Save(Item: Integer; Value: string);

  public
    property Items: TStrings read FItems;
    constructor Create;
    destructor Destroy; override;

    // Process the queue. Blocking: Doesn't return until every item in the
    // queue is processed.
    procedure Run(ThreadCount: Integer);

    // Statistics for polling.
    property Item: Integer read FNextItem;
    property RunningThreads: Integer read FRunningThreads;
  end;

Then the Consumer thread. That one is plain and easy. It just has a reference to the queue, and an execute method that runs until the queue is empty.

  TConsumer = class(TThread)
  strict private
    FQueue: TQueue;
  protected
    procedure Execute; override;
  public
    constructor Create(AQueue: TQueue);
  end;

Here you see the implementation of this obscure 'Queue'. It's main methods are Pull and Save, which are used by the Consumer to pull the next item, and save the processed value back.

Another important method is Run, which starts a given number of worker threads and waits until all of them are finished. So this is actually a blocking method, which only returns after the queue is emptied. I'm using WaitForMultipleObjects here, which allows you to wait for upto 64 threads before you need to add extra tricks. It's the same as using WaitForSingleObject in the code in your question.

See how Thread.Terminate is never called?

{ TQueue }

constructor TQueue.Create;
// Context: Main thread
begin
  FItems := TStringList.Create;
  FLock := TCriticalSection.Create;
end;

destructor TQueue.Destroy;
// Context: Main thread
begin
  FLock.Free;
  FItems.Free;
  inherited;
end;

function TQueue.Pull(out Item: Integer; out Value: string): Boolean;
// Context: Consumer thread
begin
  FLock.Acquire;
  try
    Result := FNextItem < FItems.Count;
    if Result then
    begin
      Item := FNextItem;
      Inc(FNextItem);
      Value := FItems[Item];
    end;
  finally
    FLock.Release;
  end;
end;

procedure TQueue.Save(Item: Integer; Value: string);
// Context: Consumer thread
begin
  FLock.Acquire;
  try
    FItems[Item] := Value;
  finally
    FLock.Release;
  end;
end;

procedure TQueue.Run(ThreadCount: Integer);
// Context: Calling thread (TQueueBackgroundThread, or can be main thread)
var
  i: Integer;
  Threads: TWOHandleArray;
begin
  if ThreadCount <= 0 then
    raise Exception.Create('You no make sense no');
  if ThreadCount > MAXIMUM_WAIT_OBJECTS then
    raise Exception.CreateFmt('Max number of threads: %d', [MAXIMUM_WAIT_OBJECTS]);

  for i := 0 to ThreadCount - 1 do
    Threads[i] := TConsumer.Create(Self).Handle;

  WaitForMultipleObjects(ThreadCount, @Threads, True, INFINITE);
end;

procedure TQueue.ThreadEnded;
begin
  InterlockedDecrement(FRunningThreads);
end;

procedure TQueue.ThreadStarted;
begin
  InterlockedIncrement(FRunningThreads);
end;

The code for the consumer thread is plain and easy. It signals its start and end, but that's just cosmetic, because I want to be able to show the number of running threads, which is at it's max as soon as all threads are created, and only starts declining after the first thread exits (that is, when the last batch of items from the queue are being processed).

{ TConsumer }

constructor TConsumer.Create(AQueue: TQueue);
// Context: calling thread.
begin
  inherited Create(False);
  FQueue := AQueue;
  // A consumer thread frees itself when the queue is emptied.
  FreeOnTerminate := True;
end;

procedure TConsumer.Execute;
// Context: This consumer thread
var
  Item: Integer;
  Value: String;
begin
  inherited;

  // Signal the queue (optional).
  FQueue.ThreadStarted;

  // Work until queue is empty (Pull returns false).
  while FQueue.Pull(Item, Value) do
  begin
    // Processing can take from .5 upto 1 second.
    Value := ReverseString(Value);
    Sleep(Random(500) + 1000);

    // Just save modified value back in queue.
    FQueue.Save(Item, Value);
  end;

  // Signal the queue (optional).
  FQueue.ThreadEnded;
end;

Of course, if you want to view the progress (or at least a little), you don't want a blocking Run method. Or, like I did, you can execute that blocking method in a separate thread:

  TQueueBackgroundThread = class(TThread)
  strict private
    FQueue: TQueue;
    FThreadCount: Integer;
  protected
    procedure Execute; override;
  public
    constructor Create(AQueue: TQueue; AThreadCount: Integer);
  end;

    { TQueueBackgroundThread }

constructor TQueueBackgroundThread.Create(AQueue: TQueue; AThreadCount: Integer);
begin
  inherited Create(False);
  FreeOnTerminate := True;
  FQueue := AQueue;
  FThreadCount := AThreadCount;
end;

procedure TQueueBackgroundThread.Execute;
// Context: This thread (TQueueBackgroundThread)
begin
  FQueue.Run(FThreadCount);
end;

Now, calling this from the GUI itself. I've created a form, that holds two progress bars, two memo's, a timer and a button. Memo1 is filled with random strings. Memo2 will receive the processed strings after processing is fully done. The timer is used to update the progress bars, and the button is the only thing that actually does something.

So, the form just contains all these fields, and a reference to the queue. It also contains an event handler to be notified when processing is complete:

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Memo2: TMemo;
    Timer1: TTimer;
    ProgressBar1: TProgressBar;
    ProgressBar2: TProgressBar;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    Q: TQueue;
    procedure DoAllThreadsDone(Sender: TObject);
  end;

Button1 click event, initializes the GUI, creates the queue with 100 items, and starts a background thread to process the queue. This background thread receives an OnTerminate event handler (default property for TThread) to signal the GUI when processing is done.

You can just call Q.Run in the main thread, but then it will block your GUI. If that is what you want, then you don't need this thread at all!

procedure TForm1.Button1Click(Sender: TObject);
// Context: GUI thread
const
  ThreadCount = 10;
  StringCount = 100;
var
  i: Integer;
begin
  ProgressBar1.Max := ThreadCount;
  ProgressBar2.Max := StringCount;

  Memo1.Text := '';
  Memo2.Text := '';

  for i := 1 to StringCount do
    Memo1.Lines.Add(IntToHex(Random(MaxInt), 10));

  Q := TQueue.Create;
  Q.Items.Assign(Memo1.Lines);
  with TQueueBackgroundThread.Create(Q, ThreadCount) do
  begin
    OnTerminate := DoAllThreadsDone;
  end;
end;

The event handler for when the processing thread is done. If you want the processing to block the GUI, then you don't need this event handler and you can just copy this code to the end of Button1Click.

procedure TForm1.DoAllThreadsDone(Sender: TObject);
// Context: GUI thread
begin
  Memo2.Lines.Assign(Q.Items);
  FreeAndNil(Q);
  ProgressBar1.Position := 0;
  ProgressBar2.Position := 0;
end;

Timer is just for updating the progress bars. It fetches the number of running threads (which will only decline when processing is almost done), and it fetched the 'Item', which is actually the next item to process. So it may look finished already when actually the last 10 items are still being processed.

procedure TForm1.Timer1Timer(Sender: TObject);
// Context: GUI thread
begin
  if Assigned(Q) then
  begin
    ProgressBar1.Position := Q.RunningThreads;
    ProgressBar2.Position := Q.Item;
    Caption := Format('%d, %d', [Q.RunningThreads, Q.Item]);
  end;
  Timer1.Interval := 20;
end;