Waiting for multiples threads using WaitForMultipleObjects

Question

I'm using the WaitForMultipleObjects function to wait for the finalization of several threads, but I'm doing something wrong because the result is not the expected

see this sample code

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
  end;

  TFoo = class(TThread)
  private
    Factor: Double;
    procedure ShowData;
  protected
    procedure Execute; override;
    constructor Create(AFactor : Double);
  end;


var
  Form1: TForm1;

implementation

Uses
 Math;

{$R *.dfm}

{ TFoo }

constructor TFoo.Create(AFactor: Double);
begin
  inherited Create(False);
  Factor := AFactor;
  FreeOnTerminate := True;

end;

procedure TFoo.Execute;
const
  Max=100000000;
var
  i : Integer;
begin
  inherited;
  for i:=1 to Max do
    Factor:=Sqrt(Factor);

  Synchronize(ShowData);
end;

procedure TFoo.ShowData;
begin
  Form1.Memo1.Lines.Add(FloatToStr(Factor));
end;

procedure TForm1.Button1Click(Sender: TObject);
const
 nThreads=5;
Var
 tArr  : Array[1..nThreads]  of TFoo;
 hArr  : Array[1..nThreads]  of THandle;
 i     : Integer;
 rWait : Cardinal;
begin
  for i:=1  to nThreads do
   begin
     tArr[i]:=TFoo.Create(Pi*i);
     hArr[i]:=tArr[i].Handle;
   end;

  repeat
    rWait:= WaitForMultipleObjects(nThreads, @hArr, True, 100);
    Application.ProcessMessages;
  until rWait<>WAIT_TIMEOUT;
  //here I want to show this message when all the threads are terminated    
  Memo1.Lines.Add('Wait done');
end;

end.

this is the current output of the demo app

1
Wait done
1
1
1
1

but I want something like this

1
1
1
1
1
Wait done

How I must use the WaitForMultipleObjects function to wait until all the thread are terminated?

Answer 1

Fix: Remove the FreeOnTerminate.

Your code causes the threads to be freed, when you still need the handles. That's a big bug, and you can get access violations somewhere else in your code, or error return codes coming back from your WaitFormMultipleObjects.

TThread.handle becomes invalid when the TThread is freed, and this terminates your wait loop early because the handle is no longer valid. You could also experience an access access violation, if you tried to access the TThread after it was freed in the background, so I believe it's better to free them intentionally, and at a known time.

Using the thread handle as an event handle works fine, but you should not use FreeOnTerminate to free the thread when it terminates it as this destroys the handles too soon.

I also agree with the people who said that doing a busy-waiting loop with Application.Processmessages is pretty ugly. There are other ways to do that.

unit threadUnit2;

interface

uses Classes, SyncObjs,Windows, SysUtils;

type
  TFoo = class(TThread)
  private
    FFactor: Double;
    procedure ShowData;
  protected
    procedure Execute; override;
    constructor Create(AFactor : Double);
    destructor Destroy; override;
  end;

  procedure WaitForThreads;


implementation

Uses
 Forms,
 Math;

procedure Trace(msg:String);
begin
  if Assigned(Form1) then
    Form1.Memo1.Lines.Add(msg);
end;



{ TFoo }

constructor TFoo.Create(AFactor: Double);
begin
  inherited Create(False);
  FFactor := AFactor;
//  FreeOnTerminate := True;

end;

destructor TFoo.Destroy;
begin
  inherited;
end;

procedure TFoo.Execute;
const
  Max=100000000;
var
  i : Integer;
begin
  inherited;
  for i:=1 to Max do
    FFactor:=Sqrt(FFactor);


  Synchronize(ShowData);
end;


procedure TFoo.ShowData;
begin

  Trace(FloatToStr(FFactor));
end;

procedure WaitForThreads;
const
 nThreads=5;
Var
 tArr  : Array[1..nThreads]  of TFoo;
 hArr  : Array[1..nThreads]  of THandle;
 i     : Integer;
 rWait : Cardinal;
begin
  for i:=1  to nThreads do
   begin
     tArr[i]:=TFoo.Create(Pi*i);
     hArr[i]:=tArr[i].handle; // Event.Handle;
   end;

  repeat
    rWait:= WaitForMultipleObjects(nThreads, @hArr[1],{waitAll} True, 150);
    Application.ProcessMessages;
  until rWait<>WAIT_TIMEOUT;
  Sleep(0);
  //here I want to show this message when all the threads are terminated
  Trace('Wait done');

  for i:=1  to nThreads do
   begin
     tArr[i].Free;
   end;

