I've been puzzling over this for several days now. I've have a fairly complex bit of code where a TFuture is hanging. I was sure that I was doing something sinister in my complex code that was causing it. I am amazed that I was able to create a fairly simple example that hangs in the same way. I thought I had a good understanding of Delphi's Parallel Programming Library so I'm almost convinced that this is some kind of bug; but I could really use several extra pairs of eyes that can hopefully point out what I've missed.
I hope this appears fairly straight forward: It is a background work processing Object. It creates an TTask to do it's main work. And there is a fairly time-consuming process during setup that uses a TFuture to help allow App initialization to be in parallel. The problem occurs when a second instance of the TGadget is created: The TFuture in the second instance will hang on the call to TFuture.Value ("FAvailable := IsAvailableFutureTask.Value", line 145). It will not hang if there are no other instances, that is, if I first set all "Gadget" instances to nil before creating a new one, it will always work. It only hangs if there is already an instance running.
I get the behavior if you first click either button and the click again on either button (it doesn't matter which button is first or second).
This is a VCL forms app; here is the main form code:
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.
...and the DFM:
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 119
ClientWidth = 359
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 216
Top = 25
Width = 61
Height = 13
Caption = 'not available'
end
object Button1: TButton
Left = 40
Top = 20
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 40
Top = 56
Width = 75
Height = 25
Caption = 'Button2'
TabOrder = 1
OnClick = Button2Click
end
end
With some hints from Ikol, I've isolated the problem. Yes, adding a "sleep(1);" will solve the problem:
constructor TGadget.Create;
begin
inherited Create;
ProcessWorkTask := TTask.Run(self,ProcessWork);
Sleep(1);
end;
but this doesn't really explain whats going on here very well.
"TFuture.Value" checks if the defined task function has completed, it returns the result of that function if so; if the task has not yet completed it calls WAIT on the task and then returns the task function's result value.
Here's what I think is happening:
In my example, this is the sequence of events (this is without the Sleep(1) work-around):
1) Press a button the first time;
2) Creates a "TGadget" which creates a "ProcessWorkTask". (Note: since there are no other Tasks in the ThreadPool, this task gets started pretty quickly.)
3) In "PrepareGadget", the new Gadget instance's "Dials" and "Switches" are set which ultimately causes...
4) A "IsAvailableFutureTask" TFuture task is kicked off. (This too gets started in time for things to work.)
5) Immediately after "configuring" the new Gadget, the "Available" method calls for the value of the "IsAvailableFutureTask" future.
There are now 2 Tasks in the ThreadPool.
6) Press a button for the second time
7) Creates a "TGadget" which creates a "ProcessWorkTask". (Note: since there are other Tasks in the ThreadPool now, this task does not get started as quickly as the first time around.)
8) "PrepareGadget" again triggers another "IsAvailableFutureTask" to be started. With 4 tasks now in the ThreadPool this TFuture task takes longer to get started. In fact, it is sitting in the "WaitingToStart" state when...
9) ...the "Available" method calls for the value of "IsAvailableFutureTask" #2 TFuture.
Which hangs everything since the ThreadPool is waiting on a task that has not started.
Adding the "Sleep(1)" gives the ThreadPool enough time to get the Tasks running so that the (second) TFuture is in the running state when the call for it's value executes. Instead of "sleep" I think a better choice would be:
constructor TGadget.Create;
begin
inherited Create;
ProcessWorkTask := TTask.Run(self,ProcessWork);
while ProcessWorkTask.Status = TTaskStatus.WaitingToRun do
TThread.Yield;
end;
Also, using a seperate ThreadPool makes it work as well:
constructor TGadget.Create;
begin
inherited Create;
GadgetPool := TThreadPool.Create;
ProcessWorkTask := TTask.Run(self,ProcessWork,GadgetPool);
end;
My conclusion is that this is a bug of omission, there is no way to insure that your TFuture gets into the running state before another thread calls for it's value.