使用FreeOnTerminate = True的TThread的Delphi单元测试

Question

当FreeOnTerminate = True时，为TThread后代编写Delphi DUnit测试的最佳方法是什么？ TThread后代返回一个我需要测试的引用，但我无法弄清楚如何等待线程在测试中完成...

unit uThreadTests;

interface

uses
  Classes, TestFramework;

type

  TMyThread = class(TThread)
  strict private
    FId: Integer;
  protected
    procedure Execute; override;
  public
    constructor Create(AId: Integer);
    property Id: Integer read FId;
  end;

  TestTMyThread = class(TTestCase)
  strict private
    FMyId: Integer;
    procedure OnThreadTerminate(Sender: TObject);
  protected
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestMyThread;
  end;

implementation

{ TMyThread }

constructor TMyThread.Create(AId: Integer);
begin
  FreeOnTerminate := True;
  FId := AId;

  inherited Create(False);
end;

procedure TMyThread.Execute;
begin
  inherited;

  FId := FId + 1;
end;

{ TestTMyThread }

procedure TestTMyThread.TestMyThread;
//var
//  LThread: TMyThread;
begin
//  LThread := TMyThread.Create(1);
//  LThread.OnTerminate := OnThreadTerminate;
//  LThread.WaitFor;
//  CheckEquals(2, FMyId);
//  LThread.Free;
///// The above commented out code is only useful of FreeOnTerminate = False;

  with TMyThread.Create(1) do
  begin
    OnTerminate := OnThreadTerminate;
    WaitFor; /// Not sure how else to wait for the thread to finish?
  end;

  CheckEquals(2, FMyId);
end;

procedure TestTMyThread.OnThreadTerminate(Sender: TObject);
begin
  FMyId := (Sender as TMyThread).Id;
end;  /// When FreeOnTerminate = True - THIS LINE CAUSES ERROR: Thread Error the handle is invalid

procedure TestTMyThread.SetUp;
begin
  inherited;

end;

procedure TestTMyThread.TearDown;
begin
  inherited;

end;

initialization
  RegisterTests([TestTMyThread.Suite]);


end.

任何想法都会受到欢迎。

Delphi 2010。

Answer 1

对线程进行子类化以使其更易于测试。 TThread和TObject提供了足够的钩子，您可以添加感知变量以观察它是否达到了您希望它具有的状态。

我看到您可能希望测试的这个特定类的三个方面：

1. 它根据发送给构造函数的值计算其Id属性的值。
2. 它计算新线程中的新Id属性，而不是调用构造函数的线程。
3. 它完成后会释放自己。

所有这些东西都可以从子类中测试，但是如果不对线程的接口进行更改则很难测试。 （到目前为止，所有其他答案都需要更改线程的接口，例如通过添加更多构造函数参数或通过更改它自己启动的方式。这可能会使线程更难，或者至少更麻烦，在真实程序中使用。）

type
  PTestData = ^TTestData;
  TTestData = record
    Event: TEvent;
    OriginalId: Integer;
    FinalId: Integer;
  end;

  TTestableMyThread = class(TMyThread)
  private
    FData: PTestData;
  public
    constructor Create(AId: Integer; AData: PTestData);
    destructor Destroy; override;
    procedure AfterConstruction; override;
  end;

constructor TTestableMyThread.Create(AId: Integer; const AData: PTestData);
begin
  inherited Create(AId);
  FData := AData;
end;

destructor TestableMyThread.Destroy;
begin
  inherited;
  FData.FinalId := Id;
  // Tell the test that the thread has been freed
  FData.Event.SetEvent;
end;

procedure TTestableMyThread.AfterConstruction;
begin
  FData.OriginalId := Id;
  inherited; // Call this last because this is where the thread starts running
end;

使用该子类，可以编写一个检查前面确定的三个质量的测试：

procedure TestTMyThread.TestMyThread;
var
  Data: TTestData;
  WaitResult: TWaitResult;
begin
  Data.OriginalId := -1;
  Data.FinalId := -1;
  Data.Event := TSimpleEvent.Create;
  try
    TTestableMyThread.Create(1, @Data);

    // We don't free the thread, and the event is only set in the destructor,
    // so if the event is signaled, it means the thread freed itself: That
    // aspect of the test implicitly passes. We don't want to wait forever,
    // though, so we fail the test if we have to wait too long. Either the
    // Execute method is taking too long to do its computations, or the thread
    // isn't freeing itself.
    // Adjust the timeout based on expected performance of Execute.
    WaitResult := Data.Event.WaitFor(5000);
    case WaitResult of
      wrSignaled: ; // This is the expected result
      wrTimeOut: Fail('Timed out waiting for thread');
      wrAbandoned: Fail('Event was abandoned');
      wrError: RaiseLastOSError(Data.Event.LastError);
      else Fail('Unanticipated error waiting for thread');
    end;

    CheckNotEquals(2, Data.OriginalId,
      'Didn''t wait till Execute to calculate Id');
    CheckEquals(2, Data.FinalId,
      'Calculated wrong Id value');
  finally
    Data.Event.Free;
  end;
end;

Answer 2

创建处于挂起状态的线程，然后设置OnTerminate，最后设置Resume线程。

在您的测试类中，定义一个私有布尔字段FThreadDone，该字段由false初始化，并由true Eventhandler设置为OnTerminate。

