Delphi 10.4中TTask与TThreadPool任务报告重复问题问询

问题场景 #

在Delphi 10.4（Sydney）中使用TTask实现并发任务，通过TThreadPool限制最大并发线程数为4，运行后发现部分任务的启动和完成日志重复出现，具体表现：

• TaskId 1、3、7、8的「Started TaskId」日志重复两次
• TaskId 3、8的「TaskId completed」日志重复两次

原代码 #

var
  MyThreadPool: TThreadPool;
  I: Integer;
  Tasks: TArray<ITask>;

function ProcessTask(const TaskId: Integer): TProc;
begin
  Result := procedure
  Begin
    WriteLn(Format('Started TaskId: %d ThreadId: %d',[TaskId,TThread.Current.ThreadID]));
    Sleep(2000); // Simulate work
    WriteLn(format('TaskId %d completed. ThreadId: %d',[TaskId, TThread.Current.ThreadID]));
  End;
end;

begin
  try

    Writeln('Creating TThreadPool');
    MyThreadPool := TThreadPool.Create;

    try
      MyThreadPool.SetMinWorkerThreads(1);
      MyThreadPool.SetMaxWorkerThreads(4);

      // Hold 10 tasks
      SetLength(Tasks,10);

      for I := 0 to High(Tasks) do
      Begin
        Tasks[I] := TTask.Create(
          ProcessTask(I+1),
          MyThreadPool
        );

        // Start the task
        Tasks[I].Start;
      End;

      // Wait for all tasks to complete
      for I := 0 to High(Tasks) do
        Tasks[I].Wait;

      WriteLn('All tasks completed.');
      ReadLn;

    finally
      MyThreadPool.Free;
    end;

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

运行输出 #

Creating TThreadPool
Started TaskId: 1 ThreadId: 17292
Started TaskId: 1 ThreadId: 17292
Started TaskId: 2 ThreadId: 19256
Started TaskId: 3 ThreadId: 25268
Started TaskId: 3 ThreadId: 25268
Started TaskId: 4 ThreadId: 21112
TaskId 1 completed. ThreadId: 17292
Started TaskId: 5 ThreadId: 17292
TaskId 2 completed. ThreadId: 19256
Started TaskId: 6 ThreadId: 19256
TaskId 3 completed. ThreadId: 25268
TaskId 3 completed. ThreadId: 25268
TaskId 4 completed. ThreadId: 21112
Started TaskId: 7 ThreadId: 21112Started TaskId: 8 ThreadId: 25268Started TaskId: 7 ThreadId: 21112Started TaskId: 8 ThreadId: 25268
TaskId 5 completed. ThreadId: 17292
Started TaskId: 9 ThreadId: 17292
TaskId 6 completed. ThreadId: 19256
Started TaskId: 10 ThreadId: 19256
TaskId 8 completed. ThreadId: 25268
TaskId 8 completed. ThreadId: 25268
TaskId 7 completed. ThreadId: 21112
TaskId 9 completed. ThreadId: 17292
TaskId 10 completed. ThreadId: 19256
All tasks completed.

问题分析 #

核心原因是控制台输出WriteLn不是线程安全的：当多个线程同时调用WriteLn写入控制台时，操作系统的控制台输出缓冲区会出现竞态条件，导致输出内容重叠、重复或截断，看起来像是任务被重复执行，但实际上每个任务只执行了一次。

同时需确认闭包逻辑无问题：代码中ProcessTask的参数为传值类型，每个匿名函数持有独立的TaskId，不存在闭包捕获循环变量的陷阱，输出混乱是导致误解的直接原因。

解决方案 #

添加临界区（TCriticalSection）保护控制台输出操作，确保同一时间只有一个线程写入控制台，消除输出混乱：

var
  MyThreadPool: TThreadPool;
  I: Integer;
  Tasks: TArray<ITask>;
  OutputLock: TCriticalSection; // 用于同步控制台输出的临界区

function ProcessTask(const TaskId: Integer): TProc;
begin
  Result := procedure
  Begin
    // 同步启动日志输出
    OutputLock.Enter;
    try
      WriteLn(Format('Started TaskId: %d ThreadId: %d',[TaskId,TThread.Current.ThreadID]));
    finally
      OutputLock.Leave;
    end;

    Sleep(2000); // 模拟业务逻辑

    // 同步完成日志输出
    OutputLock.Enter;
    try
      WriteLn(format('TaskId %d completed. ThreadId: %d',[TaskId, TThread.Current.ThreadID]));
    finally
      OutputLock.Leave;
    end;
  End;
end;

begin
  OutputLock := TCriticalSection.Create;
  try
    Writeln('Creating TThreadPool');
    MyThreadPool := TThreadPool.Create;

    try
      MyThreadPool.SetMinWorkerThreads(1);
      MyThreadPool.SetMaxWorkerThreads(4);

      SetLength(Tasks,10);

      for I := 0 to High(Tasks) do
      Begin
        Tasks[I] := TTask.Create(ProcessTask(I+1), MyThreadPool);
        Tasks[I].Start;
      End;

      // 等待所有任务完成
      for I := 0 to High(Tasks) do
        Tasks[I].Wait;

      WriteLn('All tasks completed.');
      ReadLn;

    finally
      MyThreadPool.Free;
    end;
  except
    on E: Exception do
    begin
      OutputLock.Enter;
      try
        Writeln(E.ClassName, ': ', E.Message);
      finally
        OutputLock.Leave;
      end;
    end;
  end;
  OutputLock.Free;
end.

验证效果 #

添加临界区后，控制台输出会变得有序，每个任务的启动和完成日志只会出现一次，能准确反映任务的执行情况。

内容的提问来源于stack exchange，提问作者Shweta Softwares