Watch, Follow, &
Connect with Us
Public Report
Report From: Delphi-BCB/RTL/Delphi/Thread support    [ Add a report in this area ]  
Report #:  29843   Status: Open
Thread.Destroy deadlocks in finalization of COM+ dll's
Project:  Delphi Build #:  10.0.2288.4245
Version:    10.0 Submitted By:   Bart van der Werf
Report Type:  Basic functionality failure Date Reported:  6/6/2006 1:31:57 AM
Severity:    Commonly encountered problem Last Updated: 3/20/2012 2:24:39 AM
Platform:    All versions Internal Tracking #:   257023
Resolution: Need More Info (Resolution Comments) Resolved in Build: : None
Duplicate of:  None
Voting and Rating
Overall Rating: No Ratings Yet
0.00 out of 5
Total Votes: None
If a thread stops, it calls ThreadExit from Classes:ThreadProc
And ThreadExit calls the DLLEntryProc with DLL_THREAD_DETACH


  Only one thread in a process can be in a DLL initialization or
detach routine at a time

The problem is that the finalization of a com+ dll is run from the
DLL_THREAD_DETACH, so that the Classes:TThread.WaitFor will wait
indefinitly because the thread won't terminate because it can't handle
its DLL_THREAD_DETACH till the finalization finishes.

This bug is confirmed to be present both in D7 and D2006


I created a workaround by copy-pasting most of the code TThread uses and
made my own thread class inheriting from it, with the extension that it has
an additional handle it signals before calling ThreadExit int ThreadProc,
which signals WaitFor to continue instead of the actual final cleanup of the
thread. (in my scope this makes no difference at all except that it doesn't

Also did some vtable rewriting so my TThread derived class can override
WaitFor (which isn't virtual)

Steps to Reproduce:
1. Create a COM+ dll.

2. Destroy a TThread in a finalization section of a unit included in the COM+ dll.
unit ComtecThread;


// Windows only
// Checked for D7
// Fixes DLL_THREAD_DETACH related deadlock in the finalization of com+ dll's and Thread.WaitFor


  TComtecThread = class(TThread)
    FThreadDeathEvent: TEvent;
    function FixedWaitFor: LongWord;
    constructor Create(CreateSuspended: Boolean);
    destructor Destroy; override;


  // must match the layout of TThread
  TExposedThread = class
    FHandle: THandle;
    FThreadID: THandle;
    FCreateSuspended: Boolean;
    FTerminated: Boolean;
    FSuspended: Boolean;
    FFreeOnTerminate: Boolean;
    FFinished: Boolean;
    FReturnValue: Integer;
    FOnTerminate: TNotifyEvent;
    FSynchronize: TSynchronizeRecord;
    FFatalException: TObject;

procedure SignalSyncEvent;

function ThreadProc(Thread: TComtecThread): Integer;
  FreeThread: Boolean;
  ExposedThread: TExposedThread;
  ExposedThread := TExposedThread(Thread);
    if not Thread.Terminated then
      ExposedThread.FFatalException := AcquireExceptionObject;
    FreeThread := ExposedThread.FFreeOnTerminate;
    Result := ExposedThread.FReturnValue;
    ExposedThread.FFinished := True;
    if FreeThread then Thread.Free;
    Thread.FThreadDeathEvent.SetEvent; // after this call Thread is no longer guaranteed to be valid

{ TComtecThread }

// DON'T Call inherited !
constructor TComtecThread.Create(CreateSuspended: Boolean);
  FThreadDeathEvent := TEvent.Create;
  // AddThread; doesn't seem to be used for anything
  with TExposedThread(Self) do
    FSuspended := CreateSuspended;
    FCreateSuspended := CreateSuspended;
    FHandle := BeginThread(nil, 0, @ThreadProc, Pointer(Self), CREATE_SUSPENDED, FThreadID);
    if FHandle = 0 then
      raise EThread.CreateResFmt(@SThreadCreateError, [SysErrorMessage(GetLastError)]);

destructor TComtecThread.Destroy;
  with TExposedThread(Self) do
    if (FThreadID <> 0) and not FFinished then
      if FCreateSuspended then
    FHandle := 0;
  // DON'T Call inherited earlier

function TComtecThread.FixedWaitFor: LongWord;
  H: array[0..2] of THandle;
  WaitResult: Cardinal;
  Msg: TMsg;
  H[0] := TExposedThread(Self).FHandle;
  H[2] := Self.FThreadDeathEvent.Handle;
  if GetCurrentThreadID = MainThreadID then
    WaitResult := 0;
    H[1] := SyncEvent;
      { This prevents a potential deadlock if the background thread
        does a SendMessage to the foreground thread }
      if WaitResult = WAIT_OBJECT_0 + 3 then
        PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE);
      WaitResult := MsgWaitForMultipleObjects(3, H, False, 1000, QS_SENDMESSAGE);
      CheckThreadError(WaitResult <> WAIT_FAILED);
      if WaitResult = WAIT_OBJECT_0 + 1 then
    until (WaitResult = WAIT_OBJECT_0) or (WaitResult = WAIT_OBJECT_0+2);
  end else WaitForSingleObject(H[0], INFINITE);
  CheckThreadError(GetExitCodeThread(H[0], Result));


Bart van der Werf at 1/26/2007 7:41:42 AM -
Should i close this bug as nobody seems to want to open it ?

We use our own TThread implementation now so for us it no longer is a problem.

Bart van der Werf at 7/18/2007 2:06:25 AM -
Could the documentation be extended on TThread as to note that you should not try and cleanup threads in the finalization of units that might be included in a dll ?

An Pham at 2/16/2010 10:54:57 AM -
Simple fix codes should be from

   until WaitResult = WAIT_OBJECT_0;


   until (WaitResult = WAIT_OBJECT_0) or FFinished;

Tomohiro Takahashi at 2/16/2010 5:34:19 PM -
An-san, thanks for the informatio.
So, does this issue still exist in Delphi 2010?

Server Response from: ETNACODE01