此外，您的构造函数逻辑有点脏，因为您不应在调用继承的构造函数之前初始化字段。

所以：

constructor TMyThread.Create(AId: Integer);
begin
  inherited Create(true);
  FreeOnTerminate := True;
  FId := AId;
end;
...
procedure TestTMyThread.TestMyThread;
begin
  FThreadDone := False;
  with TMyThread.Create(1) do begin // Note: Thread is suspended...
    OnTerminate := OnThreadTerminate;
    // Resume;                         // ... and finally started here!
    Start;

  end;
  While not FThreadDone do Application.ProcessMessages;
  CheckEquals(2, FMyId);
end;

procedure TestTMyThread.OnThreadTerminate(Sender: TObject);
begin
  FMyId := (Sender as TMyThread).Id;
  FThreadDone := True;
end;

这应该可以胜任。

编辑：纠正了愚蠢的更正，经过测试，有效。

Answer 3

因为你在终止时让线程自由，所以你已经要求它在完成后立即销毁它自己的所有痕迹。由于你无法对它何时完成施加影响，因此在启动它之后引用线程内的任何内容都是错误的。

其他人提出的解决方案，即要求线程在终止时向您发出信号，这是很好的。我个人可能会选择这样做。如果您将事件用作信号，那么您可以等待该事件。

然而，还有另一种方法可以做到。

1. 创建暂停的线程。
2. 复制线程句柄。
3. 启动帖子。
4. 等待重复的句柄。

因为您拥有重复的句柄而不是线程，所以您可以安全地等待它。它看起来有点复杂，但我认为它避免了创建一个不需要的额外同步对象。请注意，我并不是主张使用事件来表示完成的方法。

无论如何，这是一个简单的想法演示。

{$APPTYPE CONSOLE}

uses
  SysUtils, Windows, Classes;

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

destructor TMyThread.Destroy;
begin
  Writeln('I''m dead!');
  inherited;
end;

procedure TMyThread.Execute;
begin
end;

var
  DuplicatedHandle: THandle;

begin
  with TMyThread.Create(True) do // must create suspended
  begin
    FreeOnTerminate := True;
    Win32Check(DuplicateHandle(
      GetCurrentProcess,
      Handle,
      GetCurrentProcess,
      @DuplicatedHandle,
      0,
      False,
      DUPLICATE_SAME_ACCESS
    ));
    Start;
  end;

  Sleep(500);
  Writeln('I''m waiting');
  if WaitForSingleObject(DuplicatedHandle, INFINITE)=WAIT_OBJECT_0 then
    Writeln('Wait succeeded');
  CloseHandle(DuplicatedHandle);
  Readln;
end.

Answer 4

以下是使用匿名线程的示例。

• 创建了一个事件（TSimpleEvent）
• 匿名线程执行测试线程和
• 等待事件，该信号在测试线程的OnTerminate处理程序中发出信号
• 匿名线程处于暂停状态，直到使用WaitFor
执行
• 结果由OnTerminate处理程序
选取

这里重要的是事件在一个线程中等待。没有死锁的情况。

---

Uses
  SyncObjs;

type

  TMyThread = class(TThread)
  private
    FId : Integer;
  protected
    procedure Execute; override;
  public
    constructor Create( anInt : Integer);
    property Id : Integer read FId;
  end;

  TestTMyThread = class
  strict private
    FMyId: Integer;
    FMyEvent : TSimpleEvent;
    procedure OnThreadTerminate(Sender: TObject);
  protected
  public
    procedure TestMyThread;
  end;

{ TMyThread }

constructor TMyThread.Create(anInt : Integer);
begin
  inherited Create(True);
  FreeOnTerminate := True;
  FId := anInt;
end;

procedure TMyThread.Execute;
begin
  Inc(FId);
end;

procedure TestTMyThread.TestMyThread;
var
  AnonThread : TThread;
begin
  FMyEvent := TSimpleEvent.Create(nil,true,false,'');
  try
    AnonThread :=
      TThread.CreateAnonymousThread(
        procedure
        begin
          With TMyThread.Create(1) do
          begin
            OnTerminate := Self.OnThreadTerminate;
            Start;
          end;
          FMyEvent.WaitFor; // Wait until TMyThread is ready
        end
      );
    AnonThread.FreeOnTerminate := False;
    AnonThread.Start;

    AnonThread.WaitFor; // Wait here until test is ready
    AnonThread.Free;

    Assert(FMyId = 2); // Check result
  finally
    FMyEvent.Free;
  end;
end;

procedure TestTMyThread.OnThreadTerminate(Sender: TObject);
begin
  FMyId := (Sender as TMyThread).Id;
  FMyEvent.SetEvent; // Signal TMyThread ready
end;

---

更新，因为Delphi-2010没有匿名线程类，这里有一个你可以实现的替代方法：

Type
  TMyAnonymousThread = class(TThread)
    private
      FProc : TProc;
    protected
      procedure Execute; override;
    public
      constructor Create(CreateSuspended,SelfFree: Boolean; const aProc: TProc);
  end;

constructor TMyAnonymousThread.Create(CreateSuspended,SelfFree: Boolean; 
  const aProc: TProc);
begin
  Inherited Create(CreateSuspended);
  FreeOnTerminate := SelfFree;
  FProc := aProc;
end;

procedure TMyAnonymousThread.Execute;
begin
  FProc();
end;