Delphi: захватить исключение в TTask и поднять в основной поток - PullRequest
3 голосов
/ 04 июля 2019

Я хочу поймать исключение, поднятое в TTask из основной формы / основного потока

var
    aTasks: array of ITask;
begin
    Setlength(aTasks, 2);

    aTasks[0] := TTask.Create(procedure begin
        raise Exception.Create('Error1');
    end);
    aTasks[0].Start;

    aTasks[1] := TTask.Create(procedure begin
        raise Exception.Create('Error2');
    end);
    aTasks[1].Start;

    TTask.WaitForAll(aTasks);
end;

В основную форму (основной поток) я вижу это:

enter image description here

Я попытался перехватить исключение и повторно поднять его в основной поток

var
    aTasks: array of ITask;
begin
    Setlength(aTasks, 2);

    aTasks[0] := TTask.Create(procedure begin
        try
            raise Exception.Create('Error1');
        except on E : Exception do 
            begin
                TThread.Queue(TThread.CurrentThread, procedure
                begin
                    raise E;
                end);
            end;
        end;
    end);
    aTasks[0].Start;

    aTasks[1] := TTask.Create(procedure begin
        try
            raise Exception.Create('Error2');
        except on E : Exception do 
            begin
                TThread.Queue(TThread.CurrentThread, procedure
                begin
                    raise E;
                end);
            end;
        end;
    end);
    aTasks[1].Start;

    TTask.WaitForAll(aTasks);

end;

но в основной форме я вижу это:

enter image description here

Как перехватить и повторно вызвать исключение потока для основного потока?

UPDATE

возможно я нашел правильный путь, используя AcquireExceptionObject:

var
    aTasks: array of ITask;
begin
  Setlength(aTasks, 2);

  aTasks[0] := TTask.Create(procedure
  var
      CapturedException : Exception;
  begin
      try
          raise Exception.Create('Error1');
      except
          CapturedException := AcquireExceptionObject;
          TThread.Queue(TThread.CurrentThread, procedure begin
              raise CapturedException;
          end);
      end;
  end);
  aTasks[0].Start;

  aTasks[1] := TTask.Create(procedure
  var
      CapturedException : Exception;
  begin
      try
          raise Exception.Create('Error2');
      except
          CapturedException := AcquireExceptionObject;
          TThread.Queue(TThread.CurrentThread, procedure begin
              raise CapturedException;
          end);
      end;
  end);
  aTasks[1].Start;

  TTask.WaitForAll(aTasks);
end;  

теперь я вижу правильную ошибку:

enter image description here

это стандартный способ распространения ошибки в основной поток?

1 Ответ

5 голосов
/ 04 июля 2019

TTask.WaitForAll() ожидает завершения всех указанных задач.Если какая-либо из этих задач заканчивается из-за необработанного исключения, WaitForAll() собирает все исключения и выдает EAggregateException в ваш код:

procedure TForm4.Button1Click(Sender: TObject);
var ar : TArray<iTask>;
begin
  SetLength(ar, 3);
  ar[0] := TTask.Run(procedure begin
    TTask.CurrentTask.Wait(100);
    raise Exception.Create('Error Message');
  end);
  ar[1] := TTask.Run(procedure begin
    TTask.CurrentTask.Wait(100);
    raise Exception.Create('Another Error Message');
  end);
  ar[2] := TTask.Run(procedure begin
    TTask.CurrentTask.Wait(100);
    raise Exception.Create('A Third Error Message');
  end);

  try
    TTask.WaitForAll(ar);
  except
     on E: EAggregateException do ShowMessage(E.ToString);
  end;
//
//  [Dialog Content]
//  One or more errors occurred
//  Error Message
//  Another Error Message
//  A Third Error Message
//  [OK]
end;

EAggregateException имеет открытые свойства Count и InnerExceptions[], если вы хотите получить доступ к отдельным исключениям напрямую.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...