Does TThread work differently in a Delphi 2006 console application?
-
07-07-2019 - |
Question
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.
Solution
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.
OTHER TIPS
As Barry rightly pointed out, unless CheckSyncronize is called, Synchronize is not called, and if synchronize is not called, 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 Processmessages, never gets to call checkSynchronize. I've now solved the problem by changing the loop to
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 for ever.
So while my fix above works, there's something deeper to this!