关于多线程:如何停止正在运行的 TTask 线程安全? | 珊瑚贝

How to stop a running TTask thread-safe?


在 Delphi 10.1 Berlin 中,我想添加停止响应式 TParallel 的可能性。


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

如果您将所有 Synchronize 调用更改为 Queue,您将避免死锁。但是在一个正在运行的任务上同时调用 Task.Cancel 和 Task.Wait 会抛出一个 EOperationCancelled 错误,所以那里没有运气。

更新:这被报告为一个错误,在 Delphi 10.2.3 Tokyo 中仍未修复。 https://quality.embarcadero.com/browse/RSP-11267

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

当一项任务开始时,UI 应该阻止任何开始新计算的尝试,直到前者准备好/取消。

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

现在,有一种安全的方法可以知道任务何时完成/停止或取消。
完成后,删除 CalculateList 方法中的 if Assigned(Task) then Task.Cancel 语句。

如果 CalculateListItem 方法很耗时,请考虑定期检查其中的取消状态标志。

一个例子:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
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, 10001,
          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 调用:

1
2
3
4
5
6
7
8
9
10
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 事件。

  • 谢谢你的建议。然而,这不是我需要的。
  • 将有几种不同的场景如何开始计算。例如。计算链接到轨迹栏:当用户更改轨迹栏的值时,计算开始。我必须补充一点,在此处显示的”长”计算之前有一个”快速”计算。所以:用户更改轨迹栏 -> 在主线程中进行”快速”计算并显示结果 -> 在后台线程中开始”长”计算 -> 显示结果,除非用户在”长”计算结束之前再次更改轨迹栏 -在这种情况下,停止计算并使用新的轨迹栏值重新开始。
  • 好吧,这不是我们所要求的。无论如何,这仍然是如何以最佳方式处理 GUI。如果长计算尚未准备好,请在收到计算就绪通知时设置一个标志以开始新的计算(最好使用队列变体从任务线程发送通知)。
  • 让我们暂时忘记 UI。我想正确理解多线程。取消计算后,我如何知道一切何时完成(请参阅我的问题的最后一段:”我试图在 Task.Cancel 之后添加一个 Task.Wait 以等待任务完成,然后再开始新的计算,但没有成功。”)
  • 正如我在回答中所说,使用同步或队列发送消息。 PPL 很脆弱,文档记录很差。显然取消/等待在您的实施中不起作用。如果您愿意,可以调用 Task.Status。如果状态已完成,您可以开始新任务。如果它被取消,我无法从文档中看到这意味着什么(如果设置了标志或任务已完成并且所有取消操作都已完成),但您仍然必须处理它并可能在另一个时间启动任务。这就是为什么我建议按照我建议的方式进行操作。
  • @user3384674,我的最新编辑应该照顾您的不同场景,并解释多线程问题。 TTask 在任务结束时不提供事件,等待不是选项,因为这将导致死锁或异常。
  • 您提到 PPL 很脆弱。使用 TThread 而不是 TTask 的实现会更好吗?
  • 在过去几年中,大多数 PPL 错误都得到了解决。如果它适合你,很好。多年来,大多数人一直在使用 OmniThreadLibrary 框架来完成类似的任务。它有一个学习曲线,但有很好的例子记录。如果您喜欢学习并愿意尝试,可以尝试。当然,使用普通的 TThread 也是可行的,但很难说什么更好。
  • 非常好的解决方案。我设法让它启动并运行。可以启动、取消和”停止启动”任务。然而,当应用程序在任务完成之前终止时,此示例可靠地崩溃。我还没有找到解决这个问题的方法。
  • @LübbeOnken,此处的示例假定在销毁类时任务已完成/取消。您必须通过在任务完成/取消通知之前阻止应用程序/表单关闭来管理它。


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

以下工作通过使用另一种机制来通知线程停止 (StopRunning)。注意 LoopState.Break 和 LoopState.ShouldExit 的使用。还要注意使用队列而不是同步。这允许我们在主线程上等待任务而不会阻塞。

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
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, 10001,
          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;


在@pyscripters 回答的基础上,我尝试将功能封装在一个类中,并从 UI 调用该类的功能。

  • 启动任务有效
  • 在另一个正在运行的任务中停止启动一个任务
  • 在任务运行时关闭表单有效

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
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 的调用如下所示:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
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;


  • 我这里没有 AV,但尝试添加对 CheckSynchronize 的调用到 FormDestroy:procedure TForm1.FormDestroy(Sender: TObject);开始 FCalc2.Shutdown;检查同步; FCalc2.免费;结尾;
  • 就目前而言,问题可能是由于 TThread.Queue 在 TCalc2.Free 之后调用了 DoNotify。
  • 谢谢你,@PyScripter。 CheckSynchronize 可以解决问题。退出时不再崩溃。我已经更新了我的帖子和上面的代码示例,以便它可以工作。


来源:https://www.codenong.com/44080089/

微信公众号
手机浏览(小程序)
0
分享到:
没有账号? 忘记密码?