end;

end.

Answer 2

Here's what is happening.

1. Your code is returning WAIT_FAILED from WaitForMultipleObjects.
2. Calling GetLastError results in error code 6, The handle is invalid.
3. The only handles you are passing to WaitForMultipleObjects are the thread handles, ergo one of the thread handles is invalid.
4. The only way one of the thread handles could become invalid is if it has been closed.
5. As others have indicated, you are closing the handles by setting FreeOnTerminate.

The moral of the story is to check your return values correctly from all functions, and let GetLastError lead you to the root cause of the problem.

Answer 3

There is one condition that satisfies your 'until' condition in the repeat loop that you are ignoring, WAIT_FAILED:

until rWait<>WAIT_TIMEOUT; 
Memo1.Lines.Add('Wait done');

Since your timeout is somewhat tight, one (or more) of the threads finishes and frees itself rendering one (or more) handle invalid for the next WaitForMultipleObjects, which causes it to return 'WAIT_FAILED' resulting in a 'Wait done' message displayed.

For each iteration in the repeat loop, you should remove the handles of finished threads from your hArr. Then again do not forget to test for 'WAIT_FAILED' in any case.

edit:
Below is some sample code showing how this can be done. The difference of this approach instead of keeping threads alive is that, it doesn't leave unused kernel and RTL objects around. This wouldn't matter for the sample at hand, but for a lot of threads doing lengthy business it might be preferred.

In the code, WaitForMultipleObjects is called with passing 'false' for 'bWaitAll' parameter to be able to remove a thread handle without using an additional API call to find out if it is invalid or not. But it allows otherwise since the code also has to be able to handle threads finishing outside the wait call.

procedure TForm1.Button1Click(Sender: TObject);

const
  nThreads=5;

Var
  tArr  : Array[1..nThreads]  of TFoo;
  hArr  : Array[1..nThreads]  of THandle;
  i     : Integer;
  rWait : Cardinal;

  hCount: Integer;  // total number of supposedly running threads
  Flags: DWORD;     // dummy variable used in a call to find out if a thread handle is valid

  procedure RemoveHandle(Index: Integer); // Decrement valid handle count and leave invalid handle out of range
  begin
    if Index <> hCount then
      hArr[Index] := hArr[hCount];
    Dec(hCount);
  end;

begin
  Memo1.Clear;

  for i:=1  to nThreads do
   begin
     tArr[i]:=TFoo.Create(Pi*i);
     hArr[i]:=tArr[i].Handle;
   end;
   hCount := nThreads;

  repeat
    rWait:= WaitForMultipleObjects(hCount, @hArr, False, 100);

    case rWait of

      // one of the threads satisfied the wait, remove its handle
      WAIT_OBJECT_0..WAIT_OBJECT_0 + nThreads - 1: RemoveHandle(rWait + 1);

      // at least one handle has become invalid outside the wait call, 
      // or more than one thread finished during the previous wait,
      // find and remove them
      WAIT_FAILED:
        begin
          if GetLastError = ERROR_INVALID_HANDLE then
          begin
            for i := hCount downto 1 do 
              if not GetHandleInformation(hArr[i], Flags) then // is handle valid?
                RemoveHandle(i);
          end
          else
            // the wait failed because of something other than an invalid handle
            RaiseLastOSError;
        end;

      // all remaining threads continue running, process messages and loop.
      // don't process messages if the wait returned WAIT_FAILED since we didn't wait at all
      // likewise WAIT_OBJECT_... may return soon
      WAIT_TIMEOUT: Application.ProcessMessages; 
    end;

  until hCount = 0;  // no more valid thread handles, we're done

  Memo1.Lines.Add('Wait done');
end;

Note that this is to answer the question as it is asked. I'd rather use the TThreads' OnTerminate event to decrement a counter and output the 'Wait done' message when it reaches '0'. This, or as others have recommended, moving the wait to a thread of its own, would be easier and probably cleaner, and would avoid the need for Application.ProcessMessages.

Answer 4

If you really want to learn how multithreading works, you're on a correct path - learn through code and ask questions as you did here. If, however, you just want to use multithreading in your application, you can do it in much simpler way with OmniThreadLibrary provided you use at least Delphi 2009.

uses
  Math,
  OtlTask,
  OtlParallel;

