Multithreading Delphi Berlin PPL TFuture在第二个实例中等待

这件事我已经琢磨了好几天了。我有一段相当复杂的代码，其中有一个T未来悬而未决。我确信我在复杂的代码中做了一些邪恶的事情，导致了它。我很惊讶，我能够创建一个以同样方式挂起的相当简单的示例。我认为我对Delphi的并行编程库有很好的理解，所以我几乎确信这是某种bug；但我真的可以多用几双眼睛来指出我错过了什么

我希望这看起来相当直截了当：它是一个后台工作处理对象。它创建一个TTask来完成它的主要工作。在安装过程中有一个相当耗时的过程，它使用一个TFuture来帮助允许应用程序并行初始化。创建第二个TGadget实例时会出现问题：第二个实例中的TFuture将挂起对TFuture.Value的调用（“FAvailable:=IsAvailableFutureTask.Value”，第145行）。如果没有其他实例，它将不会挂起，也就是说，如果我在创建新实例之前先将所有“Gadget”实例设置为nil，它将始终工作。只有在已有实例正在运行时，它才会挂起

如果您先单击任意一个按钮，然后再次单击任意一个按钮（无论哪个按钮是第一个按钮还是第二个按钮），我都会得到这种行为

这是一个VCL表单应用程序；以下是主要表单代码：

unit Unit1;

interface

uses
     Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
     Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,

     System.Threading
     ;

type
   IGadget = interface
   ['{E426DCA3-D817-4231-8D19-9B839F89A8E3}']
      function    GetAvailable : boolean;
      property    Available : boolean read GetAvailable;

      procedure   SetDial(const Value : string);
      property    Dial : string write SetDial;

      procedure   SetSwitches(const Value : string);
      property    Switches : string write SetSwitches;
   end;

   TGadget = class(TInterfacedObject, IGadget)
     protected
      DialValue : string;
      SwitchesValue : string;
      HaveConfiguration : boolean;

      FAvailable  : boolean;
      IsAvailableFutureTask : IFuture<boolean>;

      ProcessWorkTask : ITask;

      procedure   CheckIfAvailable;
      procedure   ConfigurationChanged;

      procedure   ProcessWork(Sender : TObject);

      (* IGadget *)
      function    GetAvailable : boolean;
      procedure   SetDial(const Value : string);
      procedure   SetSwitches(const Value : string);

     public
      constructor Create;
      destructor  Destroy; override;
   end;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);

   protected
    function  PrepareGadget : IGadget;

   public
    Gadget1 : IGadget;
    Gadget2 : IGadget;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//////////////////////////////////////////////////////////////////////////////////////////////////////

constructor TGadget.Create;

begin
   inherited Create;

   ProcessWorkTask := TTask.Run(self,ProcessWork);
end;

destructor TGadget.Destroy;

begin
   ProcessWorkTask.Cancel;

   inherited Destroy;
end;

procedure TGadget.ProcessWork(Sender : TObject);

begin
   repeat
      //
      // process the Gadget's work
      //
      TThread.Yield;

   until TTask.CurrentTask.Status = TTaskStatus.Canceled;
end;

procedure TGadget.CheckIfAvailable;

begin
   FAvailable := false;

   IsAvailableFutureTask := nil;
   if not HaveConfiguration then exit;

   IsAvailableFutureTask := TTask.Future<boolean>(
      function : boolean

      var
         GadgetAvailable : boolean;

      begin

         try
            //
            // Perform some time consuming task to determine if
            //   the Gadget is available
            //
            sleep(2000);

            GadgetAvailable := true;

         except
            on E:Exception do
               begin
                  GadgetAvailable := false;

               end
         end;

         Result := GadgetAvailable;
      end);
end;

function TGadget.GetAvailable : boolean;

begin
   if assigned(IsAvailableFutureTask) then
      FAvailable := IsAvailableFutureTask.Value;

   Result := FAvailable
end;

procedure TGadget.ConfigurationChanged;

begin
   HaveConfiguration := false;

   if (DialValue = '') or (SwitchesValue = '') then exit;

   HaveConfiguration := true;
   CheckIfAvailable;
end;

procedure TGadget.SetDial(const Value : string);

begin
   DialValue := Value;
   ConfigurationChanged
end;

procedure TGadget.SetSwitches(const Value : string);

begin
   SwitchesValue := Value;
   ConfigurationChanged
end;

///////////////////////////////////////////////////////////

function TForm1.PrepareGadget : IGadget;

begin
   label1.Caption := 'seting up...';
   Application.ProcessMessages;

   Result := TGadget.Create;

   Result.Dial := 'Do something or other';
   Result.Switches := 'Toggled or whatever';

   if Result.Available then
      label1.Caption := 'is available'
   else
      label1.Caption := 'not available';

   Application.ProcessMessages;
end;

procedure TForm1.Button1Click(Sender: TObject);

