janeiro 2017 - Tirei de Letra

#compartilhandoconhecimento #wba10anos
THIS não é um método ou propriedade de classes no DELPHI como ocorre com JAVA.
Emprestando a definição do JAVA-ORACLE temos: “this is a reference to the current object — the object whose method or constructor is being called”…

Acompanhando os artigos do Marcos Douglas B. Santos em seu Blog: Object Pascal Programming por vezes versa sobre implementar uma class function a classes que instâncie e retorne o próprio objeto de preferência por uma INTERFACE.

Bem, a questão nos apresenta quando temos uma interface e precisamos obter a referência ao objeto criado pelo seu construtor. Neste casos, em geral, fazer um CAST da INTERFACE para o OBJETO não é garantia de sucesso.

Depois de lutar muito com o problema minha conclusão é que a melhor solução seria a INTERFACE retornar o próprio objeto criado em seu construtor – o THIS – como definido no JAVA.

Exemplo:
[code lang=”pascal”]

type
TTransporteClass = class;

ITransporte = interface
{…}
function This:TTransporteClass;
end;

TTransporteClass = class(TInterfacedObject, ITransporte)
public
class function New:ITransporte;
function This:TTransporteClass;
end;

…
// class function para iniciar a instância
class function TTransporteClass.New:ITransporte;
begin
result := TTransporteClass.create;
end;

// function para obter o objeto instanciado
function TTransporteClass.This:TTransporteClass;
begin
result := self;
end;

[/code]

A boa prática logo vai se manifestar com argumento de promover maior acoplamento do código – perfeitamente… neste caso retornar uma classe de nível superior pode contribuir em elevar o acoplamento do código… para isto, vamos trocar o retorno da function THIS:

[code]

IThis = interface
{…}
function This:TObject;
end;

ITransporte = interface
{…}
end;

TTransporteClass = class(TInterfacedObject, ITransporte, IThis)
…..

[/code]

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’);

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.

Tirei de Letra

Coder's Perspective

Mês: janeiro 2017

Delphi – Usando THIS com Interfaces

Delphi – Parallel Proposta WaitForAll NoBlocking

Congelando a janela com TTask.WaitForAll ???