如何停止一个运行线程安全的TTask？

Question

在 Delphi 10.1 Berlin 我想添加停止响应式 TParallel.&For 循环的可能性来自我的问题。

循环计算值并将这些值存储在 TList 中。它在一个单独的线程中运行 TTask.Run 以使其响应：

type
  TCalculationProject=class(TObject)
  private
    Task: ITask;
    ...
  public
    List: TList<Real>;
    ...
  end;

procedure TCalculationProject.CancelButtonClicked;
begin
  if Assigned(Task) then
  begin
    Task.Cancel;
  end;
end;

function TCalculationProject.CalculateListItem(const AIndex: Integer): Real;
begin
  //a function which takes a lot of calculation time
  //however in this example we simulate the calculation time and
  //use a simple alogorithm to verify the list afterwards
  Sleep(30);
  Result:=10*AIndex;
end;

procedure TCalculationProject.CalculateList;
begin
  List.Clear;

  if Assigned(Task) then
  begin
    Task.Cancel;
  end;

  Task:=TTask.Run(
    procedure
    var
      LoopResult: TParallel.TLoopResult;
      Lock: TCriticalSection;
    begin
      Lock:=TCriticalSection.Create;
      try
        LoopResult:=TParallel.&For(0, 1000-1,
          procedure(AIndex: Integer; LoopState: TParallel.TLoopState)
          var
            Res: Real;
          begin

            if (Task.Status=TTaskStatus.Canceled) and not(LoopState.Stopped) then
            begin
              LoopState.Stop;
            end;
            if LoopState.Stopped then
            begin
              Exit;
            end;

            Res:=CalculateListItem(AIndex);
            Lock.Enter;
            try
              List.Add(Res);
            finally
              Lock.Leave;
            end;
          end
        );
      finally
        Lock.Free;
      end;

      if (Task.Status=TTaskStatus.Canceled) then
      begin
        TThread.Synchronize(TThread.Current,
          procedure
          begin
            List.Clear;
          end
        );
      end
      else
      begin
        if LoopResult.Completed then
        begin
          TThread.Synchronize(TThread.Current,
            procedure
            begin
              SortList;
              ShowList;
            end
          );
        end;
      end;
    end
  );
end;

当前运行计算任务应该在

时停止

计算重新开始
用户点击取消按钮

我加了

if Assigned(Task) then
begin
  Task.Cancel;
end;

在 procedure TCalculationProject.CalculateList 的开头和在单击取消按钮时调用的 procedure TCalculationProject.CancelButtonClicked 中。

循环停止

if (Task.Status=TTaskStatus.Canceled) and not(LoopState.Stopped) then
begin
  LoopState.Stop;
end;
if LoopState.Stopped then
begin
  Exit;
end;

并使用

清除列表

if (Task.Status=TTaskStatus.Canceled) then
begin
  TThread.Synchronize(TThread.Current,
    procedure
    begin
      List.Clear;
    end
  );
end

当我重新开始计算时，这不起作用。那么两个计算任务就是运行。我试图在 Task.Cancel 之后添加一个 Task.Wait 以等待任务完成，然后再开始新的计算，但没有成功。

实现这样一个 cancel/stop 函数的完全线程安全的正确方法是什么？

Answer 1

原因Wait不起作用，是一个死锁。 Synchronize 调用和 Wait 有效地阻止了运行任务的完成。

如果将所有 Synchronize 调用更改为 Queue，您将避免死锁。但是在运行任务上调用 Task.Cancel 和 Task.Wait 会抛出 EOperationCancelled 错误，所以运气不好。

更新： 这是一个错误，在 Delphi 10.2.3 Tokyo 中仍未修复。 https://quality.embarcadero.com/browse/RSP-11267

要解决此特定问题，您需要在 Task 结束时收到通知，无论是完成、取消还是停止。

当任务开始时，UI 应该阻止任何开始新计算的尝试，直到前者 ready/canceled。

首先，当计算任务开始时，禁用开始新计算的按钮。
其次，同步或排队调用以在任务结束时启用按钮。

现在，有一种安全的方法可以知道任务何时 completed/stopped 或已取消。就绪后，删除 CalculateList 方法中的 if Assigned(Task) then Task.Cancel 语句。

如果CalculateListItem方法比较耗时，可以考虑定期检查那里的取消状态标志。

一个例子：

type
  TCalculationProject = class(TObject)
  private
    Task: ITask;
  public
    List: TList<Real>;
    procedure CancelButtonClicked;
    function CalculateListItem(const AIndex: Integer): Real;
    procedure CalculateList(NotifyCompleted: TNotifyEvent);
    Destructor Destroy; Override;    
  end;

procedure TCalculationProject.CancelButtonClicked;
begin
  if Assigned(Task) then
  begin
    Task.Cancel;
  end;
end;

destructor TCalculationProject.Destroy;
begin
   List.Free;
  inherited;
end;

function TCalculationProject.CalculateListItem(const AIndex: Integer): Real;
begin
  //a function which takes a lot of calculation time
  //however in this example we simulate the calculation time and
  //use a simple alogorithm to verify the list afterwards
  Sleep(30);
  Result:=10*AIndex;
