Multithreading 如何修复TSparseArray<；T>；？

由于

System.Generics.Collections.TArray.Copy

（取决于）存在未修复的错误，因此有时会使用线程库引发异常

在方法

System.Threading.TSparseArray.Add

中引发异常：

function TSparseArray<T>.Add(const Item: T): Integer;
var
  I: Integer;
  LArray, NewArray: TArray<T>;
begin
  ...
          TArray.Copy<T>(LArray, NewArray, I + 1); // <- Exception here
  ...
end;

工作起来很有魅力。但在那之后，我想知道为什么需要阵列拷贝：

LArray := FArray; // copy array reference from field
...
SetLength(NewArray, Length(LArray) * 2);
TArray.Copy<T>(LArray, NewArray, I + 1);
NewArray[I + 1] := Item;
Exit(I + 1);

替换

TArray.Copy

并保存

NewArray

SetLength(NewArray, Length(LArray) * 2);
// TArray.Copy<T>(LArray, NewArray, I + 1); // <- Exception here
for LIdx := Low( LArray ) to High( LArray ) do
  NewArray[LIdx] := LArray[LIdx];
NewArray[I + 1] := Item;
FArray := NewArray;
Exit(I + 1);

---

这不是

System.CopyArray

中的错误。按设计，它只支持托管类型。这个bug实际上在

TArray.Copy

中。在调用

System.CopyArray

而不区分

T

是否为托管类型时，这是错误的

但是，来自XE7 update 1的最新版本的

TArray.Copy

，似乎没有遇到您描述的问题。代码如下所示：

class procedure TArray.Copy<T>(const Source, Destination: array of T; 
  SourceIndex, DestIndex, Count: NativeInt);
begin
  CheckArrays(Pointer(@Source[0]), Pointer(@Destination[0]), SourceIndex, 
    Length(Source), DestIndex, Length(Destination), Count);
  if IsManagedType(T) then
    System.CopyArray(Pointer(@Destination[SourceIndex]), 
      Pointer(@Source[SourceIndex]), TypeInfo(T), Count)
  else
    System.Move(Pointer(@Destination[SourceIndex])^, Pointer(@Source[SourceIndex])^, 
      Count * SizeOf(T));
end;

function TSparseArray<T>.Add(const Item: T): Integer;
var
  I: Integer;
  LArray, NewArray: TArray<T>;
begin
  while True do
  begin
    LArray := FArray;
    TMonitor.Enter(FLock);
    try
      for I := 0 to Length(LArray) - 1 do
      begin
        if LArray[I] = nil then
        begin
          FArray[I] := Item;
          Exit(I);
        end else if I = Length(LArray) - 1 then
        begin
          if LArray <> FArray then
            Continue;
          SetLength(NewArray, Length(LArray) * 2);
          TArray.Copy<T>(LArray, NewArray, I + 1);
          NewArray[I + 1] := Item;
          Exit(I + 1);
        end;
      end;
    finally
      TMonitor.Exit(FLock);
    end;
  end;
end;

FArray初始化的唯一时间是在

TSparseArray

构造函数中。这意味着，如果数组已满，则会添加和丢失项。大概

I=Length（LArray）-1

是为了延长

FArray

的长度并捕获新项目。但是，还要注意，

TSparseArray

通过

Current

属性公开

FArray

。而且这种曝光不受锁的保护。因此，一旦

FArray

变满，我就看不出这个类如何以任何有用的方式工作

---

我建议您构建一个示例，在该示例中，

FArray

已满，并演示添加的项目已丢失。提交一份bug报告，说明这一点，并链接到此问题。

项目是否写入

TSparseArray

，这无关紧要，因为只有当一个工作线程已完成委托给他的所有任务，而另一个工作线程尚未完成时，才需要该报告。此时，空闲线程正在查看池中其他踏板的队列，并试图窃取一些工作

如果任何队列未进入该数组，则空闲线程看不到这些队列，因此无法共享工作负载

要解决此问题，我选择选项2

function TSparseArray<T>.Add(const Item: T): Integer;
...
SetLength(NewArray, Length(LArray) * 2);
TArray.Copy<T>(LArray, NewArray, I + 1); // <- No Exception here with XE7U1
NewArray[I + 1] := Item;
{$IFDEF USE_BUGFIX}
FArray := NewArray;
{$ENDIF}
Exit(I + 1);

还有一个bug需要修复。。。因为当使用

Task.WaitForAll

等待任务时，您现在等待的所有任务都是在内部执行的，但不会减少

fqueedRequestCount

