multithreading - 为什么线程有时卡在waitfor中？

Question

在我的应用程序中，我使用基于线程的任务。它们工作正常，但有时会挂起该应用程序。在下面的代码中，procedure Stop有时会卡在WaitFor过程中。这是因为FStopEvent.SetEvent并不总是起作用。

在正常执行期间，线程进入Execute过程，执行OnWork过程，直到Stop被调用(这将设置Terminated)，然后进行一些后处理然后退出。这是WaitFor退出的信号，每个人都很高兴。在我的用法中，这是因为任务已销毁。在这种情况下，将调用基类的析构函数，该析构函数将调用Stop。

在某些情况下，这不起作用。正确输入了Execute，可以正常执行OnWork过程调用，但对FStopEvent.SetEvent没有任何 react 。没有崩溃(只是不执行except处的语句)。该程序挂起，因为WaitFor不返回。使用调试DCU，我可以将其追溯到WaitFor单元中的Classes，其中程序卡在WaitForSingleObject(H[0], INFINITE);上。 OnWork回调是相同的。

OnBeforeWork和OnAfterWork过程为零。 MaxLoops = -1和FreeOnTerminate = False。我很拼命，希望有人可以出路。

编辑1:我正在谈论的WaitFor出现在下面列出的TEvent_Driven_Task类中。因为该类是从TSimple_Task类派生的，所以我添加了此类是出于完整性的考虑。

编辑2:由于janjan Venema指出这可能会引起问题，因此已从Application.ProcessMessages中删除了 TSimple_Task.Stop。结果是相同的(程序卡在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 //

=============基础类别=======================

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

Answer 1

当底层线程对象在OS层终止时，TThread.WaitFor()等待信号通知线程句柄(TThread.Handle属性)。当TThread方法退出后(以及ExitThread()被调用并退出后)，当Execute()自身调用Win32 API TThread.DoTerminate()函数时，就会发生该信号。您所描述的内容听起来像是遇到了一个死锁，即使您已发出信号Execute()停止了循环，该死锁仍使FStopEvent方法无法正确退出。给定您已显示的代码，这意味着WaitForMultipleObjects()返回了您不想要的错误代码，或者更有可能您的OnWork事件处理程序有时无法正确退出，因此Execute()随后可以自行退出。

到目前为止，您所展示的只是任务类本身的定义，但是您尚未展示它们在项目中的实际使用方式。请显示其余的任务逻辑，并不要让人们猜测问题可能出在哪里。

我建议的第一件事是，从析构函数中取出对Stop()的调用。它不属于那里。 永不销毁仍在运行的线程。始终先停止线程并等待其终止，然后再销毁它。 TThread本身具有运行时被销毁的足够多的问题，您无需对其进行添加。