end;

procedure TCalculationProject.CalculateList(NotifyCompleted: TNotifyEvent);
begin
  if not Assigned(List) then
    List := TList<Real>.Create;

  List.Clear;

  Task:= TTask.Run(
    procedure
    var
      LoopResult : TParallel.TLoopResult;
      Lock : TCriticalSection;
    begin
      Lock:= TCriticalSection.Create;
      try
        LoopResult:= TParallel.&For(0, 1000-1,
          procedure(AIndex: Integer; LoopState: TParallel.TLoopState)
          var
            Res: Real;
          begin
            if (Task.Status=TTaskStatus.Canceled) and not(LoopState.Stopped) then
            begin
              LoopState.Stop;
            end;
            if LoopState.Stopped then
            begin
              Exit;
            end;

            Res:= CalculateListItem(AIndex);
            Lock.Enter;
            try
              List.Add(Res);
            finally
              Lock.Leave;
            end;
          end);
      finally
        Lock.Free;
      end;

      if (Task.Status = TTaskStatus.Canceled) then
        TThread.Synchronize(TThread.Current,
          procedure
          begin
            List.Clear;
          end)
      else
      if LoopResult.Completed then
        TThread.Synchronize(TThread.Current,
         procedure
         begin
           SortList;
           ShowList;
         end);
      // Notify the main thread that the task is ended
      TThread.Synchronize(nil,  // Or TThread.Queue
        procedure
        begin
          NotifyCompleted(Self);
        end);
    end
  );
end;

并且 UI 调用：

procedure TMyForm.StartCalcClick(Sender: TObject);
begin
  StartCalc.Enabled := false;
  CalcObj.CalculateList(TaskCompleted);
end;

procedure TMyForm.TaskCompleted(Sender: TObject);
begin
  StartCalc.Enabled := true;
end;

在评论中，它显示为用户希望在一个操作中触发取消和新任务而不被阻止。

要解决这个问题，请将标志设置为真，对任务调用取消。当调用 TaskCompleted 事件时，检查标志，如果设置，则启动一个新任务。使用任务中的 TThread.Queue() 来触发 TaskCompleted 事件。

Answer 2

取消在 System.Threading 中被破坏。参见 https://quality.embarcadero.com/browse/RSP-11267

以下工作通过使用另一种机制向线程发送停止信号 (StopRunning)。注意 LoopState.Break 和 LoopState.ShouldExit 的使用。还要注意使用 Queue 而不是 Synchronize。这样我们就可以在主线程上等待任务而不会阻塞。

要使用代码，您需要一个带有 ListBox1 和两个按钮 btnStart 和 btnCancel 的表单。

type
  TForm1 = class(TForm)
    btnStart: TButton;
    btnCancel: TButton;
    ListBox1: TListBox;
    procedure btnStartClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
  private
    { Private declarations }
  private
    Task: ITask;
  public
    { Public declarations }
    List: TList<Double>;
    StopRunning : Boolean;
    function CalculateListItem(const AIndex: Integer): Real;
    procedure CalculateList;
    procedure ShowList;
  end;

var
  Form1: TForm1;

implementation

uses
  System.SyncObjs;

{$R *.dfm}

function TForm1.CalculateListItem(const AIndex: Integer): Real;
begin
  //a function which takes a lot of calculation time
  //however in this example we simulate the calculation time and
  //use a simple alogorithm to verify the list afterwards
  Sleep(30);
  Result:=10*AIndex;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  List := TList<Double>.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  List.Free;
end;

procedure TForm1.ShowList;
Var
  R : Double;
begin
  for R in List do
    ListBox1.Items.Add(R.ToString);
end;

procedure TForm1.CalculateList;
Var
  R : Real;
begin
  List.Clear;

  if Assigned(Task) then
  begin
    Task.Cancel;
  end;

  StopRunning := False;
  Task:=TTask.Run(
    procedure
    var
      LoopResult: TParallel.TLoopResult;
      Lock: TCriticalSection;
    begin
      Lock:=TCriticalSection.Create;
      try
        LoopResult:=TParallel.For(0, 1000-1,
          procedure(AIndex: Integer; LoopState: TParallel.TLoopState)
          var
            Res: Double;
          begin

            if StopRunning then begin
              LoopState.Break;
              Exit;
            end;

            if LoopState.ShouldExit then
              Exit;

            Res:=CalculateListItem(AIndex);
            Lock.Enter;
            try
              List.Add(Res);
            finally
              Lock.Leave;
            end;
          end
        );
      finally
        Lock.Free;
      end;

    if LoopResult.Completed then
        TThread.Queue(TThread.Current,
          procedure
          begin
            List.Sort;
            ShowList;
          end
        )
    else
      TThread.Queue(TThread.Current,
        procedure
        begin
          List.Clear;
          ListBox1.Items.Add('Cancelled')
        end
      );
  end
  );
end;

procedure TForm1.btnCancelClick(Sender: TObject);
begin
  StopRunning := True;
  Task.Wait;
