Watch, Follow, &
Connect with Us
Public Report
Report From: Delphi-BCB/RTL/Delphi/Thread support    [ Add a report in this area ]  
Report #:  26291   Status: Closed
Using TThread.Resume may cause setting freed object value
Project:  Delphi Build #:  10.0.2166.28377
Version:    10.0 Submitted By:   Atle Smelvaer
Report Type:  Basic functionality failure Date Reported:  3/20/2006 3:13:47 AM
Severity:    Commonly encountered problem Last Updated: 3/20/2012 2:24:39 AM
Platform:    All versions Internal Tracking #:   239315
Resolution: Fixed (Resolution Comments) Resolved in Build: : 14.0.3502.23885
Duplicate of:  None
Voting and Rating
Overall Rating: (3 Total Ratings)
4.67 out of 5
Total Votes: 78
Description
When using TThread in suspended state, and FreeOnTerminate, TThread.Resume miss threadsafe handling of the thread.

Today the code looks like this:

procedure TThread.Resume;
var
  SuspendCount: Integer;
begin
  SuspendCount := ResumeThread(FHandle);
  CheckThreadError(SuspendCount >= 0);
  if SuspendCount = 1 then
    FSuspended := False;
end;

The problem is, if there are many threads created and freed, the delay after ResumeThread(FHandle) could be big enough for the thread to finish and free itself before the routine arrives at FSuspended := False.

This will cause TThread.Resume to set a value on the freed object, and in worst case corrupt memory on newly allocated memory for some other structure.

This routine has to be made threadsafe, with interlocked states or using a critical section. One solution could be something like this:

Add FFreeLock: TCriticalSeciton protected area variable.

Create in constructor and free in destructor. Adjust resume something like this:

procedure TThread.Resume;
var
  SuspendCount: Integer;
begin
  FFreeLock.Enter;
  try
    SuspendCount := ResumeThread(FHandle);
    CheckThreadError(SuspendCount >= 0);
    if SuspendCount = 1 then
      FSuspended := False;
  finally
    FFreeLock.Leave;
  end;
end;

And ThreadProc something like this:

function ThreadProc(Thread: TThread): Integer;
var
  Lock: TCriticalSection;
  FreeThread: Boolean;
begin
{$IFDEF LINUX}
  if Thread.FSuspended then sem_wait(Thread.FCreateSuspendedSem);
{$ENDIF}
  try
    if not Thread.Terminated then
    try
      Thread.Execute;
    except
      Thread.FFatalException := AcquireExceptionObject;
    end;
  finally
    FreeThread := Thread.FFreeOnTerminate;
    Result := Thread.FReturnValue;
    Thread.DoTerminate;
    Thread.FFinished := True;
    SignalSyncEvent;
    if FreeThread then
    begin
      Lock := Thread.FFreeLock;
      Lock.Enter;
      Thread.FFreeLock := nil;
      try
        Thread.Free;
      finally
        Lock.Leave;
        Lock.Free;
      end;
    end;
{$IFDEF MSWINDOWS}
    EndThread(Result);
{$ENDIF}
{$IFDEF LINUX}
    // Directly call pthread_exit since EndThread will detach the thread
causing
    // the pthread_join in TThread.WaitFor to fail.  Also, make sure the
EndThreadProc
    // is called just like EndThread would do. EndThreadProc should not
return
    // and call pthread_exit itself.
    if Assigned(EndThreadProc) then
      EndThreadProc(Result);
    pthread_exit(Pointer(Result));
{$ENDIF}
  end;
end;
Steps to Reproduce:
Make a routine to create many TThread's that finish up very quickly. Set them to FreeOnTerminate and use the TThread.Resume.

Set FastMM to use FullDebugMode, and it will detect modified memory after free.
Workarounds
None
Attachment
None
Comments

Atle Smelvaer at 4/21/2006 1:47:38 AM -
Still the same in Delphi 2006 update 2

Alexey Beloborodov at 8/5/2009 11:26:40 PM -
The fix maybe much simpler: in ThreadProc (Classes.pas)

function ThreadProc(Thread: TThread): Integer;
...
    try
      Thread.Execute;
    except
      ...
    end;
  finally
    FreeThread := Thread.FFreeOnTerminate;
    Result := Thread.FReturnValue;
    Thread.DoTerminate;
    Thread.FFinished := True;
    SignalSyncEvent;
// Fix --------------------------------------------
    if FreeThread and (FSuspended=True) then
     repeat
      Sleep(0); // there was no time for assignment, relinquish the remainder of time slice
     until (FSuspended=False);
// End of fix -----------------------------------
    if FreeThread then Thread.Free;
...

Explanation:
If we have set property FreeOnTerminate=true and have started the thread (resuming is last allowed action for self-releasing TThread instance), the flag FSuspended can be true in this point (where thread actually is  running) only in case of delay of assignment in Resume method (as described in this article). Hence we simply should wait for the completion of assignment.

The same fix can be made in user's code at the end of Execute:

TMyThread.Execute;
begin
...
    if FreeOnTerminate and (Suspended=True) then
     repeat Sleep(0); until (Suspended=False);
end;

--------
Correction:
As Allen Bauer noticed in NG "Sleep(0) will only relinquish the current timeslice to waiting threads of *equal or greater priority*", so wee need to use Sleep(1). It unconditionally stops current thread and gives timeslice to other - even less priority - threads. Notice that (1) is not precise interval, OS can stop the thread on 10 or more milliseconds.

Mitja Perko at 2/9/2009 2:56:54 AM -
I believe this error to be quite critical now in the days of multicore processors. In our application this error (we have FastMM reports enabled) happens daily with threads running in normal priority and doing communication with a server.

Farshad Mohajeri at 7/28/2009 7:31:22 AM -
Agreed. It is very critical. It costed us two weeks of debugging to find out why our server written in Delphi crashes. It must be considered as a high-priority bug.

Server Response from: ETNACODE01