raise Exception.Create() feuert ApplicationEvents nicht aus TTask an

[TiGü]

Delphi-Quellcode:

program Project5;

{$APPTYPE CONSOLE}

{$R *.res}


uses
  System.SysUtils,
  Winapi.Windows,
  System.Classes,
  System.Threading;

type
  TMyThread = class(TThread)

  protected
    procedure Execute; override;
  end;

  { TMyThread }

procedure TMyThread.Execute;
var
  I: Integer;
begin
  inherited;
  while I < 1000 do
  begin
    if I = 900 then
    begin
      raise Exception.Create('Error Message');
    end;
    Inc(I);
  end;
end;

var
  MyThread: TMyThread;
  MyTask: ITask;

begin
  try
    MyThread := TMyThread.Create;

    MyThread.WaitFor;

    if Assigned(MyThread.FatalException) then
    begin
      Writeln(Exception(MyThread.FatalException).ClassName, ': ', Exception(MyThread.FatalException).Message);
    end;

    MyThread.Free;



    MyTask := TTask.Run(
        procedure
      var
        I: Integer;
      begin
        I := 0;

        while I < 1000 do
        begin
          if I = 900 then
          begin
            raise Exception.Create('Error Message');
          end;
          Inc(I);
        end;
      end).Start;

    // ruft intern TTask.CheckFault auf
    MyTask.Wait();

    Readln;
  except
    on E: EAggregateException do
    begin
      Writeln(E.ClassName, ': ', E.Message);

      if (E is EAggregateException) and Assigned(EAggregateException(E).InnerExceptions[0]) then
      begin
        Writeln(EAggregateException(E).InnerExceptions[0].ClassName, ': ', EAggregateException(E).InnerExceptions[0].Message);
      end;

      Readln;
    end;
  end;

end.