Delphi VCL Form testing using DUnitX Framework (thread problem)

Question

I'm doing GUI testing using DUnitX framework. And I run into a problem with threads.

Here is simple demonstration on demo what is the problem. My form have one button and one label. Button starts MyThread and changes label caption from 'Press start' to 'Thread started...'. And MyThreadTerminate again changes label caption to 'Thread finished!'.

Here is my unit:

unit Unit1;

interface

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

type
  TMyThread = class(TThread)
  protected
    procedure Execute; override;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    MyThread: TMyThread;
    procedure MyThreadTerminate(Sender: TObject);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TMyThread }

procedure TMyThread.Execute;
var
  i: Integer;
begin
  for i := 1 to 3 do
    sleep(750);
  if Terminated then
    Exit;
end;

{ TMainForm }

procedure TForm1.Button1Click(Sender: TObject);
begin
  Button1.Enabled := False;
  Label1.Caption := 'Thread started...';

  MyThread := TMyThread.Create(True);
  MyThread.OnTerminate := MyThreadTerminate;
  MyThread.Start;
end;

procedure TForm1.MyThreadTerminate(Sender: TObject);
begin
  Button1.Enabled := True;
  Label1.Caption := 'Thread finished!';
end;

end.

And dfm:

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 442
  ClientWidth = 628
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -12
  Font.Name = 'Segoe UI'
  Font.Style = []
  TextHeight = 15
  object Label1: TLabel
    Left = 104
    Top = 176
    Width = 147
    Height = 45
    Alignment = taCenter
    Caption = 'Press start'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -33
    Font.Name = 'Segoe UI'
    Font.Style = []
    ParentFont = False
  end
  object Button1: TButton
    Left = 248
    Top = 80
    Width = 113
    Height = 65
    Caption = 'Start'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -33
    Font.Name = 'Segoe UI'
    Font.Style = []
    ParentFont = False
    TabOrder = 0
    OnClick = Button1Click
  end
end 

That works fine in unit that I'm testing but it doesnt work fine in DUnitX project. MyThreadTerminate procedure is never executed because MyThreadTerminate.OnTerminated event never happens because thread stucks on this line:

TMonitor.Wait(SyncProcPtr.Signal, ThreadLock, INFINITE)

Here is my test unit:

unit TestUnit;

interface

uses
  DUnitX.TestFramework, vcl.Forms;

type
  [TestFixture]
  TMyTestObject = class
  public
    [Setup]
    procedure Setup;
    [TearDown]
    procedure TearDown;

    [Test]
    procedure Test1;

  end;

implementation

uses Unit1;

procedure TMyTestObject.Setup;
begin
  Unit1.Form1 := TForm1.Create(Application);
end;

procedure TMyTestObject.TearDown;
begin
  Unit1.Form1.Free();
end;

procedure TMyTestObject.Test1;
var
  Status: String;
begin
  Unit1.Form1.Button1Click(nil);
  Status := 'Thread in test finished!';
end;


initialization
  TDUnitX.RegisterTestFixture(TMyTestObject);

end.

And test project dpr file:

program Project2;

{$IFNDEF TESTINSIGHT}
{$APPTYPE CONSOLE}
{$ENDIF}
{$STRONGLINKTYPES ON}
uses
  System.SysUtils,
  {$IFDEF TESTINSIGHT}
  TestInsight.DUnitX,
  {$ELSE}
  DUnitX.Loggers.Console,
  DUnitX.Loggers.Xml.NUnit,
  {$ENDIF }
  DUnitX.TestFramework,
  TestUnit in 'TestUnit.pas';

{$IFNDEF TESTINSIGHT}
var
  runner: ITestRunner;
  results: IRunResults;
  logger: ITestLogger;
  nunitLogger : ITestLogger;
{$ENDIF}
begin
{$IFDEF TESTINSIGHT}
  TestInsight.DUnitX.RunRegisteredTests;
{$ELSE}
  try
    //Check command line options, will exit if invalid
    TDUnitX.CheckCommandLine;
    //Create the test runner
    runner := TDUnitX.CreateRunner;
    //Tell the runner to use RTTI to find Fixtures
    runner.UseRTTI := True;
    //When true, Assertions must be made during tests;
    runner.FailsOnNoAsserts := False;

    //tell the runner how we will log things
    //Log to the console window if desired
    if TDUnitX.Options.ConsoleMode <> TDunitXConsoleMode.Off then
    begin
      logger := TDUnitXConsoleLogger.Create(TDUnitX.Options.ConsoleMode = TDunitXConsoleMode.Quiet);
      runner.AddLogger(logger);
    end;
    //Generate an NUnit compatible XML File
    nunitLogger := TDUnitXXMLNUnitFileLogger.Create(TDUnitX.Options.XMLOutputFile);
    runner.AddLogger(nunitLogger);

    //Run tests
    results := runner.Execute;
    if not results.AllPassed then
      System.ExitCode := EXIT_ERRORS;

    {$IFNDEF CI}
    //We don't want this happening when running under CI.
    if TDUnitX.Options.ExitBehavior = TDUnitXExitBehavior.Pause then
    begin
      System.Write('Done.. press <Enter> key to quit.');
      System.Readln;
    end;
    {$ENDIF}
  except
    on E: Exception do
      System.Writeln(E.ClassName, ': ', E.Message);
  end;
{$ENDIF}
end.

Could anyone help me with this? I know that DUnitX is not best solution for GUI testing but is there any solution?