Tirei de Letra

Congelando a janela com TTask.WaitForAll ???

#compartilhandoconhecimento #wba10anos
Depois que publiquei o vídeo Papo sobre POO (TTask e outros), recebi um comentário que me deixou intrigado.

Porquê o a janela principal trava quando executo   TTask.WaitForAll(  ….  );

Fui dar uma olhando como foi implementado o método – observei que é feito uma chamada para uma camada de TEvent que é implementado nas chamadas internas da rotina. Por traz da mecânica com TEvent é feito uso de  WaitForSingleObject – que é uma camada de acesso a biblioteca do windows.

A alteração não é trivial. O primeiro problema é como reescrever o método considerando que o array passado como parametro é um   .. AArray: array of ITask… qualquer deslize no seu uso vai provocar um incremento no contador RefCount da interface e pode levar a perda de controle no autofree do processo…
Para não causar um incremento do RefCount é preciso fazer uso da instrução  [unsafe] o que foi feito através de um “wrapper” para um record marcado para não incrementar o RefCount.

Contornado a questão de referência, o próximo obstáculo é encontrar um mecanismo que permita parar o processamento sem congelar a janela…

Depois de várias tentativas a solução encontrada foi o “infamous” application.processmessage. Esta não é uma boa opção, já que  mantém o processador em atividade,  quando o ideal seria encontrar um modelo que não fizesse uso do processador enquanto esta atualizando a janela principal.

Primeiramente foi criado um Class Helper para o TTask:

[code lang=”pascal”]

Type
TTaskHelper = class helper for TTask
private type
TUnsafeTaskEx = record
private
[Unsafe]
// preciso de um record UNSAFE para nao incrementar o RefCount da Interface
FTask: TTask;
public
property Value: TTask read FTask write FTask;
end;
public
class function WaitForAllEx(AArray: Array of ITask;
ATimeOut: int64 = INFINITE): boolean;
end;

[/code]

Versão 1. Implementando o método:

[code lang=”pascal”]
class function TTaskHelper.WaitForAllEx(AArray: array of ITask;
ATimeOut: int64 = INFINITE): boolean;
var
task: TUnsafeTaskEx;
i: integer;
taskInter: TArray<TUnsafeTaskEx>;
completou: boolean;
Canceled, Exceptions: boolean;
begin
Canceled := false;
Exceptions := false;
result := true;
try
for i := low(AArray) to High(AArray) do
begin
task.Value := TTask(AArray[i]);
if task.Value = nil then
raise EArgumentNilException.Create(‘Wait Nil Task’);

completou := task.Value.IsComplete;
if not completou then
begin
taskInter := taskInter + [task];
end
else
begin
if task.Value.HasExceptions then
Exceptions := true
else if task.Value.IsCanceled then
Canceled := true;
end;
end;

try
for task in taskInter do
begin
while not task.Value.IsComplete do
begin
try
TThread.Queue(nil,
procedure
begin
application.ProcessMessages;
end);
finally
end;
end;
if task.Value.IsComplete then
begin
if task.Value.HasExceptions then
Exceptions := true
else if task.Value.IsCanceled then
Canceled := true;
end;
end;
finally
end;
except
result := false;
end;

if (not Exceptions and not Canceled) then
Exit;
if Exceptions or Canceled then
raise EOperationCancelled.Create
(‘One Or More Tasks HasExceptions/Canceled’);

end;

[/code]

Versão 2. Revisando o código para um uso mais eficiente com MsgWaitForMultipleObjectsEx:
[code lang=”pascal”]
class function TTaskHelper.WaitForAllEx(AArray: array of ITask;
ATimeOut: int64 = INFINITE): boolean;
var
FEvent: TEvent;
task: TUnsafeTaskEx;
i: integer;
taskInter: TArray<TUnsafeTaskEx>;
completou: boolean;
Canceled, Exceptions: boolean;
ProcCompleted: TProc<ITask>;
LHandle: THandle;
LStop: TStopwatch;
begin
LStop := TStopwatch.StartNew;
ProcCompleted := procedure(ATask: ITask)
begin
FEvent.SetEvent;
end;

Canceled := false;
Exceptions := false;
result := true;
try
for i := low(AArray) to High(AArray) do
begin
task.Value := TTask(AArray[i]);
if task.Value = nil then
raise EArgumentNilException.Create(‘Wait Nil Task’);

completou := task.Value.IsComplete;
if not completou then
begin
taskInter := taskInter + [task];
end
else
begin
if task.Value.HasExceptions then
Exceptions := true
else if task.Value.IsCanceled then
Canceled := true;
end;
end;

try
FEvent := TEvent.Create();
for task in taskInter do
begin
try
FEvent.ResetEvent;
if LStop.ElapsedMilliseconds > ATimeOut then
break;
LHandle := FEvent.Handle;
task.Value.AddCompleteEvent(ProcCompleted);
while not task.Value.IsComplete do
begin
try
if LStop.ElapsedMilliseconds > ATimeOut then
break;
if MsgWaitForMultipleObjectsEx(1, LHandle,
ATimeOut – LStop.ElapsedMilliseconds, QS_ALLINPUT, 0)
= WAIT_OBJECT_0 + 1 then
application.ProcessMessages;
finally
end;
end;
if task.Value.IsComplete then
begin
if task.Value.HasExceptions then
Exceptions := true
else if task.Value.IsCanceled then
Canceled := true;
end;
finally
task.Value.removeCompleteEvent(ProcCompleted);

end;
end;
finally
FEvent.Free;
end;
except
result := false;
end;

if (not Exceptions and not Canceled) then
Exit;
if Exceptions or Canceled then
raise EOperationCancelled.Create
(‘One Or More Tasks HasExceptions/Canceled’);

end;

[/code]

Reescrevendo o Exemplo:  Dia11_Threading_TParallel

Este é um comportamento quando o SO é windows. Em outras plataformas o resultado poderá ser outro.