multithreading - 使用 Delphi XE7 并行库

Question

我有一个耗时的例程，我想使用 Delphi XE7 的新并行库并行处理它。

这是单线程版本:

procedure TTerritoryList.SetUpdating(const Value: boolean);
var
  i, n: Integer;
begin
  if (fUpdating <> Value) or not Value then
  begin
    fUpdating := Value;

    for i := 0 to Count - 1 do
    begin
      Territory[i].Updating := Value; // <<<<<< Time consuming routine
      if assigned(fOnCreateShapesProgress) then
        fOnCreateShapesProgress(Self, 'Reconfiguring ' + Territory[i].Name, i / (Count - 1));
    end;
  end;
end;

实际上没有什么复杂的事情发生。如果区域列表变量更改或设置为 false，则例程将循环所有销售区域并重新创建区域边界(这是一项耗时的任务)。

所以这是我使其并行的尝试:

procedure TTerritoryList.SetUpdating(const Value: boolean);
var
  i, n: Integer;
begin
  if (fUpdating <> Value) or not Value then
  begin
    fUpdating := Value;

    n := Count;
    i := 0;

    TParallel.For(0, Count - 1,
      procedure(Index: integer)
      begin
        Territory[Index].Updating := fUpdating; // <<<<<< Time consuming routine
        TInterlocked.Increment(i);
        TThread.Queue(TThread.CurrentThread,
          procedure
            begin
              if assigned(fOnCreateShapesProgress) then
                fOnCreateShapesProgress(nil, 'Reconfiguring ', i / n);
            end);
      end
    );
  end;
end;

我用并行 for 循环替换了 for 循环。计数器“i”在递增以显示进度时被锁定。然后，我将 OnCreateShapeProgress 事件包装在 TThread.Queue 中，该事件将由主线程处理。 OnCreateShapeProgress 事件由更新进度条和描述任务的标签的例程处理。

如果我排除对 OnCreateShapeProgress 事件的调用，则该例程有效。它因 EAurgumentOutOfRange 错误而崩溃。

所以我的问题很简单:

我做了什么蠢事吗？

如何从 TParallel.For 循环或 TTask 中调用事件处理程序？

Answer 1

我看到的最明显的问题是您排队到工作线程。

您对TThread.Queue的调用会传递TThread.CurrentThread。这就是您正在调用 TThread.Queue 的线程。我认为可以肯定地说，您永远不应该将 TThread.CurrentThread 传递给 TThread.Queue。

相反，请删除该参数。使用仅接受线程过程的单参数重载。

否则我会注意到进度计数器i的递增并没有真正正确处理。嗯，递增很好，但是你稍后再读它，那就是一场竞赛。如果线程 1 在线程 2 之前递增，但线程 2 在线程 1 之前对进度进行排队，则您可能会乱序报告进度。通过将计数器递增代码移动到主线程来解决该问题。只需在排队的匿名方法内增加它即可。额外的好处是您不再需要使用原子增量，因为所有修改都在主线程上。

除此之外，这份质量控制报告似乎与您报告的内容非常相似:http://qc.embarcadero.com/wc/qcmain.aspx?d=128392

最后，AtomicIncrement 是在最新版本的 Delphi 中执行无锁增量的惯用方法。