delphi thread waitfor infinite (never terminate)

Question

I'm waiting for the Thread to finish, but without success, it gets stuck in the WaitFor () method; and does not return, standing there indefinitely.

procedure TForm1.btnStopClick(Sender: TObject);

Can anyone help me?

I am using Delphi Berlin 10.1 Update 2, running on a Windows 10 64-bit version 1709 16299.64

follows the code:

unit untPrincipal;

interface

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

const
   WM_TEST_SERVICE = WM_APP + 1;

type
   TForm1 = class(TForm)
      btnStart: TButton;
      mmoOutput: TMemo;
      btnStop: TButton;
      procedure btnStartClick(Sender: TObject);
      procedure btnStopClick(Sender: TObject);
   private
      { Private declarations }
      threadService: TThread;
      procedure OnThreadTerminate(Sender: TObject);
      procedure WMTestService(var msg: TMessage); message WM_TEST_SERVICE;
   public
      { Public declarations }
   end;

   IThreadInfo = interface
      ['{B179712B-8B14-4D54-86DA-AB22227DBCAA}']
      function IsRunning: Boolean;
   end;

   IService = interface
      ['{30934A11-1FB9-46CB-8403-F66317B50199}']
      procedure ServiceCreate();
      procedure ServiceStart(const info: IThreadInfo);
   end;

   TMyService = class(TInterfacedObject, IService)
   private
      handle: THandle;
   public
      constructor Create(const handle: THandle);
      procedure ServiceCreate;
      procedure ServiceStart(const info: IThreadInfo);
   end;

   TThreadService = class(TThread)
   private
      service: IService;
   protected
      procedure Execute; override;
   public
      constructor Create(const service: IService);
   end;

   TThreadInfo = class(TInterfacedObject, IThreadInfo)
   private
      thread: TThread;
   public
      constructor Create(const thread: TThread);
      function IsRunning: Boolean;
   end;

   TThreadPost = class(TThread)
   private
      handle: THandle;
      info: IThreadInfo;
   protected
      procedure Execute; override;
   public
      constructor Create(const handle: THandle; const info: IThreadInfo);
   end;

var
   Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.btnStartClick(Sender: TObject);
var
   service: IService;
begin
   service := TMyService.Create(Self.handle);
   threadService := TThreadService.Create(service);
   threadService.OnTerminate := OnThreadTerminate;
   threadService.Start;
end;

procedure TForm1.btnStopClick(Sender: TObject);
begin
   if Assigned(threadService) then
   begin
      try
         threadService.Terminate;
         threadService.WaitFor;
      finally
         if Assigned(threadService) then
            FreeAndNil(threadService);
      end;
   end;
end;

procedure TForm1.OnThreadTerminate(Sender: TObject);
begin
   mmoOutput.Lines.Add(DateTimeToStr(Now()) + ' - procedure TForm1.OnThreadTerminate(Sender: TObject);');
end;

procedure TForm1.WMTestService(var msg: TMessage);
begin
   mmoOutput.Lines.Add(DateTimeToStr(Now()) + ' - Service');
end;

{ TMyService }

constructor TMyService.Create(const handle: THandle);
begin
   inherited Create();
   Self.handle := handle;
end;

procedure TMyService.ServiceCreate;
begin
   PostMessage(handle, WM_TEST_SERVICE, 0, 0);
end;

procedure TMyService.ServiceStart(const info: IThreadInfo);
var
   thread: TThreadPost;
begin
   while info.IsRunning do
   begin
      thread := TThreadPost.Create(handle, info);
      try
         thread.Start;
         thread.WaitFor;
         ShowMessage('Never Execute');
      finally
         thread.Free;
      end;
   end;
end;

{ TThreadService }

constructor TThreadService.Create(const service: IService);
begin
   inherited Create(True);
   Self.service := service;
end;

procedure TThreadService.Execute;
begin
   service.ServiceCreate;
   service.ServiceStart(TThreadInfo.Create(Self) as IThreadInfo);
end;

{ TThreadInfo }

constructor TThreadInfo.Create(const thread: TThread);
begin
   inherited Create();
   Self.thread := thread;
end;

function TThreadInfo.IsRunning: Boolean;
begin
   Result := not thread.CheckTerminated;
end;

{ TThreadPost }

constructor TThreadPost.Create(const handle: THandle; const info: IThreadInfo);
begin
   inherited Create(True);
   Self.handle := handle;
   Self.info := info;
end;

procedure TThreadPost.Execute;
begin
   while info.IsRunning do
   begin
      PostMessage(handle, WM_TEST_SERVICE, 0, 0);
      Sleep(1000);
   end;
end;

end.

Answer 1

You are calling:

function TThreadInfo.IsRunning: Boolean;
begin
   Result := not thread.CheckTerminated;
end;

from TThreadPost.Execute, which tries to check if thread instance is terminated or not.

The problem is that the call to CheckTerminated uses the current thread terminated status, not the thread instance. (Think what would have happened if the thread instance was terminated and freed at the time when thread.CheckTerminated was called, if that was possible).

The result is that IsRunning never will be false, and you will have an endless loop. You will have to redesign how to stop the threads in a safe manner.

Answer 2

before we start anything here please next time start the names of fields in your class with an 'F'.

Let's go through your code step by step starting with the first user action

procedure TForm1.btnStartClick(Sender: TObject);

1. service := TMyService.Create(Self.handle);

you create an instance of TMyService and assign TForm.Handle to the field handle (which you should name FHandle).

2. threadService := TThreadService.Create(service);

you create a suspended instance of TThread and assign service to its private field service (again you should name it FServiceand you do not need to use self)

one thing is that the reference this time is kept unlike the first line where the reference dies/lost at end of scope.

3. threadService.OnTerminate := OnThreadTerminate;

assign Onterminate event handler.

Onterminate uses synchronize() internally so this could be the cause of the deadlock. (<--- future bug prone one)

4. threadService.Start;

you start the suspended threadService.

at this point now you have two threads running the MainThread and the threadService (MyService runs in the context of the MainThread).

the MainThread is Idle waiting for more user action or handling other messages (i.e: repaint, resize, move form....etc).

threadService is running its execute method.

now let's follow what is the TThreadService.Execute; doing

1. service.ServiceCreate;

here you post a message to handle == TForm.Handle (<--future bug prone two)

2. service.ServiceStart(TThreadInfo.Create(Self) as IThreadInfo);

   2.1 while info.IsRunning do

your problem is here because info.IsRunning checks for the terminate flag in the current thread (internally otherwise an exception will be raised) which is threadService (<-- future error prone three).

 2.2 **the catastrophe code**

    begin
      thread := TThreadPost.Create(handle, info);
      try
         thread.Start;
         thread.WaitFor;
         ShowMessage('Never Execute');
      finally
         thread.Free;
      end;
   end;

here you create TThreadPost which is another thread and start it. then you call waitfor on it locking TThreadService. so now you have three threads running: the MainThread (Idle), threadService (deadlocked) and a TThreadPost (loose).

In the TThreadPost execute method there is another while info.IsRunning do

checking for the terminate flag but it is the TThreadPost's one not the threadService one.

so when the user hits Stop button the waitfor call in the MainThread is waiting on a deadlocked thread.

as a solution you do as LU RD said (I was writing my answer when he posted his).