How to complete the thread?

Question

My usual setup for a thread is a while loop, and inside a while loop does two things:

• do some work.
• Pause until it resumes outside

procedure TMIDI_Container_Publisher.Execute; begin Suspend; while not Terminated do begin FContainer.Publish; if not Terminated then Suspend; end; // if end; // Execute // 

It works great. To complete the code, I use:

 destructor TMIDI_Container_Publisher.Destroy; begin Terminate; if Suspended then Resume; Application.ProcessMessages; Self.WaitFor; inherited Destroy; end; // Destroy // 

This Destroy works fine on Windows 7 but hangs on XP. The problem seems to be in WaitFor, but when I delete this code, it hangs in inherited Destroy .

Does anyone think what's wrong?

---

Update 2011/11/02 Thank you all for your help. Remy Labeau came up with sample code to avoid Resume / Suspend at all. From now on, I will implement his proposal in my programs. For this particular occasion, I was inspired by the CodeInChaos proposal. Just create a stream, let it publish to Execute and forget about it. I used the Remy example to rewrite one of my timers. I post this implementation below.

 unit Timer_Threaded; interface uses Windows, MMSystem, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, SyncObjs, Timer_Base; Type TTask = class (TThread) private FTimeEvent: TEvent; FStopEvent: TEvent; FOnTimer: TNotifyEvent; public constructor Create; destructor Destroy; override; procedure Execute; override; procedure Stop; procedure ProcessTimedEvent; property OnTimer: TNotifyEvent read FOnTimer write FOnTimer; end; // Class: TWork // TThreadedTimer = class (TBaseTimer) private nID: cardinal; FTask: TTask; protected procedure SetOnTimer (Task: TNotifyEvent); override; procedure StartTimer; override; procedure StopTimer; override; public constructor Create; override; destructor Destroy; override; end; // Class: TThreadedTimer // implementation var SelfRef: TTask; // Reference to the instantiation of this timer procedure TimerUpdate (uTimerID, uMessage: cardinal; dwUser, dw1, dw2: cardinal); stdcall; begin SelfRef.ProcessTimedEvent; end; // TimerUpdate // {******************************************************************* * * * Class TTask * * * ********************************************************************} constructor TTask.Create; begin FTimeEvent := TEvent.Create (nil, False, False, ''); FStopEvent := TEvent.Create (nil, True, False, ''); inherited Create (False); Self.Priority := tpTimeCritical; end; // Create // destructor TTask.Destroy; begin Stop; FTimeEvent.Free; FStopEvent.Free; inherited Destroy; end; // Destroy // procedure TTask.Execute; var two: TWOHandleArray; h: PWOHandleArray; ret: DWORD; begin h := @two; h [0] := FTimeEvent.Handle; h [1] := FStopEvent.Handle; while not Terminated do begin ret := WaitForMultipleObjects (2, h, FALSE, INFINITE); if ret = WAIT_FAILED then Break; case ret of WAIT_OBJECT_0 + 0: if Assigned (OnTimer) then OnTimer (Self); WAIT_OBJECT_0 + 1: Terminate; end; // case end; // while end; // Execute // procedure TTask.ProcessTimedEvent; begin FTimeEvent.SetEvent; end; // ProcessTimedEvent // procedure TTask.Stop; begin Terminate; FStopEvent.SetEvent; WaitFor; end; // Stop // {******************************************************************* * * * Class TThreaded_Timer * * * ********************************************************************} constructor TThreadedTimer.Create; begin inherited Create; FTask := TTask.Create; SelfRef := FTask; FTimerName := 'Threaded'; Resolution := 2; end; // Create // // Stop the timer and exit the Execute loop Destructor TThreadedTimer.Destroy; begin Enabled := False; // stop timer (when running) FTask.Free; inherited Destroy; end; // Destroy // procedure TThreadedTimer.SetOnTimer (Task: TNotifyEvent); begin inherited SetOnTimer (Task); FTask.OnTimer := Task; end; // SetOnTimer // // Start timer, set resolution of timesetevent as high as possible (=0) // Relocates as many resources to run as precisely as possible procedure TThreadedTimer.StartTimer; begin nID := TimeSetEvent (FInterval, FResolution, TimerUpdate, cardinal (Self), TIME_PERIODIC); if nID = 0 then begin FEnabled := False; raise ETimer.Create ('Cannot start TThreaded_Timer'); end; // if end; // StartTimer // // Kill the system timer procedure TThreadedTimer.StopTimer; var return: integer; begin if nID <> 0 then begin return := TimeKillEvent (nID); if return <> TIMERR_NOERROR then raise ETimer.CreateFmt ('Cannot stop TThreaded_Timer: %d', [return]); end; // if end; // StopTimer // end. // Unit: MSC_Threaded_Timer // unit Timer_Base; interface uses Windows, MMSystem, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; type TCallBack = procedure (uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD); ETimer = class (Exception); {$M+} TBaseTimer = class (TObject) protected FTimerName: string; // Name of the timer FEnabled: boolean; // True= timer is running, False = not FInterval: Cardinal; // Interval of timer in ms FResolution: Cardinal; // Resolution of timer in ms FOnTimer: TNotifyEvent; // What to do when the hour (ms) strikes procedure SetEnabled (value: boolean); virtual; procedure SetInterval (value: Cardinal); virtual; procedure SetResolution (value: Cardinal); virtual; procedure SetOnTimer (Task: TNotifyEvent); virtual; protected procedure StartTimer; virtual; abstract; procedure StopTimer; virtual; abstract; public constructor Create; virtual; destructor Destroy; override; published property TimerName: string read FTimerName; property Enabled: boolean read FEnabled write SetEnabled; property Interval: Cardinal read FInterval write SetInterval; property Resolution: Cardinal read FResolution write SetResolution; property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer; end; // Class: HiResTimer // implementation constructor TBaseTimer.Create; begin inherited Create; FEnabled := False; FInterval := 500; Fresolution := 10; end; // Create // destructor TBaseTimer.Destroy; begin inherited Destroy; end; // Destroy // // SetEnabled calls StartTimer when value = true, else StopTimer // It only does so when value is not equal to the current value of FEnabled // Some Timers require a matching StartTimer and StopTimer sequence procedure TBaseTimer.SetEnabled (value: boolean); begin if value <> FEnabled then begin FEnabled := value; if value then StartTimer else StopTimer; end; // if end; // SetEnabled // procedure TBaseTimer.SetInterval (value: Cardinal); begin FInterval := value; end; // SetInterval // procedure TBaseTimer.SetResolution (value: Cardinal); begin FResolution := value; end; // SetResolution // procedure TBaseTimer.SetOnTimer (Task: TNotifyEvent); begin FOnTimer := Task; end; // SetOnTimer // end. // Unit: MSC_Timer_Custom // 

