Обновление TasksEx - попытка №2

Обновился модуль TasksEx, включая пример. Текст статьи остался без изменений, просто был перезалит обновлённый архив.
В модуль добавлены стандартные процедуры для отмены выполнения потока. Реализация проста - при запуске потока EnterWorkerThread возвращает дескриптор задачи, который потом можно передать в одну из функций отмены - AbortXXX. В рамках самого потока вы должны периодически вызывать CheckAbort, которая возбудит тихое исключение, если поток был отменён.
Предложенный функционал является универсальным в том смысле, что функции отмены можно использовать не только для рабочих потоков EnterWorkerThread, но и для любых потоков вообще. Для регистрации потоков служат функции Register/UnregisterWorkerThread.
Также, по просьбе некоторых товарищей туда вошёл этот функционал.

Исключения в чужом потоке в EurekaLog

В связи с моей будущей статьёй, я познакомился с EurekaLog несколько ближе, чем мне нужно для повседневной работы. В частности, у EurekaLog есть возможность включить обнаружение зависаний приложения. Делается это классическим образом: через дополнительный поток и polling (опрос) главного потока с SendMessageTimeout.

Интересна, однако, реакция на обнаружение зависания. Вместо какого-нибудь показа сообщения об ошибке, в EurekaLog я заметил интересную вещь: при подвисании приложения, в главном потоке будет возбуждено EFrozenException. При этом используется примерно тот же код, что и в моём неудачном эксперименте для TasksEx.

Видимо подразумевается, что EFrozenException фатально и требуется перезапуск приложения.

Вот и пример удачного использования подобного кода.

Обновление для TasksEx - неудачно

Сегодня закончил тестирование обновления для модуля TasksEx. Не считая служебных, в него должны были войти такие функции:

// Raises EExternalAbort in last launched worker thread
procedure AbortLastWorkerThread;
// Raises EExternalAbort in all worker threads
procedure AbortAllWorkerThreads;
// Raises EExternalAbort in specific worker thread.
(*
 Handle of worker thread can be obtained by call to GetCurrentThreadHandle inside of Enter/LeaveWorkerThread block, thread function of Execute method.
 AbortWorkerThread(THandle) differs from _RaiseAbortInThread(THandle).
 AbortWorkerThread raises exception only when user code is executed in the thread (for external threads - code between RegisterAsWorkerThread/UnregisterAsWorkerThread). I.e. - it is safe.
*)
procedure AbortWorkerThread(const AThreadHandle: THandle);
// These functions can not interrupt kernel code.

// Registers any thread (TThread, CreateThread, etc) as worker thread.
// Once registered you can abort it with AbortXXX functions above.
procedure RegisterAsWorkerThread(const AThreadHandle: THandle);
procedure UnregisterAsWorkerThread(const AThreadHandle: THandle);

// Returns real handle of current thread
function GetCurrentThreadHandle: THandle;

Смысл в том, чтобы рабочий поток мог бы выполняться, не проверяя флагов отмены потока. А из гуёвого потока можно было бы вызвать функцию отмены работы (см. выше). Функция отмены возбудила бы в рабочем потоке исключение (класса EAbort) и, таким образом, отменила бы поток.

Хотя само возбуждение исключения во внешнем потоке мне удалось сделать без особых проблем, но оказалось, что нельзя возбуждать его в любое время.

Посмотрите на такой (типичный) код:

F := TF.Create;
try
  // do something with F
finally
  FreeAndNil(F);
end;

Что будет, если исключение возникнет в процессе выполнения деструктора F? Или сразу после выхода из конструктора, но до установки try? Ничего хорошего: утечка ресурсов будет.

Увы, но такой красивый механизм себя не оправдал. Хотя я не собираюсь специально искать решения этих проблем, но, может быть, другой механизм или решение этой проблемы когда-нибудь само придёт ко мне в голову :)

P.S.

Если кому интересно, таким был основной код:

{ EExternalAbort }

class function EExternalAbort.Create: EExternalAbort;
begin
  Result := inherited Create('');
end;

// $W- (in unit's header) has the same effect
{$STACKFRAMES OFF}

procedure RaiseExternalAbort;
begin
  raise EExternalAbort.Create;
end;

procedure _RaiseAbortInThread(AThreadHandle: THandle); overload;
var
  Context: Windows.TContext;
begin
  try
      FillChar(Context, SizeOf(Context), 0);
      Context.ContextFlags := CONTEXT_CONTROL;
      if SuspendThread(AThreadHandle) = DWORD(-1) then
          RaiseLastOSError;
      try
          if not GetThreadContext(AThreadHandle, Context) then
              RaiseLastOSError;
          Context.Eip := DWord(@RaiseExternalAbort);
          if not SetThreadContext(AThreadHandle, Context) then
              RaiseLastOSError;
      finally
          if ResumeThread(AThreadHandle) = DWORD(-1) then
              RaiseLastOSError;
      end;
  except
      on E: Exception do
          raise EAbortRaiseError.CreateFmt(RsErrorRaisingAbortExcep, [E.Message]);
  end;
end;