Gracefully terminating all the threads

Question

I am using this in one of my solution

My requirement is to clear the queue and kill all the threads gracefully when Stop button is clicked.

For this I created an ObjectList

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

Later I made this modification:

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

And on Stop button button click I am doing this

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

While doing this I application is getting hanged. Is this the correct approach or am I missing something?

I am using 10.2 Tokyo

Edit 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

Terminate only sets the Terminated property to true. It's important that the internal loop of the thread checks the Terminated property periodically, and returns from the Execute method when it is set to true. After that, use WaitFor in the main thread to check the threads have all ended before you free queue or thread-pool objects.

Answer 2

You left out some important stuff regarding how the job queue works and how to interact with the threadpool.

1. Taking a reference to a thread that is self-terminating is wrong. Remove the List, since it is useless.
2. In order to finish the queue at a later point, make aQueue global.
3. To finish the threadpool, add as many empty tasks to the queue as there are threads.
4. See example below how a stop method could be implemented. Note that both aCounter and aQueue must be global in scope. Disclaimer untested, not in front of a compiler at the moment.
5. If you need to abort ongoing work in the job tasks, you will have to provide a reference to a global (in scope) flag with each job task, and signal to end the task.
6. There are other libraries that can perform similar work, see Delphi PPL or the well proven OTL library.

---

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;