Clever Geek Handbook

How do I stop a running TTask thread-safe?

In Delphi 10.1 Berlin, I would like to add the ability to stop the sensitive TParallel. & for the loop from my question How to make TParallel. & values โ€‹โ€‹in TList <T>? ...

The loop calculates the values โ€‹โ€‹and stores those values โ€‹โ€‹in TList. It runs on 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 design task should be stopped when

  • the calculation is restarted
  • user clicks cancel button

I added

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

at the beginning procedure TCalculationProject.CalculateList

and in procedure TCalculationProject.CancelButtonClicked

, which is called when the cancel button is pressed.

The cycle 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

It doesn't work when I restart the calculation. Then two calculation tasks are performed. I tried adding Task.Wait

after Task.Cancel

to wait for the task to complete before we start a new calculation, but without success.

What is the correct completely safe flow to implement such an undo / stop function?

+3


source to share


3 answers


The reason Wait

not working is deadlock. The call Synchronize

and Wait

effectively stops the execution of the task in progress.

If you change all calls Synchronize

to Queue

, you will avoid blocking. But the call Task.Cancel

in combination with Task.Wait

in the task being executed will throw an error EOperationCancelled

, so no luck there.



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



To fix this particular issue, you need to get notified when it Task

ended, either through completion, or canceled or stopped.

When the task starts, the user interface should block any attempt to start a new calculation until the first one is ready / canceled.

  • First, when the calculation task is running, disable the button that will start a new calculation.
  • Second, sync or queue the call to enable the button at the end of the task.

There is now a safe way to know when a task is completed / stopped or canceled. When doing so, remove the operator if Assigned(Task) then Task.Cancel

in the method CalculateList

.



If the method CalculateListItem

is taking a long time, consider checking the cancellation status flag regularly.



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 user interface:

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

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


In the comment, it looks like the user would like to trigger cancellation and new task in one operation without blocking.

To solve this problem, set the flag to true, cancel the task call. When the event is triggered TaskCompleted

, check the flag and, if set, start a new task. Use TThread.Queue()

from task to trigger an event TaskCompleted

.

0


source


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

The following works by using a different mechanism to signal the termination of threads (StopRunning). Note the use of LoopState.Break and LoopState.ShouldExit. Note also the use of a 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;
+1


source


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

  • Task launch works
  • Stop + start a task while it is running
  • Closing a form while a task is running

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


source






More articles:


All Articles