Изящно заканчивая все темы

Question

Я использую это в одном из моих решений

Мое требование - очистить очередь и аккуратно уничтожить все потоки, когда нажата кнопка "Стоп".

Для этого я создал ObjectList

var
  List: TObjectList<TMyConsumerItem>;
begin
  { Create a new List. }
  List := TObjectList<TMyConsumerItem>.Create();

Позже я сделал эту модификацию:

procedure TForm1.DoSomeJob(myListItems: TStringList);
...
for i := 1 to cThreadCount do
    List.Add(TMyConsumerItem.Create(aQueue, aCounter));

И при нажатии кнопки Стоп Я делаю это

for i := 0 to List.Count - 1 do
  begin
    List.Item[i].Terminate;
  end;
  aCounter.Free;
  aQueue.Free;

При этом приложение зависает. Это правильный подход или я что-то упустил?

Я использую 10,2 Токио

Изменить 1:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type

  TMyConsumerItem = class(TThread)
  private
    FQueue : TThreadedQueue<TProc>;
    FSignal : TCountDownEvent; 
  protected
    procedure Execute; override;
  public
    constructor Create( aQueue : TThreadedQueue<TProc>; aSignal : TCountdownEvent);
  end;


  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure StopClick(Sender: TObject);
  private
    { Private declarations }
    List: TObjectList<TMyConsumerItem>;
    aQueue: TThreadedQueue<TProc>;
    aCounter: TCountDownEvent;
    procedure DoSomeJob( myListItems : TStringList);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  SyncObjs, Generics.Collections;

{- Include TMyConsumerItem class here }

procedure TForm1.Button1Click(Sender: TObject);
var
  aList : TStringList;
  i : Integer;
begin
  aList := TStringList.Create;
  Screen.Cursor := crHourGlass;
  try
    for i := 1 to 20 do aList.Add(IntToStr(i));
    DoSomeJob(aList);
  finally
    aList.Free;
    Screen.Cursor := crDefault;
  end;
end;

procedure TForm1.StopClick(Sender: TObject);
begin
  for i := 0 to List.Count - 1 do
  begin
    List.Item[i].Terminate;
  end;
  List.Free;
  aCounter.WaitFor;
  aCounter.Free;
  aQueue.Free;
end;

procedure TForm1.DoSomeJob(myListItems: TStringList);
const
  cThreadCount = 10;
  cMyQueueDepth = 100;
var
  i: Integer;

  function CaptureJob(const aString: string): TProc;
  begin
    Result :=
      procedure
      var
        i,j : Integer;
      begin
        // Do some job with aString
        for i := 0 to 1000000 do
          j := i;
        // Report status to main thread
        TThread.Synchronize(nil,
          procedure
          begin
            Memo1.Lines.Add('Job with:'+aString+' done.');
          end
        );

      end;
  end;
var
  aThread : TThread;
begin
  List := TObjectList<TMyConsumerItem>.Create();
  List.OwnsObjects := False;
  aQueue := TThreadedQueue<TProc>.Create(cMyQueueDepth);
  aCounter := TCountDownEvent.Create(cThreadCount);
  try
    for i := 1 to cThreadCount do
       List.Add(TMyConsumerItem.Create(aQueue, aCounter));
    for i := 0 to myListItems.Count - 1 do
    begin
      aQueue.PushItem(CaptureJob(myListItems[i]));
    end;
  finally

  end;
end;


constructor TMyConsumerItem.Create(aQueue: TThreadedQueue<TProc>; aSignal : TCountDownEvent);
begin
 Inherited Create(false);
 Self.FreeOnTerminate := true;
 FQueue := aQueue;
 FSignal := aSignal;
end;

procedure TMyConsumerItem.Execute;
var
aProc : TProc;
begin
 try
 repeat
  FQueue.PopItem(aProc);
  aProc();
 until Terminated;
 finally
  FSignal.Signal;
 end;
end;
end.

Answer 1

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

1. Ссылка на самозавершающуюся ветку неверна. Удалить List, так как это бесполезно.
2. Чтобы завершить очередь позже, сделайте aQueue Глобальный.
3. Чтобы завершить пул потоков, добавьте в очередь столько пустых задач, сколько имеется потоков.
4. Ниже приведен пример того, как может быть реализован метод stop. Обратите внимание, что оба aCounter а также aQueue должен быть глобальным по объему. Отказ от ответственности не проверен, а не перед компилятором в данный момент.
5. Если вам нужно прервать текущую работу в рабочих заданиях, вам нужно будет предоставить ссылку на глобальный (в области действия) флаг с каждой задачей и дать сигнал о завершении задачи.
6. Существуют и другие библиотеки, которые могут выполнять аналогичную работу, см. Delphi PPL или хорошо зарекомендовавшую себя библиотеку OTL.

---

procedure TForm1.StopClick(Sender: TObject);
var
  i : Integer;
  aThread : TThread;
begin
  // Kill the worker threads by pushing nil
  for i := 1 to cThreadCount do
    aQueue.PushItem(nil);

  // Since the worker threads synchronizes with the main thread,
  // we must wait for them in another thread.
  aThread := TThread.CreateAnonymousThread(
    procedure
    begin
      aCounter.WaitFor; // Wait for threads to finish
      aCounter.Free;
      aQueue.Free;
    end
  );
  aThread.FreeOnTerminate := false;
  aThread.Start;
  aThread.WaitFor;  // Safe to wait for the anonymous thread
  aThread.Free;
end;

Answer 2

Terminate только устанавливает Terminated свойство к истине. Важно, чтобы внутренний цикл потока проверял Terminated имущество периодически и возвращается с Execute метод, когда он установлен в true. После этого используйте WaitFor в основном потоке, чтобы проверить, все ли потоки закончились, прежде чем вы освободите очередь или объекты пула потоков.