Exceptions em Thread Paralelas – Estendendo TTask
Quando estamos executando um código em um processo paralelo (Thread) e ocorre uma Exception internamente, normalmente nada é apresentado ao usuário.
Isso ocorre por que a Thread em paralelo não consegue notificar a Thread Principal da aplicação para exibir a exceção pro usuário.
Vamos demonstrar um exemplo:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 |
var FTask: ITask; procedure TForm1.Button1Click(Sender: TObject); begin ExecProc; end; procedure TForm1.FormDestroy(Sender: TObject); begin FTask.Cancel; end; procedure TForm1.ExecProc; begin FTask := TTask.Create( procedure var I : Integer; begin for I := 0 to 9 do begin if TTask.CurrentTask.Status = TTaskStatus.Canceled then exit; Sleep(1000); if I = 2 then raise Exception.Create(‘Test exception’); end; if TTask.CurrentTask.Status <> TTaskStatus.Canceled then begin TThread.Queue(TThread.CurrentThread, procedure begin if Assigned(ListBox1) then Listbox1.Items.Add(’10 Seconds’); end); end; end); Task.Start; end; |
Executando o código é possível constatar que o procedimento levanta uma exceção e o usuário não recebe a informação de erro.
Stefan Glienke criou uma classe herdada de ITask e TTask com melhorias e mais simples de implementar para permitir tratar as exceções que ocorrem dentro da Thread.
Ele utilizou como modelo a Task.ContinueWith do .NET que permite continuar a execução após a ocorrência da exceção. Unit ThreadingEx:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 |
unit ThreadingEx; interface uses SysUtils, Threading; type TAction<T> = reference to procedure(const arg: T); TTaskContinuationOptions = ( NotOnCompleted, NotOnFaulted, NotOnCanceled, OnlyOnCompleted, OnlyOnFaulted, OnlyOnCanceled ); ITaskEx = interface(ITask) ['{3AE1A614-27AA-4B5A-BC50-42483650E20D}'] function GetExceptObj: Exception; function GetStatus: TTaskStatus; function ContinueWith(const continuationAction: TAction<ITaskEx>; continuationOptions: TTaskContinuationOptions): ITaskEx; property ExceptObj: Exception read GetExceptObj; property Status: TTaskStatus read GetStatus; end; TTaskEx = class(TTask, ITaskEx) private fExceptObj: Exception; function GetExceptObj: Exception; protected function ContinueWith(const continuationAction: TAction<ITaskEx>; continuationOptions: TTaskContinuationOptions): ITaskEx; public destructor Destroy; override; class function Run(const action: TProc): ITaskEx; static; end; implementation uses Classes; { TTaskEx } function TTaskEx.ContinueWith(const continuationAction: TAction<ITaskEx>; continuationOptions: TTaskContinuationOptions): ITaskEx; begin Result := TTaskEx.Run( procedure var task: ITaskEx; doContinue: Boolean; begin task := Self; if not IsComplete then DoneEvent.WaitFor; fExceptObj := GetExceptionObject; case continuationOptions of NotOnCompleted: doContinue := GetStatus <> TTaskStatus.Completed; NotOnFaulted: doContinue := GetStatus <> TTaskStatus.Exception; NotOnCanceled: doContinue := GetStatus <> TTaskStatus.Canceled; OnlyOnCompleted: doContinue := GetStatus = TTaskStatus.Completed; OnlyOnFaulted: doContinue := GetStatus = TTaskStatus.Exception; OnlyOnCanceled: doContinue := GetStatus = TTaskStatus.Canceled; else doContinue := False; end; if doContinue then continuationAction(task); end); end; destructor TTaskEx.Destroy; begin fExceptObj.Free; inherited; end; function TTaskEx.GetExceptObj: Exception; begin Result := fExceptObj; end; class function TTaskEx.Run(const action: TProc): ITaskEx; var task: TTaskEx; begin task := TTaskEx.Create(nil, TNotifyEvent(nil), action, TThreadPool.Default, nil); Result := task.Start as ITaskEx; end; end. |
Exemplo de como utilizar a nova implementação de TTask:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 |
TTaskEx.Run( procedure begin Sleep(1000); raise Exception.Create(‘Test Error’) end) .ContinueWith( procedure(const LTaskEx: ITaskEx) begin TThread.Queue(TThread.CurrentThread, procedure begin ShowMessage(LTaskEx.ExceptObj.ToString); end); end , OnlyOnFaulted); |
Melhorando o tratamento da exceção:
Se utilizarmos o código padrão:
|
1 |
ShowMessage(LTaskEx.ExceptObj.Message); |
O retorno da mensagem será: “One or more errors occurred”
Para resolver isso podemos utilziar:
|
1 |
ShowMessage(LTaskEx.ExceptObj.ToString); |
E o retorno será:
One or more errors occurred
1 exceptions(s):
#0 Exception: Test Error
Isso ocorre pois podemos ter mais de um erro dentro da Exception.
Para melhorar podemos utilizar EAggregateException que contem as propriedades: Count e InnerExceptions[ ]
Exemplo 1:
|
1 2 |
for var I := 0 to Pred(EAggregateException(LTaskEx.ExceptObj).Count) do ShowMessage(EAggregateException(LTaskEx.ExceptObj).InnerExceptions[I].Message); |
Exemplo 2:
|
1 2 3 4 5 |
var LStr: String; for var I := 0 to Pred(EAggregateException(LTaskEx.ExceptObj).Count) do LStr := LStr + EAggregateException(LTaskEx.ExceptObj).InnerExceptions[I].Message + #13; ShowMessage(LStr); |
Assim caso tenha mais de uma mensagem de exception poderemos exibi-las ao usuário.
Créditos: http://tireideletra.wbagestao.com/index.php/2016/03/24/exceptions-em-thread-paralelas-extendendo-ttask/