How to stop a running TTask thread-safe?

user_3384674 0
Viewed 8071

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?

wait parallel-processing thread-safety delphi multithreading
3 Answers

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;
user_4212990

Building on @pyscripters answer I tried to encapsulate the functionality in a class and call the functions of this class from the UI.

  • Starting a task works
  • Stopping+starting a task while another is running works
  • Closing the form while a task is running works

The final hint was to add CheckSynchronize to the Shutdown method.

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.

The calls from the UI look like this:

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;
user_40788420
Related