Delphi OmniThreadLibrary 3.03b: IBackgroundWorker - Termination doesn't work

Question

I have problem with termination of BackgroundWorker in OmniThreadLibrary. Everything is OK, but when I want to terminate BackgroundWorker, termination has failed and BackgroundWorker is still alive. So, whole application that run as batch process is still alive.

  procedure TEntityIndexer.StartReindex;
  begin
    if LoadTable then
    begin      
    // In a ProcessRecords method I schedule WorkItems for background tasks
      ProcessRecords;
      while FCounter > 0 do
          ProcessMessages;
    // In ProcessMessages I keep the main thread alive
      ProcessRecordsContinue;
    // In ProcessRecordsContinue method I process the results of  background tasks and OnRequestDone method
    end
    else
        TerminateBackgroundWorker;
  end;

  procedure ProcessMessages;
  var
    Msg: TMsg;
  begin
    while integer(PeekMessage(Msg, 0, 0, 0, PM_REMOVE)) <> 0 do begin
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end;
  end;

  constructor TEntityIndexer.Create;
  begin
    ...
    CreateBackgroundWorker;
  end;

  procedure TEntityIndexer.CreateBackgroundWorker;
  begin
    FBackgroundWorker := Parallel.BackgroundWorker
      .NumTasks(INITasksCount)
      .Initialize(InitializeTask)
      .Finalize(FinalizeTask)
      .OnRequestDone(HandleRequestDone)
      .Execute(ProcessSupportStrings);
  end;

  procedure TEntityIndexer.FinalizeTask(const taskState: TOmniValue);
  var
    _obj: TObject;
  begin
    if not(taskState.IsObject) then
        Exit;
    _obj := taskState.AsObject;
    if _obj is TServerSessionApp then
        TServerSessionApp(_obj).ParentApplication.Free;
    CoUninitialize;
  end;

  procedure TEntityIndexer.ProcessRecordsContinue;
  begin
    if FStack.Count = 0 then
        Exit;
   ...
    FStack.Clear;
    StartReindex;
  end;

  procedure TEntityIndexer.ProcessRecords;
  ...
  begin
    FVTable.First;
    while not FVTable.Eof do
    begin
      ...
      _omniValue := TOmniValue.CreateNamed(
        [ovIdKey, _id,
        ovXMLKey, FVTable.FieldByName('mx').AsString,
        ovGenKey, FVTable.FieldByName('created').AsString
        ]);
      FBackgroundWorker.Schedule(FBackgroundWorker.CreateWorkItem(_omniValue));
      Inc(FCounter);
      FVTable.Next;
    end;
  end;

  procedure TEntityIndexer.ProcessSupportStrings(const workItem: IOmniWorkItem);
  var
    ...
  begin
    if not(workItem.taskState.IsObject) then
    ...
    if not workItem.Data.IsArray then
        raise Exception.Create('Empty parameters!');
    ...
    //  make some JSON and XML strings
    ...
    try
      try
        workItem.Result := TOmniValue.CreateNamed(
          [... ]);
     ...
  end;

  procedure TEntityIndexer.HandleRequestDone(const Sender: IOmniBackgroundWorker;
    const workItem: IOmniWorkItem);
  var
    ...
  begin
    Dec(FCounter);
    if workItem.IsExceptional then
    begin
      //  Process the exception
    end
    else if workItem.Result.IsArray then
    begin          
        ...         
      FStack.AddToStack(_stackItem);
    end;
  end;

  procedure TEntityIndexer.InitializeTask(var taskState: TOmniValue);
  begin
    CoInitialize(nil);
    taskState.AsObject := CreateAnotherServerSession;
  end;

  procedure TEntityIndexer.TerminateBackgroundWorker;
  begin
  // Here is s problem - Termination of the BackgroundWorker doesn't work, but finalization 
  // of background tasks is done
    FBackgroundWorker.Terminate(INFINITE);
    FBackgroundWorker := nil;
  end;

end.

Answer 1

Ok I find a bug. It wasn't the bug of the OTL. This one was caused by wrong destruction of the object in Finalize() method. Release of the objects in taskState parameter variable in not enough. TaskState parameter variable should be cleared too.

procedure TEntityIndexer.FinalizeTask(const taskState: TOmniValue);
var
  _obj: TObject;
begin
  if not(taskState.IsObject) then
      Exit;
  _obj := taskState.AsObject;
  if Assigned(_obj) then
      _obj.Free;
  if _obj is TServerSessionApp then
      TServerSessionApp(_obj).ParentApplication.Free;
  // release the objects and clear a taskState variable
  taskState.Clear;
  CoUninitialize;
end;