function Calculate(factor: real): real;
const
  Max = 100000000;
var
  i: integer;
begin
  Result := factor;
  for i := 1 to Max do
    Result := Sqrt(Result);
end;

procedure TForm35.btnClick(Sender: TObject);
const
  nThreads = 5;
begin
  Parallel.ForEach(1, nThreads).Execute(
    procedure (const task: IOmniTask; const value: integer)
    var
      res: real;
    begin
      res := Calculate(Pi*value);
      task.Invoke(
        procedure begin
          Form35.Memo1.Lines.Add(FloatToStr(res));
        end
      );
    end
  );
  Memo1.Lines.Add('All done');
end;

Answer 5

Don't pass such a short timeout period as the last parameter.

According to MSDN

dwMilliseconds [in] The time-out interval, in milliseconds. The function returns if the interval elapses, even if the conditions specified by the bWaitAll parameter are not met. If dwMilliseconds is zero, the function tests the states of the specified objects and returns immediately. If dwMilliseconds is INFINITE, the function's time-out interval never elapses.

Pay special attention to the second sentence. You're telling it to wait for all the handles, but to time out after 100 ms. So pass INFINITE as the last parameter instead, and use WAIT_OBJECT_0 instead of WAIT_TIMEOUT as the exit test.

Answer 6

Whenever you wait and it is involving message, you must use MsgWait... and specify the mask to deal with expected message

repeat
    rWait:= MsgWaitForMultipleObjects(nThreads, @hArr[1], True, INFINITE, QS_ALLEVENTS);
    Application.ProcessMessages;
 until (rWait<>WAIT_TIMEOUT) and (rWait <> (WAIT_OBJECT_0 + nThreads));

nThreads

Answer 7

I couldn't pass on this opportunity to create a working example of starting a couple of threads and using messaging to report the results back to the GUI.

The threads that will be started are declared as:

type
  TWorker = class(TThread)
  private
    FFactor: Double;
    FResult: Double;
    FReportTo: THandle;
  protected
    procedure Execute; override;
  public
    constructor Create(const aFactor: Double; const aReportTo: THandle);

    property Factor: Double read FFactor;
    property Result: Double read FResult;
  end;

The constructor just sets the private members and sets FreeOnTerminate to False. This is essential as it will allow the main thread to query the instance for the result. The execute method does its calculation and then posts a message to the handle it received in its constructor to say its done.

procedure TWorker.Execute;
const
  Max = 100000000;
var
  i : Integer;
begin
  inherited;

  FResult := FFactor;
  for i := 1 to Max do
    FResult := Sqrt(FResult);

  PostMessage(FReportTo, UM_WORKERDONE, Self.Handle, 0);
end;

The declarations for the custom UM_WORKERDONE message are declared as:

const
  UM_WORKERDONE = WM_USER + 1;

type
  TUMWorkerDone = packed record
    Msg: Cardinal;
    ThreadHandle: Integer;
    unused: Integer;
    Result: LRESULT;
  end;

The form starting the threads has this added to its declaration:

  private
    FRunning: Boolean;
    FThreads: array of record
      Instance: TThread;
      Handle: THandle;
    end;
    procedure StartThreads(const aNumber: Integer);
    procedure HandleThreadResult(var Message: TUMWorkerDone); message UM_WORKERDONE;

The FRunning is used to prevent the button from being clicked while the work is going on. FThreads is used to hold the instance pointer and the handle of the created threads.

The procedure to start the threads has a pretty straightforward implementation:

procedure TForm1.StartThreads(const aNumber: Integer);
var
  i: Integer;
begin
  Memo1.Lines.Add(Format('Starting %d worker threads', [aNumber]));
  SetLength(FThreads, aNumber);
  for i := 0 to aNumber - 1 do
  begin
    FThreads[i].Instance := TWorker.Create(pi * (i+1), Self.Handle);
    FThreads[i].Handle := FThreads[i].Instance.Handle;
  end;
end;

The fun is in the HandleThreadResult implementation:

procedure TForm1.HandleThreadResult(var Message: TUMWorkerDone);
var
  i: Integer;
  ThreadIdx: Integer;
  Thread: TWorker;
  Done: Boolean;
