title: why does a thread sometimes hang in waitfor?
body: <p>In my application I use thread based tasks. They work fine but sometimes they hang the application. In the code below <code>procedure Stop</code> sometimes hangs in the <code>WaitFor</code> procedure. That is because the <code>FStopEvent.SetEvent</code> not always appears to function. </p>
  
  <p>During a normal execution the thread enters the <code>Execute</code> procedure, executes the <code>OnWork</code> procedure until <code>Stop</code> is called (which sets <code>Terminated</code>), then does some postprocessing and then exits. That is the signal for <code>WaitFor</code> to quit and everybody is happy. In my usage this occurs because the task is destroyed. In that case the destructor of the base class is called which calls <code>Stop</code>.</p>
  
  <p>In some cases this does not work. <code>Execute</code> is entered correctly, the <code>OnWork</code> procedure calls are executed ok but there is no reaction on the <code>FStopEvent.SetEvent</code>. There has been no crash (the statement at the <code>except</code> is not executed) just nothing. The program hangs because the WaitFor does not return. With debug DCU's I can trace this back to the <code>WaitFor</code> in unit <code>Classes</code> where the program hangs at <code>WaitForSingleObject(H[0], INFINITE);</code>. The <code>OnWork</code> callback is the same. </p>
  
  <p>The OnBeforeWork and OnAfterWork procedures are nil. <code>MaxLoops = -1</code> and <code>FreeOnTerminate = False</code>. I am quite desperate, hope that somebody has a way out. </p>
  
  <p><strong>EDIT 1:</strong> The <code>WaitFor</code> I am talking about occurs in class <code>TEvent_Driven_Task</code> listed below. Because this class is derived from class <code>TSimple_Task</code> I have added this class for completeness.</p>
  
  <p><strong>EDIT 2:</strong> <code>Application.ProcessMessages</code> has been removed from <code>TSimple_Task.Stop</code> as Marjan Venema remarked that this might cause a problem. The outcomes are identical (the program hangs in the <code>WaitFor</code>).</p>
  
  <pre><code>unit Parallel_Event_Task;
  
  interface
  
  uses Forms, Windows, Classes, SysUtils, SyncObjs,
       Parallel_Simple_Task;
  
  type
     TEvent_Driven_Task = class (TSimple_Task)
     private
        FWorkEvent: TEvent; // Event signalling that some work should be done
  
     public
        constructor Create (work: TNotifyEvent; CreateSuspended: boolean = False;
                       max: Int32 = 1;
                       before: TNotifyEvent = nil; after: TNotifyEvent = nil;
                       terminate: boolean = True; task: integer = 1); override;
        destructor Destroy; override;
        procedure Activate (work: TNotifyEvent = nil);
        procedure Execute; override;
        procedure Stop; override;
        procedure Release; override;
     end; // Class: TEvent_Driven_Task //
  
  implementation
  
  constructor TEvent_Driven_Task.Create
  (
     work: TNotifyEvent;        // Work to do in Execute loop
     CreateSuspended: boolean = False; // False = start now, True = use Start
     max: Int32 = 1;            // Max loops of Execute loop, negative = infinite loop
     before: TNotifyEvent = nil;// Called before Execute loop
     after: TNotifyEvent = nil; // Called after Execute loop
     terminate: boolean = True; // When true free the task on termination
     task: integer = 1          // Task ID
  );
  begin
     inherited Create (work, CreateSuspended, max, before, after, terminate, task);
  
     FWorkEvent := TEvent.Create (nil, False,  False, '');
  end; // Create //
  
  Destructor TEvent_Driven_Task.Destroy;
  begin
     inherited Destroy;
  end; // Destroy //
  
  procedure TEvent_Driven_Task.Activate (work: TNotifyEvent = nil);
  begin
     if Assigned (work) then OnWork := work;
     FWorkEvent.SetEvent;
  end; // Activate //
  
  // Execute calls event handler OnWork in a while loop.
  // Before the loop is entered, OnBeforeWork is executed, after: OnAfterWork.
  procedure TEvent_Driven_Task.Execute;
  var two: TWOHandleArray;
      pwo: PWOHandleArray;
      ret: DWORD;
  begin
     pwo := @two;
     pwo [0] := FWorkEvent.Handle;
     pwo [1] := FStopEvent.Handle;
     NameThreadForDebugging (AnsiString (FTaskName));
     FLoop := 0;
     try
        if Assigned (OnBeforeWork) then OnBeforeWork (Self);
        while (not Terminated) and (Loop &lt;&gt; Max_Loops) do
        begin
           FLoop := FLoop + 1;
           ret := WaitForMultipleObjects (2, pwo, FALSE, INFINITE);
           if ret = WAIT_FAILED then Break;
           case ret of
              WAIT_OBJECT_0 + 0: if Assigned (OnWork) then OnWork (Self);
              WAIT_OBJECT_0 + 1: Terminate;
           end; // case
        end; // while
        if Assigned (OnAfterWork) then OnAfterWork (Self);
  
  // Intercept and ignore the interruption but keep the message
     except
        on e: exception do FError_Mess := e.Message;
     end; // try..except
  end; // Execute //
  
  procedure TEvent_Driven_Task.Stop;
  begin
     Terminate;
     FStopEvent.SetEvent;
     if not FreeOnTerminate
        then WaitFor;
  end; // Stop //
  
  procedure TEvent_Driven_Task.Release;
  begin
     inherited Release;
  
     FWorkEvent.Free;
  end; // Release //
  
  end. // Unit: Parallel_Simple_Task //
  </code></pre>
  
  <p>============= Base class =======================</p>
  
  <pre><code>unit Parallel_Simple_Task;
  
  interface
  
  uses Windows, Classes, SysUtils, SyncObjs, Forms;
  
  type
     TSimple_Task = class (TThread)
     protected
        FStopEvent: TEvent;           // Event signalling that the thread has to terminate, set by Stop
        FTaskID: integer;             // Task sequence number
        FTaskName: string;            // Task name
        FLoop: integer;               // Indicates number of times Work has been processed
        FMax_Loops: integer;          // Maximum # of iterations
        FError_Mess: string;          // Error message if an exception occurred, else empty
        FOnBeforeWork:  TNotifyEvent; // Event to be called just before thread loop is entered
        FOnWork:        TNotifyEvent; // Event caled in Execute loop
        FOnAfterWork:   TNotifyEvent; // Event to be called just after thread loop is finished
  
        procedure set_name (value: string);
  
     public
        constructor Create (work: TNotifyEvent; CreateSuspended: boolean = False; max: Int32 = 1;
                       before: TNotifyEvent = nil; after: TNotifyEvent = nil;
                       terminate: boolean = True; task: integer = 1); reintroduce; virtual;
        destructor Destroy; override;
        procedure Execute; override;
        procedure Stop; virtual;
        procedure Release; virtual;
  
        property TaskID: integer read FTaskID;
        property TaskName: string read FTaskName write set_name;
        property Loop: integer read FLoop;
        property Max_Loops: integer read FMax_Loops write FMax_Loops;
        property OnBeforeWork:  TNotifyEvent read FOnBeforeWork  write FOnBeforeWork;
        property OnWork:        TNotifyEvent read FOnWork        write FOnWork;
        property OnAfterWork:   TNotifyEvent read FOnAfterWork   write FOnAfterWork;
     end; // Class: TSimple_Task //
  
  implementation
  
  constructor TSimple_Task.Create
  (
     work: TNotifyEvent;        // Work to do in Execute loop
     CreateSuspended: boolean = False; // False = start now, True = use Start
     max: Int32 = 1;            // Max loops of Execute loop
     before: TNotifyEvent = nil;// Called before Execute loop
     after: TNotifyEvent = nil; // Called after Execute loop
     terminate: boolean = True; // When true free the task on termination
     task: integer = 1          // Task ID
  );
  begin
  // The thread will only be started when this constructor ends.
     inherited Create (CreateSuspended);
  
     FStopEvent        := TEvent.Create (nil, True,  False, '');
     FError_Mess       := '';
     FTaskID           := task;
     FTaskName         := '';
     Max_Loops         := max;
     OnBeforeWork      := before;
     OnWork            := work;
     OnAfterWork       := after;
     FreeOnTerminate   := terminate;
  end; // Create //
  
  destructor TSimple_Task.Destroy;
  begin
     Stop;
     Release;
  
     inherited Destroy;
  end; // Destroy //
  
  // Execute calls event handler OnWork in a while loop.
  // Before the loop is entered, OnBeforeWork is executed, after: OnAfterWork.
  procedure TSimple_Task.Execute;
  var ret: DWORD;
  begin
     try
        NameThreadForDebugging (AnsiString (FTaskName));
  
        FLoop := 0;
        if Assigned (OnBeforeWork) then OnBeforeWork (Self);
        while (not Terminated) and (FLoop &lt;&gt; Max_Loops) do
        begin
           ret := WaitForSingleObject (FStopEvent.Handle, 0);
           if ret = WAIT_OBJECT_0 then
           begin
              Terminate;
           end else
           begin
              if Assigned (OnWork) then OnWork (Self);
              FLoop := FLoop + 1;
           end; // if
        end; // while
        if not Terminated and Assigned (OnAfterWork) then OnAfterWork (Self);
  // Intercept and ignore the interruption but keep the message
     except
        on e: exception do FError_Mess := e.Message;
     end; // try..except
  end; // Execute //
  
  procedure TSimple_Task.Stop;
  begin
     Terminate;
     FStopEvent.SetEvent;
     if not FreeOnTerminate
        then WaitFor;
  end; // Stop //
  
  procedure TSimple_Task.Release;
  begin
     FStopEvent.Free;
  end; // Release //
  
  procedure TSimple_Task.set_name (value: string);
  begin
     FTaskName := value;
  end; // set_name //
  
  end. // Unit: Parallel_Simple_Task //
  </code></pre>