我如何使用新的线程库中的TTask.WaitForAny？
在尝试使用Delphi中的线程库来并行计算任务并使用TTask.WaitForAny()获取第一个计算结果时，异常会立即停止执行。
调用堆栈的例外情况：
第一次机会例外情况是$ 752D2F71。 带有消息'Object lock not owned'的异常类EMonitorLockException。 Process Project1.exe（11248）
:752d2f71 KERNELBASE.RaiseException + 0x48
System.TMonitor.CheckOwningThread
System.ErrorAt(25,$408C70)
System.Error(reMonitorNotLocked)
System.TMonitor.CheckOwningThread
System.TMonitor.Exit
System.TMonitor.Exit($2180E40)
System.Threading.TTask.RemoveCompleteEvent(???)
System.Threading.TTask.DoWaitForAny((...),4294967295)
System.Threading.TTask.WaitForAny((...))
Project9.Parallel2
Project9.Project1
:74ff919f KERNEL32.BaseThreadInitThunk + 0xe
:7723b54f ntdll.RtlInitializeExceptionChain + 0x8f
:7723b51a ntdll.RtlInitializeExceptionChain + 0x5a
调用堆栈导致异常是由线程库TMonitor和/或TTask.WaitForAny()的错误引起的。 为了验证，代码被减少到了最低限度：
program Project1;
{$APPTYPE CONSOLE}
uses
System.SysUtils, System.Threading, System.Classes, System.SyncObjs,
System.StrUtils;
var
WorkerCount : integer = 1000;
function MyTaskProc: TProc;
begin
result := procedure
begin
// Do something
end;
end;
procedure Parallel2;
var
i : Integer;
Ticks: Cardinal;
tasks: array of ITask;
LTask: ITask;
workProc: TProc;
begin
workProc := MyTaskProc();
Ticks := TThread.GetTickCount;
SetLength(tasks, WorkerCount); // number of parallel tasks to undertake
for i := 0 to WorkerCount - 1 do // parallel tasks
tasks[i] := TTask.Run(workProc);
TTask.WaitForAny(tasks); // wait for the first one to finish
for LTask in tasks do
LTask.Cancel; // kill the remaining tasks
Ticks := TThread.GetTickCount - Ticks;
WriteLn('Parallel time ' + Ticks.ToString + ' ms');
end;
begin
try
repeat
Parallel2;
WriteLn('finished');
until FALSE;
except
on E: Exception do
writeln(E.ClassName, ': ', E.Message);
end;
Readln;
end.
现在错误再现一段时间后，RTL错误得到验证。
这是作为RSP-10197 TTask.WaitForAny向Embarcadero发出异常EMonitorLockException“Object lock not owned”而提交的。
鉴于目前使用Delphi线程库无法解决这个问题，问题是：
有没有解决方案可以并行执行一个过程以获得第一个获得的解决方案？
下面是一个使用TParallel.For的例子，当答案产生时停止执行。 它使用TParallel.LoopState来指示并行for循环的其他成员。 通过使用.Stop信号，所有当前和未决的迭代应该停止。 当前的迭代应该检查loopState.Stopped 。
procedure Parallel3(CS: TCriticalSection);
var
Ticks: Cardinal;
i,ix: Integer; // variables that are only touched once in the Parallel.For loop
begin
i := 0;
Ticks := TThread.GetTickCount;
TParallel.For(1,WorkerCount,
procedure(index:Integer; loopState: TParallel.TLoopState)
var
k,l,m: Integer;
begin
// Do something complex
k := (1000 - index)*1000;
for l := 0 to Pred(k) do
m := k div 1000;
// If criteria to stop fulfilled:
CS.Enter;
Try
if loopState.Stopped then // A solution was already found
Exit;
loopState.Stop; // Signal
Inc(i);
ix := index;
Finally
CS.Leave;
End;
end
);
Ticks := TThread.GetTickCount - Ticks;
WriteLn('Parallel time ' + Ticks.ToString + ' ticks', ' i :',i,' index:',ix);
end;
关键部分保护计算结果，这里为简单起见i，ix。
免责声明，鉴于在System.Threading库内bug的状态，我会推荐使用OTL框架的另一个解决方案。 至少在图书馆达到稳定的基础之前。
上一篇: How can I use TTask.WaitForAny from the new threading library?