Работает ли TThread по-разному в консольном приложении Delphi 2006?

Question

У нас есть довольно зрелая COM-библиотека, которую мы тестируем с помощью DUnit. Один из наших недавних тестов создает несколько потоков и тестирует объект из этих потоков. Этот тест работает нормально при запуске теста с использованием графического интерфейса, но зависает при запуске в качестве консольного приложения. Вот быстрый псевдо-обзор того, что мы имеем в тесте

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;

Я пытался ничего не делать в OnExecute, поэтому я уверен, что это не тот код, который я тестирую. В консоли fThreadRefCount никогда не уменьшается, а если я запускаю его как приложение с графическим интерфейсом, это нормально!

Насколько я вижу, событие OnTerminate просто не вызывается.

Answer 1

Вам необходимо предоставить больше данных.

Обратите внимание, что OnTerminate вызывается через Synchronize, который требует вызова CheckSynchronize в какой-то момент. Application.ProcessMessages обычно делает это, но в зависимости от того, как VCL был инициализирован, возможно, что механизм Synchronize не был полностью подключен в консольном приложении.

В любом случае эта программа работает, как и ожидалось, на моем компьютере:

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.

Answer 2

Как справедливо заметил Барри, если не вызывается CheckSyncronize, не вызывается Synchronize, а если не вызывается синхронизация, то событие OnTerminate не вызывается. Кажется, что происходит, когда я запускаю свои модульные тесты как консольное приложение, в очереди сообщений нет никаких сообщений, и поэтому Application.ProcessMessage, который вызывается из Processmessages, никогда не получает вызов checkSynchronize. Теперь я решил проблему, изменив цикл на

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

Теперь он работает как в консольном, так и в графическом режиме.

Кажется, весь хук wakeupmainthread настроен правильно. Именно этот хук отправляет сообщение WM_NULL, которое запускает проверку синхронизации. В консольном приложении это далеко не так далеко.

Дополнительные расследования

Итак, Synchronize вызывает . DoTerminate вызывает Synchronize (CallOnTerminate), но там есть строка:

WaitForSingleObject(SyncProcPtr.Signal, Infinite); 

который просто ждет вечно.

Так что, хотя мое исправление выше работает, в этом есть что-то более глубокое!