Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Does TThread work differently in a Delphi 2006 console application?

We have a pretty mature COM dll, which we test using DUnit. One of our recent tests creates a few threads, and tests the object from those threads. This test works fine when running the test using the gui front-end, but hangs when running as a console application. Here's a quick pseudo view of what we have in the test

SetupTest;
fThreadRefCount := 0; //number of active threads
Thread1 := TMyThread.Create(True);
Inc(fThreadRefCount);
Thread1.OnTerminate := HandleTerminate; //HandleOnTerminate decrements fThreadRefCount
Thread3 := TMyThread.Create(True);
Inc(fThreadRefCount);
Thread2.OnTerminate := HandleTerminate; //HandleOnTerminate decrements fThreadRefCount
Thread3 := TMyThread.Create(True);
Inc(fThreadRefCount);
Thread3.OnTerminate := HandleTerminate; //HandleOnTerminate decrements fThreadRefCount

Thread1.Resume;
Thread2.Resume;
Thread3.Resume;

while fThreadRefCount > 0 do
  Application.ProcessMessages;

I have tried doing nothing in the OnExecute, so I'm sure it's not the actual code I'm testing. In the console, fThreadRefCount never decrements, while if I run it as a gui app, it's fine!

As far as I can see, the OnTerminate event is just not called.

like image 353
Steve Avatar asked Nov 07 '08 18:11

Steve


2 Answers

You need to provide more data.

Note that OnTerminate is called via Synchronize(), which requires a call to CheckSynchronize() at some point somewhere. Application.ProcessMessages() normally does this, but depending on how the VCL has been initialized, it's possible that the Synchronize() mechanism hasn't been fully hooked together in a Console application.

In any case, this program works as expected on my machine:

uses Windows, SysUtils, Classes, Forms;

var
  threadCount: Integer;

type
  TMyThread = class(TThread)
  public
    procedure Execute; override;
    class procedure Go;
    class procedure HandleOnTerminate(Sender: TObject);
  end;
  
procedure TMyThread.Execute;
begin
end;

class procedure TMyThread.Go;
  function MakeThread: TThread;
  begin
    Result := TMyThread.Create(True);
    Inc(threadCount);
    Result.OnTerminate := HandleOnTerminate;
  end;
var
  t1, t2, t3: TThread;
begin
  t1 := MakeThread;
  t2 := MakeThread;
  t3 := MakeThread;
  t1.Resume;
  t2.Resume;
  t3.Resume;
  while threadCount > 0 do
    Application.ProcessMessages;
end;

class procedure TMyThread.HandleOnTerminate(Sender: TObject);
begin
  InterlockedDecrement(threadCount);
end;

begin
  try
    TMyThread.Go;
  except
    on e: Exception do
      Writeln(e.Message);
  end;
end.
like image 133
Barry Kelly Avatar answered Sep 19 '22 06:09

Barry Kelly


As Barry rightly pointed out, unless CheckSyncronize() is called, Synchronize() is not processed, and if Synchronize() is not processed, then the OnTerminate event is not fired.

What seems to be happening is that when I run my unit tests as a Console application, there are no messages on the message queue, and thus Application.ProcessMessage(), which is called from Application.ProcessMessages(), never gets to call CheckSynchronize().

I've now solved the problem by changing the loop to this:

While fThreadRefCount > 0 do
begin
   Application.ProcessMessages;
   CheckSynchronize;
end;

It now works in both Console and GUI modes.

The whole WakeupMainThread hook seems to be setup properly. It's this hook which posts the WM_NULL message that triggers the CheckSynchronize(). It just doesn't get that far in the Console app.

More Investigation

So, Synchronize() does get called. DoTerminate() calls Synchronize(CallOnTerminate) but there's a line in there:

WaitForSingleObject(SyncProcPtr.Signal, Infinite); 

which just waits forever.

So, while my fix above works, there's something deeper to this!

like image 38
Steve Avatar answered Sep 18 '22 06:09

Steve