Delphi Thread Timeout дает утечки каждый раз

Question

Итак, я реализовал многопоточность с помощью THandle, вот так:

procedure Calc_Prin;
type
  TTeste = record
    ptrClass: TSpAu;
    ptrTEMPO: ^integer;
  end;

var
  TEMPO: integer;
  RESULTADO: THandle;
  thrID: DWord;
  teste: TTeste;

  function THREAD_C(PTR: pointer): longint; stdcall;
  begin
    try
      CoInitializeEx(nil, COINIT_APARTMENTTHREADED);
      TPtrTeste(PTR).ptrClass.Calc;
      TPtrTeste(PTR).ptrTEMPO^ := 1;
    finally
      ExitThread(1);
      CoUninitialize;
      result := 0;
    end;
  end;

begin
  RESULTADO := CreateThread(nil, 0, @THREAD_C, @teste, 0, thrID);
  WaitForSingleObject(RESULTADO, TEMPO_PERMITIDO); 

  SuspendThread(RESULTADO);
  CloseHandle(RESULTADO);
end;

Когда поток работает нормально (тайм-аут не достигнут, а процесс преждевременно не завершен), утечки не будет, но если у потока возникнут какие-то проблемы и он достигнет тайм-аута, это даст мне много утечек, потому что я думаю, это просто уходит от функции, игнорируя все попытки.. наконец, где я все освобождаю.

Есть ли способ завершить поток и устранить утечки, которые он допускает?

Answer 1

Попробуйте что-то более похожее на это:

type
  TSpAu = class
  public
    Cancelled: Boolean;
    procedure Calc;
  end;

  TPtrTeste = ^TTeste;
   TTeste = record
    ptrClass: TSpAu;
    ptrTEMPO: ^integer;
  end;

procedure TSpAu.Calc;
begin
  ...
  if Cancelled then Abort;
  ...
  if Cancelled then Abort;
  ...
end;


function THREAD_CALCULO(PTR: pointer): DWORD; stdcall;
begin
  CoInitializeEx(nil, COINIT_APARTMENTTHREADED);
  try
    with TPtrTeste(PTR)^ do
    begin
      try
        ptrClass.Calc;
        ptrTEMPO^ := 1;
      except
        ptrTEMPO^ := 0;
      end;
    end;
  finally
    CoUninitialize;
  end;
  Result := 0;
end;

procedure Calc_Prin;
var
  TEMPO: integer;
  RESULTADO: THandle;
  thrID: DWord;
  teste: TTeste;
  ret: DWORD;
begin
  TEMPO := 0;

  teste.ptrClass := ...; // <-- whatever your TSpAu object is
  teste.ptrTEMPO := @TEMPO;

  RESULTADO := CreateThread(nil, 0, @THREAD_CALCULO, @teste, 0, thrID);
  if RESULTADO = 0 then RaiseLastOSError;
  try
    ret := WaitForSingleObject(RESULTADO, TEMPO_PERMITIDO);
    if ret = WAIT_TIMEOUT then
    begin
      teste.ptrClass.Cancelled := True;
      ret := WaitForSingleObject(RESULTADO, INFINITE);
    end;
    if ret = WAIT_FAILED then RaiseLastOSError;
  finally
    CloseHandle(RESULTADO);
  end;

  // use TEMPO as needed...
end;

Answer 2

Вы вызываете ExitThread(), что немедленно убивает поток, что означает, что вызов CoUninitialize() больше не выполняется. Вам не нужно вызывать ExitThread самостоятельно. Достаточно нормально выйти из функции потока.

try
  // ...
finally
  CoUnintialize;
  Result := 1; // the value that you specified in the ExitThread() call
end;

Вызов SuspendThread() может приостановить поток, но он не будет выполнять блок "finally", а также не покинет функцию Calc() и не завершит поток. Вам необходимо добавить проверку "has-terminated" в вашу функцию Calc(), чтобы поток мог завершиться изящно.

РЕДАКТИРОВАТЬ:
Вот псевдокод, который позволяет корректно завершить ваш поток, изменив метод Calc(), чтобы узнать о возможном таймауте.

type
  ECalcTimedOut = class(Exception);

  TSpAu = class(...)
  protected
    FCalcTimedOut: Boolean;
    procedure CheckCalcTimedOut;
  end;

  PTeste = ^TTeste;
  TTeste = record
    ptrClass: TSpAu;
    ptrTEMPO: ^integer;
  end;

function THREAD_CALCULO(PTR: pointer): longint; stdcall;
begin
  CoInitializeEx(nil, COINIT_APARTMENTTHREADED);
  try
    try
      PTeste(PTR).ptrClass.Calc;
      PTeste(PTR).ptrTEMPO^ := 1;
      Result := 1;
    except
      on ECalcTimedOut do
        Result := 0;
    end;
  finally
    CoUninitialize;
  end;
end;

procedure Calc_Prin;
var
  TEMPO: integer;
  RESULTADO: THandle;
  thrID: DWord;
  teste: TTeste;
begin
  // ...
  teste.ptrClass.FCalcTimedOut := False;

  RESULTADO := CreateThread(nil, 0, @THREAD_CALCULO, @teste, 0, thrID);
  if WaitForSingleObject(RESULTADO, TEMPO_PERMITIDO) = WAIT_TIMEOUT then
  begin
    // Signal the Calc() method that it timed out
    teste.ptrClass.FCalcTimedOut := True;
    // Wait for the thread to terminate gracefully
    WaitForSingleObject(RESULTADO, INFINITE);
  end;
  CloseHandle(RESULTADO);
end;

procedure TSpAu.CheckCalcTimedOut;
begin
  if FCalcTimedOut then
    raise ECalcTimedOut.Create('Calc Timed out');
end;

procedure TSpAu.Calc;
begin
  CheckCalcTimeout;
  // do something
  while condition do
  begin
    CheckCalcTimeout;
    DoSomethingElse;
    CheckCalcTimeout;
    // do something
  end;
end;

procedure TSpAu.DoSomethingElse;
begin
  for I := 0 to 1000000 do
  begin
    CheckCalcTimeout;
    // do something
  end;
end;