解决这个问题

function TThreadPool.TryRemoveWorkItem(const WorkerData: IThreadPoolWorkItem): Boolean;
begin
  Result := (QueueThread <> nil) and (QueueThread.WorkQueue <> nil);
  if Result then
    Result := QueueThread.WorkQueue.LocalFindAndRemove(WorkerData);
  {$IFDEF USE_BUGFIX}
  if Result then
    DecWorkRequestCount;
  {$ENDIF}
end;

函数TThreadPool.TryRemoveWorkItem（const-WorkerData:IThreadPoolWorkItem）：布尔值；
开始
结果：=（QueueThread nil）和（QueueThread.WorkQueue nil）；
如果结果是这样的话
结果：=QueueThread.WorkQueue.LocalFindAndRemove（WorkerData）；
{$IFDEF USE_BUGFIX}
如果结果是这样的话
DecWorkRequestCount；
{$ENDIF}
结束；

现在它运行起来就像它应该立即运行一样

---

更新

作为Uwe的评论，我们还需要修复已修复的

System.Generics.Collections.TArray.Copy

SetLength(NewArray, Length(LArray) * 2);
// TArray.Copy<T>(LArray, NewArray, I + 1); // <- Exception here
for LIdx := Low( LArray ) to High( LArray ) do
  NewArray[LIdx] := LArray[LIdx];
NewArray[I + 1] := Item;
Exit(I + 1);

类过程TArray.Copy（const-Source，Destination:T的数组；SourceIndex，destinex，Count:nativent）；
{$IFDEF USE_BUGFIX}
开始
检查数组（指针（@Source[0]）、指针（@Destination[0]）、源索引、长度（Source）、目的索引、长度（destinex）、计数）；
如果是IsManagedType（T），则
System.CopyArray（指针（@Destination[destinex]）、指针（@Source[SourceIndex]）、类型信息（T）、计数）
其他的
移动（指针（@Source[SourceIndex]）^，指针（@destinex[DestIndex]）^，Count*SizeOf（T））；
结束；
{$ELSE}
开始
检查数组（指针（@Source[0]）、指针（@Destination[0]）、源索引、长度（Source）、目的索引、长度（destinex）、计数）；
如果是IsManagedType（T），则
System.CopyArray（指针（@Destination[SourceIndex]）、指针（@Source[SourceIndex]）、类型信息（T）、计数）
其他的
移动（指针（@Destination[SourceIndex]）^，指针（@Source[SourceIndex]）^，Count*SizeOf（T））；
结束；
{$ENDIF}

要测试的简单检查：

procedure TestArrayCopy;
var
  LArr1, LArr2: TArray<Integer>;
begin
  LArr1 := TArray<Integer>.Create( 10, 11, 12, 13 );
  LArr2 := TArray<Integer>.Create( 20, 21 );
  // copy the last 2 elements from LArr1 to LArr2
  TArray.Copy<Integer>( LArr1, LArr2, 2, 0, 2 );
end;

程序测试副本；
变量
LArr1，LArr2：焦油；
开始
LArr1:=TArray.Create（10,11,12,13）；
LArr2:=TArray.Create（20,21）；
//将最后2个元素从LArr1复制到LArr2
TArray.Copy（LArr1，LArr2，2，0，2）；
结束；

• 使用XE7，您将得到一个异常
• 使用XE7更新1，您将获得 LArr1 = ( 10, 11, 0, 0 ) LArr2 = ( 20, 21 ) LArr1=（10,11,0,0） LArr2=（20,21）
• 通过上面的修复，您将获得 LArr1 = ( 10, 11, 12, 13 ) LArr2 = ( 12, 13 ) LArr1=（10,11,12,13） LArr2=（12,13）

---

即使修复了

TArray.Copy（）

，我认为

FArray

丢失的赋值/修改将是一个单独的bug，也需要修复。否则，

Add（）

如何将

项添加到数组中？我还没有看过
TSparseArray
的源代码。
TSparseArray
很奇怪。为什么它觉得需要创建一个单独的锁对象？锁定本身有什么问题？这并不能真正修复
TSparseArray
。例外情况不会再出现了，一切似乎都很好，但奇怪和无用的副本仍然存在，并留下了一股臭味。我将试着深入了解代码，为什么它没有所有的复制部分。顺便说一句，你确实是对的，那就是
System.CopyArray
可以按照文档中的说明工作。我的错和《塔雷》的作者一样。抄写

-相信/假设而不是了解/阅读文档：o）@SirRufo我认为这比这要深刻得多。在你的问题中使用选项2是不够的，因为

