终止线程时Delphi AsyncCalls死锁(com + dll终结)

时间:2015-10-14 23:24:59

标签: multithreading delphi

我有一个很棒的Delphi 2007项目,我使用AsyncCall

我在单个控制台应用程序中提取并测试了多线程代码,一切正常。

我的Delphi 2007项目生成了一个COM DLL,我有一些用C#编写的单元测试 - 调用DLL的mstest。

单元测试经常随机挂起(测试通过),我发现它发生在AsyncCall单元 - finalizatoin部分释放ThreadPool。

destructor TThreadPool.Destroy;
var
  I: Integer;
  Call: TInternalAsyncCall;
begin
  FMaxThreads := FThreadCount; // Do not allocation new threads
  FDestroying := True; // => Sync in this thread because there is no other thread (required for FAsnycCallHead.Free)

  // Allow the threads to terminate if there is no task
  for I := FThreadCount - 1 downto 0 do
    FThreads[I].Terminate;
  // Wake up all sleeping threads and keep them awake so they can terminate
  SetEvent(FThreadTerminateEvent);
  // Wait and destroy the threads
****Hangs here -------->      for I := FThreadCount - 1 downto 0 do   
****------->        FThreads[I].Free;

  ReleaseAutoDeleteAsyncCalls;

  // Clean up not yet released AutoDelete InternalAsyncCalls.
  while FAsyncCallHead <> nil do
  begin
    Call := FAsyncCallHead.FNext;
    CheckAutoDelete(FAsyncCallHead);
    FAsyncCallHead := Call;
  end;

  CloseHandle(FThreadTerminateEvent);
  CloseHandle(FWakeUpEvent);
  CloseHandle(FMainThreadSyncEvent);
  DeallocateHWnd(FMainThreadVclHandle);
  DeleteCriticalSection(FAsyncCallsCritSect);

  inherited Destroy;
end;

如果我删除

  for I := FThreadCount - 1 downto 0 do
    FThreads[I].Free;

然后工作正常。我无法在一个简单的示例中重现这一点,并且无法想到任何可能在终止时挂起线程的原因。

我认为这与此处提出的问题非常相似:

http://qc.embarcadero.com/wc/qcmain.aspx?d=29843

  

如果一个线程停止,它会从Classes调用ThreadExit:ThreadProc And   ThreadExit使用DLL_THREAD_DETACH调用DLLEntryProc。只有一个   进程中的线程可以在DLL初始化或分离例程中   一次。

     

问题是com + dll的最终确定是从   DLL_THREAD_DETACH,以便Classes:TThread.WaitFor等待   无限期,因为线程不会因为无法处理而终止   它的DLL_THREAD_DETACH直到最终完成。

更新

我花了几天时间找出原因,并且有一项工作是手动执行AsyncCall单元的终结部分。

这与算法无关,因为即使非常简单的代码也会导致com + dll出现问题。

以下是重现的步骤:

创建一个com + dll 创建一个具有以下代码的方法: 确保调用TestAsync,当线程池(来自AsyncCall)清理线程时你会发现死锁。

procedure Test(int i: integer); cdecl;
begin
  Exit;
end;

procedure TestAsyn;
var
  t: IAsyncCall;
begin
  t := AsyncCall(@Test, [0])
  t.Sync;
end;

1 个答案:

答案 0 :(得分:0)

看起来你正在尝试做一些你不允许在dll的初始化/完成中做的事情。

您需要从其他地方运行该终结代码。通常这是在dll导出的辅助函数内完成的。另一个选项是在释放dll的最后一个com对象时运行终结。

导出的函数DllCanUnloadNow看起来像是终止线程的候选者。