Question

It has been asked before, but without a full answer. This is to do with the so called famous “‘Fatal threading model!’”.

I need to replace this call to TThread.Suspend with something safe, that returns when terminated or resumed:

procedure TMyThread.Execute;
begin
  while (not Terminated) do begin
     if PendingOffline then begin
          PendingOffline := false;   // flag off.
          ReleaseResources;
          Self.Suspend; // suspend thread. { evil! ask Barry Kelly why.}
          // -- somewhere else, after a long time, a user clicks
          // a resume button, and the thread resumes: --
          if Terminated then
              exit; // leave TThread.Execute.
          // Not terminated, so we continue..
          GrabResources;
     end;
    end;
end;

The original answer vaguely suggests “TMutex, TEvent and critical sections”.

I guess I’m looking for a TThreadThatDoesntSuck.

Here’s the sample TThread derivative with a Win32Event, for comments:

unit SignalThreadUnit;

interface

uses
  Classes,SysUtils,Windows;

type

TSignalThread = class(TThread)
  protected
    FEventHandle:THandle;
    FWaitTime :Cardinal; {how long to wait for signal}
    //FCritSec:TCriticalSection; { critical section to prevent race condition at time of change of Signal states.}
    FOnWork:TNotifyEvent;

    FWorkCounter:Cardinal; { how many times have we been signalled }

    procedure Execute; override; { final; }

    //constructor Create(CreateSuspended: Boolean); { hide parent }
  public
    constructor Create;
    destructor Destroy; override;

    function WaitForSignal:Boolean; { returns TRUE if signal received, false if not received }

    function Active:Boolean; { is there work going on? }

    property WorkCounter:Cardinal read FWorkCounter; { how many times have we been signalled }

    procedure Sync(AMethod: TThreadMethod);

    procedure Start; { replaces method from TThread }
    procedure Stop; { provides an alternative to deprecated Suspend method }

    property Terminated; {make visible}

  published
      property WaitTime :Cardinal read FWaitTime write FWaitTime; {how long to wait for signal}

      property OnWork:TNotifyEvent read FOnWork write FOnWork;

end;

implementation

{ TSignalThread }

constructor TSignalThread.Create;
begin
  inherited Create({CreateSuspended}true);
 // must create event handle first!
  FEventHandle := CreateEvent(
          {security}      nil,
          {bManualReset}  true,
          {bInitialState} false,
          {name}          nil);

  FWaitTime := 10;
end;

destructor TSignalThread.Destroy;
begin
 if Self.Suspended or Self.Terminated then
    CloseHandle(FEventHandle);
  inherited;
end;



procedure TSignalThread.Execute;
begin
//  inherited; { not applicable here}
  while not Terminated do begin
      if WaitForSignal then begin
          Inc(FWorkCounter);
          if Assigned(FOnWork) then begin
              FOnWork(Self);
          end;
      end;
  end;
  OutputDebugString('TSignalThread shutting down');

end;

{ Active will return true when it is easily (instantly) apparent that
  we are not paused.  If we are not active, it is possible we are paused,
  or it is possible we are in some in-between state. }
function TSignalThread.Active: Boolean;
begin
 result := WaitForSingleObject(FEventHandle,0)= WAIT_OBJECT_0;
end;

procedure TSignalThread.Start;
begin
  SetEvent(FEventHandle); { when we are in a signalled state, we can do work}
  if Self.Suspended then
      inherited Start;

end;

procedure TSignalThread.Stop;
begin
    ResetEvent(FEventHandle);
end;

procedure TSignalThread.Sync(AMethod: TThreadMethod);
begin
 Synchronize(AMethod);
end;

function TSignalThread.WaitForSignal: Boolean;
var
 ret:Cardinal;
begin
  result := false;
  ret := WaitForSingleObject(FEventHandle,FWaitTime);
  if (ret=WAIT_OBJECT_0) then
      result := not Self.Terminated;
end;

end.

Answer 1

EDIT: Latest version can be found on GitHub: https://github.com/darianmiller/d5xlib

I’ve come up with this solution as a basis for TThread enhancement with a working Start/Stop mechanism that doesn’t rely on Suspend/Resume. I like to have a thread manager that monitors activity and this provides some of the plumbing for that.

unit soThread;

interface

uses
  Classes,
  SysUtils,
  SyncObjs,
  soProcessLock;