FArray

是公开的，没有锁。我认为我们并没有简单的解决方法，尤其是因为我们不能真正了解这个类的设计。就我个人而言，我预计Emba大约需要5年时间来修复这个新的线程库，就像他们花了那么长时间来修复

TMonitor

一样。我不相信他们有能力编写一个干净的线程库。对System.CopyArray的调用使用目标的SourceIndex以及t

while I < Length(ThreadPool.FQueues.Current) do

if I <> Length(ThreadPool.FQueues.Current) then

if Signaled then
begin
  I := 0;
  while I < Length(ThreadPool.FQueues.Current) do
  begin
    {$IFDEF USE_BUGFIX}
    TMonitor.Enter(ThreadPool.FQueues);
    try
    {$ENDIF}
      if (ThreadPool.FQueues.Current[I] <> nil) and (ThreadPool.FQueues.Current[I] <> WorkQueue) and ThreadPool.FQueues.Current[I].TrySteal(Item) then
        Break;
    {$IFDEF USE_BUGFIX}
    finally
      TMonitor.Exit(ThreadPool.FQueues);
    end;
    {$ENDIF}
    Inc(I);
  end;
  if I <> Length(ThreadPool.FQueues.Current) then
    Break;
  LookedForSteals := True;
end

program WatchStealingTasks;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  Winapi.Windows,
  System.SysUtils,
  System.Threading,
  System.Classes,
  System.Math;

procedure OutputDebugStr( const AStr: string ); overload;
begin
  OutputDebugString( PChar( AStr ) );
end;

procedure OutputDebugStr( const AFormat: string; const AParams: array of const ); overload;
begin
  OutputDebugStr( Format( AFormat, AParams ) );
end;

function CreateInnerTask( AThreadId: Cardinal; AValue: Integer; APool: TThreadPool ): ITask;
begin
  Result := TTask.Run(
      procedure
    begin
      Sleep( AValue );
      if AThreadId <> TThread.CurrentThread.ThreadID
      then
        OutputDebugStr( '[%d] executed stolen task from [%d]', [TThread.CurrentThread.ThreadID, AThreadId] )
      else
        OutputDebugStr( '[%d] executed task', [TThread.CurrentThread.ThreadID] );
    end, APool );
end;

function CreateTask( AValue: Integer; APool: TThreadPool ): ITask;
begin
  Result := TTask.Run(
    procedure
    var
      LIdx: Integer;
      LTasks: TArray<ITask>;
    begin
      // Create three inner tasks per task
      SetLength( LTasks, 3 );
      for LIdx := Low( LTasks ) to High( LTasks ) do
        begin
          LTasks[LIdx] := CreateInnerTask( TThread.CurrentThread.ThreadID, AValue, APool );
        end;
      OutputDebugStr( '[%d] waiting for tasks completion', [TThread.CurrentThread.ThreadID] );
      TTask.WaitForAll( LTasks );
      OutputDebugStr( '[%d] task finished', [TThread.CurrentThread.ThreadID] );
    end, APool );
end;

procedure Test;
var
  LPool: TThreadPool;
  LIdx: Integer;
  LTasks: TArray<ITask>;
begin
  OutputDebugStr( 'Test started' );
  try
    LPool := TThreadPool.Create;
    try
      // Create three tasks
      SetLength( LTasks, 3 );
      for LIdx := Low( LTasks ) to High( LTasks ) do
        begin
          // Let's put some heavy work (200ms) on the first tasks shoulder
          // and the other tasks just some light work (20ms) to do
          LTasks[LIdx] := CreateTask( IfThen( LIdx = 0, 200, 20 ), LPool );
        end;
      TTask.WaitForAll( LTasks );
    finally
      LPool.Free;
    end;
  finally
    OutputDebugStr( 'Test completed' );
  end;
end;

begin
  try
    Test;
  except
    on E: Exception do
      Writeln( E.ClassName, ': ', E.Message );
  end;
  ReadLn;

end.