begin
   Gadget1 := PrepareGadget;

end;

procedure TForm1.Button2Click(Sender: TObject);

begin
   Gadget2 := PrepareGadget;

end;

end.

---

TTask将只创建与处理器数量相等的线程数量。因此，如果您只有一个处理器，无论您将创建和运行多少个ttask，一次只能运行一个处理器（它们是一些算法，用于检测一个ttask何时休眠以运行另一个ttask，但它的设计很糟糕，可能要等30秒-1分钟左右才能检测到，而不是一个ttask在运行另一个实例之前什么都不做）。Tparalell和tfutur也是一样的

---

因此，您必须仅对非常密集的CPU算法（使用100%的CPU）使用TTask/tparalell/tfutur，否则必须使用TThread。所谓非常密集的CPU过程，我指的是例如计算素数这样的过程，而不是像执行http请求或类似的任务那样只创建与处理器数量相等的线程数量。因此，如果您只有一个处理器，无论您将创建和运行多少个ttask，一次只能运行一个处理器（它们是一些算法，用于检测一个ttask何时休眠以运行另一个ttask，但它的设计很糟糕，可能要等30秒-1分钟左右才能检测到，而不是一个ttask在运行另一个实例之前什么都不做）。Tparalell和tfutur也是一样的

---

因此，您必须仅对非常密集的CPU算法（使用100%的CPU）使用TTask/tparalell/tfutur，否则必须使用TThread。通过非常密集的CPU过程，我指的是例如计算素数之类的过程，而不是像执行http请求或类似的

，通过Ikol的一些提示，我已经隔离了这个问题。是的，添加“sleep（1）；”将解决以下问题：

constructor TGadget.Create;

begin
   inherited Create;

   ProcessWorkTask := TTask.Run(self,ProcessWork);

   Sleep(1);
end;

但这并不能很好地解释这里发生了什么

“TFuture.Value”检查定义的任务函数是否已完成，如果已完成，则返回该函数的结果；如果任务尚未完成，则调用等待任务，然后返回任务函数的结果值

以下是我认为正在发生的事情：

在我的示例中，这是事件的顺序（没有睡眠（1）解决方案）：

1） 第一次按下按钮

2） 创建一个“TGadget”，它创建一个“ProcessWorkTask”。（注意：由于线程池中没有其他任务，因此此任务很快就开始了。）

3） 在“PrepareGadget”中，设置了新小工具实例的“拨号”和“开关”，最终导致

4） “IsAvailableFutureTask”t未来任务已启动。（这也会及时开始，以使事情顺利进行。）

5） 在“配置”新小工具之后，“可用”方法立即调用“IsAvailableFutureTask”future的值

线程池中现在有2个任务

6） 第二次按下按钮

7） 创建一个“TGadget”，它创建一个“ProcessWorkTask”。（注意：由于线程池中现在还有其他任务，因此此任务的启动速度不如第一次快。）

8） “PrepareGadget”再次触发另一个要启动的“IsAvailableFutureTask”。线程池中现在有4个任务，因此此t未来任务需要更长的时间才能开始。事实上，它正处于“等待启动”状态，此时

9） …该“Available”方法调用“IsAvailableFutureTask”的值

这会挂起所有内容，因为线程池正在等待尚未启动的任务

添加“Sleep（1）”可以让线程池有足够的时间运行任务，以便在执行对其值的调用时（第二个）t未来处于运行状态。与“睡眠”相比，我认为更好的选择是：

constructor TGadget.Create;

begin
   inherited Create;

   ProcessWorkTask := TTask.Run(self,ProcessWork);

   while ProcessWorkTask.Status = TTaskStatus.WaitingToRun do
      TThread.Yield;
end;

此外，使用单独的线程池也可以使其正常工作：

constructor TGadget.Create;

begin
   inherited Create;

   GadgetPool := TThreadPool.Create;
   ProcessWorkTask := TTask.Run(self,ProcessWork,GadgetPool);
end;

---

我的结论是，这是一个遗漏的bug，在另一个线程调用它的值之前，无法确保您的t未来进入运行状态。

通过Ikol的一些提示，我已经隔离了这个问题。是的，添加“sleep（1）；”将解决以下问题：

constructor TGadget.Create;

begin
   inherited Create;

   ProcessWorkTask := TTask.Run(self,ProcessWork);

   Sleep(1);
end;

但这并不能很好地解释这里发生了什么

“TFuture.Value”检查定义的任务函数是否已完成，如果已完成，则返回该函数的结果；如果任务尚未完成，则调用等待任务，然后返回任务函数的结果值

以下是我认为正在发生的事情：

在我的示例中，这是事件的顺序（没有睡眠（1）解决方案）：

1） 第一次按下按钮

2） 创建一个“TGadget”，它创建一个“ProcessWorkTask”。（注意：因为ThreadPoo中没有其他任务