begin
  // Find thread in array
  ThreadIdx := -1;
  for i := Low(FThreads) to High(FThreads) do
    if FThreads[i].Handle = Cardinal(Message.ThreadHandle) then
    begin
      ThreadIdx := i;
      Break;
    end;

  // Report results and free the thread, nilling its pointer so we can detect
  // when all threads are done.
  if ThreadIdx > -1 then
  begin
    Thread := TWorker(FThreads[i].Instance);
    Memo1.Lines.Add(Format('Thread %d returned %f', [ThreadIdx, Thread.Result]));
    FreeAndNil(FThreads[i].Instance);
  end;

  // See whether all threads have finished.
  Done := True;
  for i := Low(FThreads) to High(FThreads) do
    if Assigned(FThreads[i].Instance) then
    begin
      Done := False;
      Break;
    end;
  if Done then
    Memo1.Lines.Add('Work done');
end;

Enjoy...

Answer 8

I added the following lines to the end of the routine:

memo1.Lines.add(intToHex(rWait, 2));
if rWait = $FFFFFFFF then
  RaiseLastOSError;

Turns out that WaitForMultipleObjects is failing with an Access Denied error, most likely because some but not all of the threads are finishing and cleaning themselves up between iterations.

You've got a sticky issue here. You need to keep the message pump running, or the Synchronize calls won't work, so you can't pass INFINITE like Ken suggested. But if you do what you're currently doing, you run into this problem.

The solution is to move the WaitForMultipleObjects call and the code around it into a thread of its own as well. It should wait for INFINITE, then when it's finished it should signal the UI thread in some way to let it know it's done. (For example, when you click the button, disable the button, and then when the monitor thread finishes, it enables the button again.)

Answer 9

You could refactor your code to wait for just one object instead of many.

I'd like to introduce you to a little helper which usually helps me in cases like this. This time his name is IFooMonitor:

IFooMonitor = interface
  function WaitForAll(ATimeOut: Cardinal): Boolean;
  procedure ImDone;
end;

TFoo and IFooMonitor will be friends:

TFoo = class(TThread)
strict private
  FFactor: Double;
  FMonitor: IFooMonitor;
  procedure ShowData;
protected
  procedure Execute; override;
public
  constructor Create(const AMonitor: IFooMonitor; AFactor: Double);
end;

constructor TFoo.Create(const ACountDown: ICountDown; AFactor: Double);
begin
  FCountDown := ACountDown;
  FFactor := AFactor;
  FreeOnTerminate := True;
  inherited Create(False);// <- call inherited constructor at the end!
end;

When TFoo is done with his job it wiil tell about it to his new friend:

procedure TFoo.Execute;
const
  Max = 100000000;
var
  i: Integer;
begin
  for i := 1 to Max do
    FFactor := Sqrt(FFactor);

  Synchronize(ShowData);

  FMonitor.ImDone(); 
end;

Now we can refactor the event handler to look like this:

procedure TForm1.Button1Click(Sender: TObject);
const
  nThreads = 5;
var
 i: Integer;
 monitor: IFooMonitor;
begin
  monitor := TFooMonitor.Create(nThreads); // see below for the implementation.

  for i := 1 to nThreads do
    TFoo.Create(monitor, Pi*i);

  while not monitor.WaitForAll(100) do
    Application.ProcessMessages;

  Memo1.Lines.Add('Wait done');
end;

And this is how we can implement IFooMonitor:

uses
  SyncObjs;

TFooMonitor = class(TInterfacedObject, IFooMonitor)
strict private
  FCounter: Integer;
  FEvent: TEvent;
  FLock: TCriticalSection;
private
  { IFooMonitor }
  function WaitForAll(ATimeOut: Cardinal): Boolean;
  procedure ImDone;
public
  constructor Create(ACount: Integer);
  destructor Destroy; override;   
end;

constructor TFooMonitor.Create(ACount: Integer);
begin
  inherited Create;
  FCounter := ACount;
  FEvent := TEvent.Create(nil, False, False, '');
  FLock := TCriticalSection.Create;
end;

procedure TFooMonitor.ImDone;
begin
  FLock.Enter;
  try
    Assert(FCounter > 0);
    Dec(FCounter);
    if FCounter = 0 then
      FEvent.SetEvent;
  finally
    FLock.Leave
  end;
end;

destructor TFooMonitor.Destroy;
begin
  FLock.Free;
  FEvent.Free;
  inherited;
end;

function TFooMonitor.WaitForAll(ATimeOut: Cardinal): Boolean;
begin
  Result := FEvent.WaitFor(ATimeOut) = wrSignaled 
end;