Debug-Ausgabe: Test started Prozess WatchStealingTasks.exe (4532) Thread-Start: Thread-ID: 2104. Prozess WatchStealingTasks.exe (4532) Thread-Start: Thread-ID: 2188. Prozess WatchStealingTasks.exe (4532) Thread-Start: Thread-ID: 4948. Prozess WatchStealingTasks.exe (4532) Debug-Ausgabe: [2188] waiting for tasks completion Prozess WatchStealingTasks.exe (4532) Debug-Ausgabe: [2104] waiting for tasks completion Prozess WatchStealingTasks.exe (4532) Thread-Start: Thread-ID: 2212. Prozess WatchStealingTasks.exe (4532) Debug-Ausgabe: [4948] waiting for tasks completion Prozess WatchStealingTasks.exe (4532) Debug-Ausgabe: [2188] executed task Prozess WatchStealingTasks.exe (4532) Debug-Ausgabe: [4948] executed task Prozess WatchStealingTasks.exe (4532) Debug-Ausgabe: [2188] executed task Prozess WatchStealingTasks.exe (4532) Debug-Ausgabe: [4948] executed task Prozess WatchStealingTasks.exe (4532) Debug-Ausgabe: [2188] executed task Prozess WatchStealingTasks.exe (4532) Debug-Ausgabe: [2188] task finished Prozess WatchStealingTasks.exe (4532) Debug-Ausgabe: [4948] executed task Prozess WatchStealingTasks.exe (4532) Debug-Ausgabe: [4948] task finished Prozess WatchStealingTasks.exe (4532) Debug-Ausgabe: [2104] executed task Prozess WatchStealingTasks.exe (4532) Debug-Ausgabe: [2188] executed stolen task from [2104] Prozess WatchStealingTasks.exe (4532) Debug-Ausgabe: [4948] executed stolen task from [2104] Prozess WatchStealingTasks.exe (4532) Debug-Ausgabe: [2104] task finished Prozess WatchStealingTasks.exe (4532) Debug-Ausgabe: Thread Exiting: 2188 Prozess WatchStealingTasks.exe (4532) Debug-Ausgabe: Thread Exiting: 4948 Prozess WatchStealingTasks.exe (4532) Thread-Ende: Thread-ID: 4948. Prozess WatchStealingTasks.exe (4532) Thread-Ende: Thread-ID: 2188. Prozess WatchStealingTasks.exe (4532) Thread-Ende: Thread-ID: 2212. Prozess WatchStealingTasks.exe (4532)

procedure TThreadPool.TQueueWorkerThread.Execute;

...

if ThreadPool.FWorkerThreadCount = 1 then
begin
  // it is the last thread after all tasks executed, but
  // FQueuedRequestCount is still on 7 - WTF
  if ThreadPool.FQueuedRequestCount = 0 then
  begin

function TThreadPool.TryRemoveWorkItem(const WorkerData: IThreadPoolWorkItem): Boolean;
begin
  Result := (QueueThread <> nil) and (QueueThread.WorkQueue <> nil);
  if Result then
    Result := QueueThread.WorkQueue.LocalFindAndRemove(WorkerData);
  {$IFDEF USE_BUGFIX}
  if Result then
    DecWorkRequestCount;
  {$ENDIF}
end;

class procedure TArray.Copy<T>(const Source, Destination: array of T; SourceIndex, DestIndex, Count: NativeInt);
{$IFDEF USE_BUGFIX}
begin
  CheckArrays(Pointer(@Source[0]), Pointer(@Destination[0]), SourceIndex, Length(Source), DestIndex, Length(Destination), Count);
  if IsManagedType(T) then
    System.CopyArray(Pointer(@Destination[DestIndex]), Pointer(@Source[SourceIndex]), TypeInfo(T), Count)
  else
    System.Move(Pointer(@Source[SourceIndex])^,Pointer(@Destination[DestIndex])^, Count * SizeOf(T) );
end;
{$ELSE}
begin
  CheckArrays(Pointer(@Source[0]), Pointer(@Destination[0]), SourceIndex, Length(Source), DestIndex, Length(Destination), Count);
  if IsManagedType(T) then
    System.CopyArray(Pointer(@Destination[SourceIndex]), Pointer(@Source[SourceIndex]), TypeInfo(T), Count)
  else
    System.Move(Pointer(@Destination[SourceIndex])^, Pointer(@Source[SourceIndex])^, Count * SizeOf(T));
end;
{$ENDIF}

procedure TestArrayCopy;
var
  LArr1, LArr2: TArray<Integer>;
begin
  LArr1 := TArray<Integer>.Create( 10, 11, 12, 13 );
  LArr2 := TArray<Integer>.Create( 20, 21 );
  // copy the last 2 elements from LArr1 to LArr2
  TArray.Copy<Integer>( LArr1, LArr2, 2, 0, 2 );
end;

LArr1 = ( 10, 11, 0, 0 ) LArr2 = ( 20, 21 ) LArr1 = ( 10, 11, 12, 13 ) LArr2 = ( 12, 13 )