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

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

6 голосов
/ 07 ноября 2008

У нас есть довольно зрелая 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 просто не вызывается.

Ответы [ 2 ]

8 голосов
/ 07 ноября 2008

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

Обратите внимание, что 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.
5 голосов
/ 09 ноября 2008

Как справедливо заметил Барри, если не вызывается 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);

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

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

...