Share Button

#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:


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;

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:


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

      ITransporte = interface
         {...}
      end;

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



Share Button

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:

 


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;

Versão 1. Implementando o método:

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;

Versão 2. Revisando o código para um uso mais eficiente com MsgWaitForMultipleObjectsEx:

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;

Reescrevendo o Exemplo:  Dia11_Threading_TParallel

 

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