CODEWITHSUNDEEP
multithreadingdelphi
Arnold
Arnold

Reputation: 4840

why does a thread sometimes hang in waitfor?

In my application I use thread based tasks. They work fine but sometimes they hang the application. In the code below procedure Stop sometimes hangs in the WaitFor procedure. That is because the FStopEvent.SetEvent not always appears to function.

During a normal execution the thread enters the Execute procedure, executes the OnWork procedure until Stop is called (which sets Terminated), then does some postprocessing and then exits. That is the signal for WaitFor 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 Stop.

In some cases this does not work. Execute is entered correctly, the OnWork procedure calls are executed ok but there is no reaction on the FStopEvent.SetEvent. There has been no crash (the statement at the except 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 WaitFor in unit Classes where the program hangs at WaitForSingleObject(H[0], INFINITE);. The OnWork callback is the same.

The OnBeforeWork and OnAfterWork procedures are nil. MaxLoops = -1 and FreeOnTerminate = False. I am quite desperate, hope that somebody has a way out.

EDIT 1: The WaitFor I am talking about occurs in class TEvent_Driven_Task listed below. Because this class is derived from class TSimple_Task I have added this class for completeness.

EDIT 2: Application.ProcessMessages has been removed from TSimple_Task.Stop as Marjan Venema remarked that this might cause a problem. The outcomes are identical (the program hangs in the WaitFor).

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 <> 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 //

============= Base class =======================

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 <> 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 //

Upvotes: 1

Views: 3659

Answers (1)

Remy Lebeau
Remy Lebeau

Reputation: 595537

TThread.WaitFor() waits for the thread handle (the TThread.Handle property) to become signaled when the underlying thread object terminates at the OS layer. That signal happens when TThread calls the Win32 API ExitThread() function on itself after your Execute() method has exited (and after TThread.DoTerminate() has been called and exited). What you describe sounds like you are encountering a deadlock that is preventing your Execute() method from exiting correctly even though you may have signaled FStopEvent to stop your loop. Given the code you have shown, that means either WaitForMultipleObjects() is returning an error code you are not looking for, or more likely your OnWork event handler is not exiting correctly at times so Execute() can then exit itself.

All you have shown so far are the definitions of your task classes themselves, but you have not shown how they are actually being used in your project. Please show the rest of your task logic and stop making people guess what the problem might be.

The first thing I would suggest is take the call to Stop() out of your destructor. It does not belong there. NEVER destroy a thread that is still running. Always stop the thread first and wait for it to finish terminating before you then destroy it. TThread by itself has enough problems of its own being destroyed while running, you don't need to add to that.

Upvotes: 7

Related Questions