How to stop a running TTask thread-safe?

Question

In Delphi 10.1 Berlin I would like to add the possibility to stop the responsive TParallel.&For loop from my question How to make a TParallel.&For loop responsive and store values in a TList<T>? .

The loop calculates values and stores these values in a TList. It runs in a separate thread with TTask.Run to make it responsive:

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;

The current running calculation Task should be stopped when

1. the calculation is restarted
2. the user click on a cancel button

I added

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

at the beginning of procedure TCalculationProject.CalculateList and in procedure TCalculationProject.CancelButtonClicked which is called when the cancel button is clicked.

The loop is stopped with

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

and the list is cleared with

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

This does not work when I restart the calculation. Then two calculation tasks are running. I tried to add a Task.Wait after Task.Cancel to wait for the task to be finished before we start the new calculation but without success.

What is the correct fully thread-safe way to implement such a cancel/stop function?

Answer 1

The reason Wait does not work, is a dead-lock. The Synchronize call and Wait effectively stops a running task from finishing.

If you change all the Synchronize calls to Queue, you will avoid the dead-lock. But calling Task.Cancel in conjunction with Task.Wait on a running task will throw an EOperationCancelled error, so there is no luck going there.

---

Update: This was reported as a bug and is still not fixed in Delphi 10.2.3 Tokyo. https://quality.embarcadero.com/browse/RSP-11267

---

To solve this specific problem, you need to be notified when the Task has ended, either through completion, being canceled or stopped.

When a task is started, the UI should block any attempt to start a new calculation until the former is ready/canceled.

• First, when a calculation task is started, disable the button which starts a new calculation.
• Second, synchronize or queue a call to enable the button at the end of the task.

Now, there is a safe way to know when the task is completed/stopped or cancelled. With that in place, remove the if Assigned(Task) then Task.Cancel statement in the CalculateListmethod.

---

If the CalculateListItem method is time consuming, consider to regularly check the cancel status flag in there as well.

---

An example:

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;

---

And the UI call:

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

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

---

In a comment, it appears as the user would want to trigger a cancel and a new task in one operation without being blocked.

To solve that, set a flag to true, call cancel on the task. When the TaskCompleted event is called, check the flag and if set, start a new task. Use TThread.Queue() from the task to trigger the TaskCompleted event.

Answer 2

Cancel is broken in System.Threading. See https://quality.embarcadero.com/browse/RSP-11267

The following works by using another mechanism for signalling to the threads to stop (StopRunning). Notice the use of LoopState.Break and LoopState.ShouldExit. Notice also the use of Queue instead of Synchronize. This allows us to wait for the task on the main thread without blocking.

To use the code you need a form with a ListBox1 and two buttons btnStart and 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;