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
Description
If a thread stops, it calls ThreadExit from Classes:ThreadProc
And ThreadExit calls the DLLEntryProc with DLL_THREAD_DETACH

From
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dllp...


  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
deadlock)

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.
Workarounds
unit ComtecThread;

interface

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

uses
  Classes,
  RTLConsts,
  SysUtils,
  Windows,
  SyncObjs;

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

implementation

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

procedure SignalSyncEvent;
begin
  SetEvent(SyncEvent);
end;


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

{ TComtecThread }

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

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

function TComtecThread.FixedWaitFor: LongWord;
var
  H: array[0..2] of THandle;
  WaitResult: Cardinal;
  Msg: TMsg;
begin
  H[0] := TExposedThread(Self).FHandle;
  H[2] := Self.FThreadDeathEvent.Handle;
  if GetCurrentThreadID = MainThreadID then
  begin
    WaitResult := 0;
    H[1] := SyncEvent;
    repeat
      { 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
        CheckSynchronize;
    until (WaitResult = WAIT_OBJECT_0) or (WaitResult = WAIT_OBJECT_0+2);
  end else WaitForSingleObject(H[0], INFINITE);
  CheckThreadError(GetExitCodeThread(H[0], Result));
end;

end.
Attachment
None
Comments

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;

To

   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