¿TThread funciona de manera diferente en una aplicación de consola Delphi 2006?

Question

Tenemos un dll COM bastante maduro, que probamos con DUnit. Una de nuestras pruebas recientes crea algunos subprocesos y prueba el objeto de esos subprocesos. Esta prueba funciona bien cuando se ejecuta utilizando la interfaz gráfica de usuario, pero se bloquea cuando se ejecuta como una aplicación de consola. Aquí hay una pseudo vista rápida de lo que tenemos en la prueba

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;

He intentado no hacer nada en OnExecute, así que estoy seguro de que no es el código real que estoy probando. En la consola, fThreadRefCount nunca disminuye, mientras que si lo ejecuto como una aplicación gui, ¡está bien!

Hasta donde puedo ver, el evento OnTerminate simplemente no se llama.

Answer 1

Debe proporcionar más datos.

Tenga en cuenta que OnTerminate se llama a través de Synchronize, que requiere una llamada a CheckSynchronize en algún momento en algún lugar. Application.ProcessMessages normalmente hace esto, pero dependiendo de cómo se haya inicializado el VCL, es posible que el mecanismo de sincronización no se haya enganchado completamente en una aplicación de consola.

En cualquier caso, este programa funciona como se esperaba en mi máquina:

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

Como Barry señaló correctamente, a menos que se llame a CheckSyncronize, no se llama a Synchronize, y si no se llama a sync, entonces el evento OnTerminate no se dispara. Lo que parece estar sucediendo es que cuando ejecuto mis pruebas unitarias como una aplicación de consola, no hay mensajes en la cola de mensajes y, por lo tanto, Application.ProcessMessage, que se llama desde Processmessages, nunca llama a checkSynchronize. Ahora he resuelto el problema cambiando el ciclo a

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

Ahora funciona tanto en modo consola como en modo gui.

Todo el hook de wakeupmainthread parece estar configurado correctamente. Es este gancho el que publica el mensaje WM_NULL que activa la sincronización de comprobación. Simplemente no llega tan lejos en la aplicación de consola.

Más investigación

Entonces Sincronizar se llama . DoTerminate llama a Sincronizar (CallOnTerminate) pero hay una línea allí:

WaitForSingleObject(SyncProcPtr.Signal, Infinite); 

que solo espera para siempre.

Entonces, aunque mi solución anterior funciona, ¡hay algo más profundo en esto!