type

  TsoThread = class;
  TsoNotifyThreadEvent = procedure(const pThread:TsoThread) of object;
  TsoExceptionEvent = procedure(pSender:TObject; pException:Exception) of object;


  TsoThreadState = (tsActive,
                    tsSuspended_NotYetStarted,
                    tsSuspended_ManuallyStopped,
                    tsSuspended_RunOnceCompleted,
                    tsTerminationPending_DestroyInProgress,
                    tsSuspendPending_StopRequestReceived,
                    tsSuspendPending_RunOnceComplete,
                    tsTerminated);

  TsoStartOptions = (soRepeatRun,
                     soRunThenSuspend,
                     soRunThenFree);



  TsoThread = class(TThread)
  private
    fThreadState:TsoThreadState;
    fOnException:TsoExceptionEvent;
    fOnRunCompletion:TsoNotifyThreadEvent;
    fStateChangeLock:TsoProcessResourceLock;
    fAbortableSleepEvent:TEvent;
    fResumeSignal:TEvent;
    fTerminateSignal:TEvent;
    fExecDoneSignal:TEvent;
    fStartOption:TsoStartOptions;
    fProgressTextToReport:String;
    fRequireCoinitialize:Boolean;
    function GetThreadState():TsoThreadState;
    procedure SuspendThread(const pReason:TsoThreadState);
    procedure Sync_CallOnRunCompletion();
    procedure DoOnRunCompletion();
    property ThreadState:TsoThreadState read GetThreadState;
    procedure CallSynchronize(Method: TThreadMethod);
  protected
    procedure Execute(); override;

    procedure BeforeRun(); virtual;      // Override as needed
    procedure Run(); virtual; ABSTRACT;  // Must override
    procedure AfterRun(); virtual;       // Override as needed

    procedure Suspending(); virtual;
    procedure Resumed(); virtual;
    function ExternalRequestToStop():Boolean; virtual;
    function ShouldTerminate():Boolean;

    procedure Sleep(const pSleepTimeMS:Integer);  

    property StartOption:TsoStartOptions read fStartOption write fStartOption;
    property RequireCoinitialize:Boolean read fRequireCoinitialize write fRequireCoinitialize;
  public
    constructor Create(); virtual;
    destructor Destroy(); override;

    function Start(const pStartOption:TsoStartOptions=soRepeatRun):Boolean;
    procedure Stop();  //not intended for use if StartOption is soRunThenFree

    function CanBeStarted():Boolean;
    function IsActive():Boolean;

    property OnException:TsoExceptionEvent read fOnException write fOnException;
    property OnRunCompletion:TsoNotifyThreadEvent read fOnRunCompletion write fOnRunCompletion;
  end;


implementation

uses
  ActiveX,
  Windows;


constructor TsoThread.Create();
begin
  inherited Create(True); //We always create suspended, user must call .Start()
  fThreadState := tsSuspended_NotYetStarted;
  fStateChangeLock := TsoProcessResourceLock.Create();
  fAbortableSleepEvent := TEvent.Create(nil, True, False, '');
  fResumeSignal := TEvent.Create(nil, True, False, '');
  fTerminateSignal := TEvent.Create(nil, True, False, '');
  fExecDoneSignal := TEvent.Create(nil, True, False, '');
end;


destructor TsoThread.Destroy();
begin
  if ThreadState <> tsSuspended_NotYetStarted then
  begin
    fTerminateSignal.SetEvent();
    SuspendThread(tsTerminationPending_DestroyInProgress);
    fExecDoneSignal.WaitFor(INFINITE); //we need to wait until we are done before inherited gets called and locks up as FFinished is not yet set
  end;
  inherited;
  fAbortableSleepEvent.Free();
  fStateChangeLock.Free();
  fResumeSignal.Free();
  fTerminateSignal.Free();
  fExecDoneSignal.Free();
end;


procedure TsoThread.Execute();

            procedure WaitForResume();
            var
              vWaitForEventHandles:array[0..1] of THandle;
              vWaitForResponse:DWORD;
            begin
              vWaitForEventHandles[0] := fResumeSignal.Handle;
              vWaitForEventHandles[1] := fTerminateSignal.Handle;
              vWaitForResponse := WaitForMultipleObjects(2, @vWaitForEventHandles[0], False, INFINITE);
              case vWaitForResponse of
              WAIT_OBJECT_0 + 1: Terminate;
              WAIT_FAILED: RaiseLastOSError;
              //else resume
              end;
            end;
var
  vCoInitCalled:Boolean;
begin
  try
    try
      while not ShouldTerminate() do
      begin
        if not IsActive() then
        begin
          if ShouldTerminate() then Break;
          Suspending;
          WaitForResume();   //suspend()

          //Note: Only two reasons to wake up a suspended thread:
          //1: We are going to terminate it  2: we want it to restart doing work
          if ShouldTerminate() then Break;
          Resumed();
        end;

        if fRequireCoinitialize then
        begin
          CoInitialize(nil);
          vCoInitCalled := True;
        end;
        BeforeRun();
        try
          while IsActive() do
          begin
            Run(); //descendant's code
            DoOnRunCompletion();

            case fStartOption of
            soRepeatRun:
              begin
                //loop
              end;
            soRunThenSuspend:
              begin
                SuspendThread(tsSuspendPending_RunOnceComplete);
                Break;
              end;
            soRunThenFree:
              begin
                FreeOnTerminate := True;
                Terminate();
                Break;
              end;
            else
              begin
                raise Exception.Create('Invalid StartOption detected in Execute()');
              end;
            end;
          end;
        finally
          AfterRun();
          if vCoInitCalled then
          begin
            CoUnInitialize();
          end;
        end;
      end; //while not ShouldTerminate()
    except
      on E:Exception do
      begin
        if Assigned(OnException) then
        begin
          OnException(self, E);
        end;
        Terminate();
      end;
    end;
  finally
    //since we have Resumed() this thread, we will wait until this event is
    //triggered before free'ing.
    fExecDoneSignal.SetEvent();
  end;
