How to fix TSparseArray <T>?

Question

Due to an uncommitted error with System.Generics.Collections.TArray.Copy<T> (depending on an already registered error in System.CopyArray ), an exception sometimes occurs using the thread library.

An exception is System.Threading.TSparseArray<T>.Add in the System.Threading.TSparseArray<T>.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; 

Well, what is expected with an error in System.CopyArray . Therefore, trying to fix this, my first thought was to simply copy the array with:

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

It works like a charm. But after that I was wondering why I needed a copy of the array:

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

Elements are copied to NewArray (local variable), and that is it. There is no assignment back to FArray , so for me NewArray will be completed if it goes beyond.

Now I have three fix options:

• Just replace 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); 

• Replace TArray.Copy and save 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); 

• Comment on all the unnecessary parts of the code (because they just waste time)

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

I checked all three fixes with a bunch of tasks looking for unused workflows or failed tasks. But I did not find any of them. The library is working as expected (and now without any exceptions).

Could you tell me what I do not see here?

---

To get this exception, you started a bunch of tasks and TTaskPool created more and more TWorkerQueueThreads . Check the number of threads with the TaskManager and use a breakpoint on the TArray.Copy line in TSparseArray<T>.Add . Here I get this exception when the number of application threads exceeds 25 threads.

 // Hit the button very fast until the debugger stops // at TSparseArray<T>.Add method to copy the array procedure TForm1.Button1Click( Sender : TObject ); var LIdx : Integer; begin for LIdx := 1 to 20 do TTask.Run( procedure begin Sleep( 50 ); end ); end; 

Answer 1

It doesn’t matter if the elements are written to TSparseArray<T> , because it is necessary only if the workflow has completed all the tasks delegated to it and another workflow has not yet completed. At this point, an idle thread looks at the queues of other steps within the pool and tries to steal some work.

If any queue does not fall into this array, insignificant flows are not visible, and therefore the workload cannot be divided.

To fix this, I choose option 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); 

But this thieves part is risky implemented without blocking

 procedure TThreadPool.TQueueWorkerThread.Execute; ... if Signaled then begin I := 0; while I < Length(ThreadPool.FQueues.Current) do begin if (ThreadPool.FQueues.Current[I] <> nil) and (ThreadPool.FQueues.Current[I] <> WorkQueue) and ThreadPool.FQueues.Current[I].TrySteal(Item) then Break; Inc(I); end; if I <> Length(ThreadPool.FQueues.Current) then Break; LookedForSteals := True; end 

The length of the array is only growing, therefore

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

and

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

should be safe enough.

 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 

Now we need a test environment to view the theft:

 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 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. 

And debug log

  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)

Ok, theft should now work with any number of worker threads, so is everything okay?

Not

This small test application does not come to an end, because now it hangs inside the thread pool destructor. The last workflow will not complete, caused by

 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 

Another bug to fix here ... because, while waiting for tasks with Task.WaitForAll , then all the tasks that you are currently waiting for were performed internally, but did not reduce the FQueuedRequestCount .

We fix that

 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; 

and now he works as if he should have done right away.

---

Update

As a Uwe comment, we also need to fix the fixed System.Generics.Collections.TArray.Copy<T>

 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} 

Simple check:

 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; 

• with XE7 you get an exception
• with the XE71 update you will get

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

• with this fix above

    LArr1 = (10, 11, 12, 13)
   LArr2 = (12, 13)
  

Answer 2

This is not a bug in System.CopyArray . By design, it only supports managed types. Fixed bug in TArray.Copy<T> . This is erroneous when calling System.CopyArray without distinguishing whether the managed type is T

However, the latest version of TArray.Copy<T> , from XE7 update 1, does not seem to suffer from the described problem. The code is as follows:

 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; 

If I'm not mistaken in my analysis, you just need to apply Update 1 to solve problems with System.CopyArray .

---

But, as Uwe points out in the comments below, this code is still dummy. It uses SourceIndex erroneously, where DestIndex should be used. Source and destination parameters are transferred in the wrong order. The question also arises as to why the author wrote Pointer(@Destination[SourceIndex])^ rather than Destination[SourceIndex] . I find this whole situation terribly depressing. How can Embarcadero produce code of such terrifying quality?

---

Deeper than the above are problems with TSparseArray<T> . Which looks like this:

 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; 

The only time FArray initialized in the TSparseArray<T> constructor. This means that if the array is filled, then elements are added and lost. Presumably, I = Length(LArray) - 1 intended to extend the length of the FArray and capture a new element. However, also note that TSparseArray<T> provides the FArray Current property. And this exposition is not protected by a castle. Thus, I do not see how this class can behave in any useful way after the FArray becomes populated.

I suggest you build an example in which the FArray will be filled with a demonstration that the elements that are added will be lost. Submit a bug report demonstrating this and contacting this question.