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.
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.
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!
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With