end;


procedure TsoThread.Suspending();
begin
  fStateChangeLock.Lock();
  try
    if fThreadState = tsSuspendPending_StopRequestReceived then
    begin
      fThreadState := tsSuspended_ManuallyStopped;
    end
    else if fThreadState = tsSuspendPending_RunOnceComplete then
    begin
      fThreadState := tsSuspended_RunOnceCompleted;
    end;
  finally
    fStateChangeLock.Unlock();
  end;
end;


procedure TsoThread.Resumed();
begin
  fAbortableSleepEvent.ResetEvent();
  fResumeSignal.ResetEvent();
end;


function TsoThread.ExternalRequestToStop:Boolean;
begin
  //Intended to be overriden - for descendant's use as needed
  Result := False;
end;


procedure TsoThread.BeforeRun();
begin
  //Intended to be overriden - for descendant's use as needed
end;


procedure TsoThread.AfterRun();
begin
  //Intended to be overriden - for descendant's use as needed
end;


function TsoThread.Start(const pStartOption:TsoStartOptions=soRepeatRun):Boolean;
var
  vNeedToWakeFromSuspendedCreationState:Boolean;
begin
  vNeedToWakeFromSuspendedCreationState := False;

  fStateChangeLock.Lock();
  try
    StartOption := pStartOption;

    Result := CanBeStarted();
    if Result then
    begin
      if (fThreadState = tsSuspended_NotYetStarted) then
      begin
        //Resumed() will normally be called in the Exec loop but since we
        //haven't started yet, we need to do it here the first time only.
        Resumed();
        vNeedToWakeFromSuspendedCreationState := True;
      end;

      fThreadState := tsActive;

      //Resume();
      if vNeedToWakeFromSuspendedCreationState then
      begin
        //We haven't started Exec loop at all yet
        //Since we start all threads in suspended state, we need one initial Resume()
        Resume();
      end
      else
      begin
        //we're waiting on Exec, wake up and continue processing
        fResumeSignal.SetEvent();
      end;
    end;
  finally
    fStateChangeLock.Unlock();
  end;
end;


procedure TsoThread.Stop();
begin
  SuspendThread(tsSuspendPending_StopRequestReceived);
end;


procedure TsoThread.SuspendThread(const pReason:TsoThreadState);
begin
  fStateChangeLock.Lock();
  try
    fThreadState := pReason; //will auto-suspend thread in Exec
    fAbortableSleepEvent.SetEvent();
  finally
    fStateChangeLock.Unlock();
  end;
end;


procedure TsoThread.Sync_CallOnRunCompletion();
begin
  if Assigned(fOnRunCompletion) then fOnRunCompletion(Self);
end;


procedure TsoThread.DoOnRunCompletion();
begin
  if Assigned(fOnRunCompletion) then CallSynchronize(Sync_CallOnRunCompletion);
end;


function TsoThread.GetThreadState():TsoThreadState;
begin
  fStateChangeLock.Lock();
  try
    if Terminated then
    begin
      fThreadState := tsTerminated;
    end
    else if ExternalRequestToStop() then
    begin
      fThreadState := tsSuspendPending_StopRequestReceived;
    end;
    Result := fThreadState;
  finally
    fStateChangeLock.Unlock();
  end;
end;


function TsoThread.CanBeStarted():Boolean;
begin
  Result := (ThreadState in [tsSuspended_NotYetStarted,
                             tsSuspended_ManuallyStopped,
                             tsSuspended_RunOnceCompleted]);
end;

function TsoThread.IsActive():Boolean;
begin
  Result := (ThreadState = tsActive);
end;


procedure TsoThread.Sleep(const pSleepTimeMS:Integer);
begin
  fAbortableSleepEvent.WaitFor(pSleepTimeMS);
end;


procedure TsoThread.CallSynchronize(Method: TThreadMethod);
begin
  if IsActive() then
  begin
    Synchronize(Method);
  end;
end;

Function TsoThread.ShouldTerminate():Boolean;
begin
  Result := Terminated or
            (ThreadState in [tsTerminationPending_DestroyInProgress, tsTerminated]);
end;

end.