Answer 1

You really shouldn't use Suspend() and Resume() like this. They are not only dangerous if used improperly (for example, you), but in any case they are also not recommended in D2010 +. A safer option is to use the TEvent class, for example:

 contructor TMIDI_Container_Publisher.Create; begin fPublishEvent := TEvent.Create(nil, False, False, ''); fTerminateEvent := TEvent.Create(nil, True, False, ''); inherited Create(False); end; destructor TMIDI_Container_Publisher.Destroy; begin Stop fPublishEvent.Free; fTerminateEvent.Free; inherited Destroy; end; procedure TMIDI_Container_Publisher.Execute; var h: array[0..1] of THandle; ret: DWORD; begin h[0] := fPublishEvent.Handle; h[1] := fTerminateEvent.Handle; while not Terminated do begin ret := WaitForMultipleObjects(2, h, FALSE, INFINITE); if ret = WAIT_FAILED then Break; case ret of WAIT_OBJECT_0 + 0: FContainer.Publish; WAIT_OBJECT_0 + 1: Terminate; end; end; end; procedure TMIDI_Container_Publisher.Publish; begin fPublishEvent.SetEvent; end; procedure TMIDI_Container_Publisher.Stop; begin Terminate; fTerminateEvent.SetEvent; WaitFor; end; 

Answer 2

I don’t know the answer to your question, but I think your code has at least one error:

I assume you have a method similar to the following:

 procedure DoWork() begin AddWork(); Resume(); end; 

This results in a race condition:

 procedure TMIDI_Container_Publisher.Execute; begin Suspend; while not Terminated do begin FContainer.Publish; // <= Assume code is here (1) if not Terminated then { Or even worse: here (2) } Suspend; end; // if end; // Execute // 

If you call DoWork and resume the flow while it is somewhere near (1) or (2), it immediately returns to the suspension.

If you call Destroy at run time (2), it immediately pauses and most likely never ends.

Answer 3

There is probably a dead end in this code. Suppose that Execute and Destroy work simultaneously, and there the context is disconnected from the Execute stream immediately after evaluating not Terminated , for example:

 // Thread 1 // Thread 2 if not Terminated then // context switch Terminate; if Suspended then Resume; Application.ProcessMessages; WaitFor; // context switch Suspend; 

You are now waiting for the paused stream to complete. It will never make progress. The inherited destructor also calls Terminate and WaitFor , so it is not surprising that removing code from your own destructor does not have a big impact on the behavior of your program.

Do not pause the stream. Instead, make him wait for an event that signals that more data is needed to process the data. At the same time, wait for another event to indicate that the thread should complete. (As a complement to this tip, don’t worry, call Terminate as it is not virtual, it is just not a useful method to terminate a thread that makes something non-trivial.)

Answer 4

try using suspended: = false instead of resuming.