QualityCentral

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?

Developer Tools

Database Tools