end;

procedure TForm1.btnStartClick(Sender: TObject);
begin
  ListBox1.Clear;
  CalculateList;
end;

Answer 3

基于@pyscripters 的回答，我尝试将功能封装在 class 中，并从 UI.

中调用此 class 的功能

开始任务有效
停止+启动一个任务，而另一个是运行有效
在任务进行时关闭表单运行有效

最后的提示是将 CheckSynchronize 添加到 Shutdown 方法。

unit uCalculation2;

interface

uses
  System.Classes,
  System.Generics.Collections,
  System.Threading;

type
  TNotifyTaskEvent = procedure(Sender: TObject; AMessage: string) of object;

  TCalc2 = class
  private
    FTask             : ITask;
    FOnNotifyTaskEvent: TNotifyTaskEvent;
    FCancelTask       : Boolean;

    function CalculateListItem(const AIndex: Integer): Real;
    procedure CalculateList;
    procedure DoNotify(AMessage: string);

  public
    List: TList<Double>;

    constructor Create;
    destructor Destroy; override;

    procedure Start;
    procedure Stop;

    property OnNotifyTaskEvent: TNotifyTaskEvent read FOnNotifyTaskEvent write FOnNotifyTaskEvent;
  end;

implementation

uses
  System.SysUtils,
  System.SyncObjs;

constructor TCalc2.Create;
begin
  List := TList<Double>.Create;
end;

destructor TCalc2.Destroy;
begin
  FOnNotifyTaskEvent := Nil;
  Stop;
  CheckSynchronize;

  FTask := Nil;
  List.Free;

  inherited;
end;

procedure TCalc2.DoNotify(AMessage: string);
begin
  if Assigned(FOnNotifyTaskEvent) then
    begin
      if Assigned(FTask) then
        AMessage := Format('%4d: %-40s Entries=%3d', [FTask.Id, AMessage, List.Count])
      else
        AMessage := Format('%4d: %-40s Entries=%3d', [0, AMessage, List.Count]);
      FOnNotifyTaskEvent(Self, AMessage);
    end;
end;

function TCalc2.CalculateListItem(const AIndex: Integer): Real;
begin
  //a function which takes a lot of calculation time
  //however in this example we simulate the calculation time and
  //use a simple alogorithm to verify the list afterwards
  Sleep(30);
  Result := 10 * AIndex;
end;

procedure TCalc2.CalculateList;
begin
  List.Clear;

  if Assigned(FTask) then
    begin
      FTask.Cancel;
    end;

  FCancelTask := False;

  FTask := TTask.Run(
    procedure
    var
      LoopResult: TParallel.TLoopResult;
      Lock: TCriticalSection;
    begin
//      TThread.Queue(TThread.Current,
//        procedure
//        begin
//          DoNotify('Started');
//        end
//        );

      Lock := TCriticalSection.Create;
      try
        LoopResult := TParallel.For(0, 500 - 1,
          procedure(AIndex: Integer; LoopState: TParallel.TLoopState)
          var
            Res: Double;
          begin

            if FCancelTask then
              begin
                LoopState.Break;
                Exit;
              end;

            if LoopState.ShouldExit then
              Exit;

            Res := CalculateListItem(AIndex);
            Lock.Enter;
            try
              List.Add(Res);
            finally
              Lock.Leave;
            end;
          end
          );
      finally
        Lock.Free;
      end;

      if LoopResult.Completed then
        TThread.Queue(TThread.Current,
          procedure
          begin
            DoNotify('Completed');
          end
          )
      else
        TThread.Queue(TThread.Current,
          procedure
          begin
            DoNotify('Canceled');
          end
          );
    end
    );
end;

procedure TCalc2.Start;
begin
  CalculateList;
end;

procedure TCalc2.Stop;
begin
  FCancelTask := True;
  if Assigned(FTask) then
    FTask.Wait;
end;

end.

来自 UI 的调用如下所示：

procedure TForm5.FormCreate(Sender: TObject);
begin
  FCalc2 := TCalc2.Create;
  FCalc2.OnNotifyTaskEvent := CalcCompleted;
end;

procedure TForm5.FormDestroy(Sender: TObject);
begin
  FCalc2.Free;
end;

procedure TForm5.btnCalcCancelClick(Sender: TObject);
begin
  FCalc2.Stop;
end;

procedure TForm5.btnCalcRunClick(Sender: TObject);
begin
  CalcRun;
end;

procedure TForm5.btnRunAnotherClick(Sender: TObject);
begin
  CalcRun;
end;

procedure TForm5.CalcCompleted(Sender: TObject; Status: string);
begin
  memStatus.Lines.Add(Status);
  btnCalcRun.Enabled := true;
end;

procedure TForm5.CalcRun;
begin
  btnCalcRun.Enabled := false;
  memStatus.Lines.Add('Started');
  FCalc2.Stop;
  FCalc2.Start;
end;

如何停止一个运行线程安全的TTask？

How to stop a running TTask thread-safe?

delphi

parallel-processing

multithreading

thread-safety

wait