使用 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.

欢迎任何想法。

德尔福 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

因为您在终止时使线程自行释放，所以您要求它在完成后立即销毁自身的所有痕迹。由于您无法影响它何时结束，因此在启动后引用线程内的任何内容是错误的。

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

但是，还有另一种方法。

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 3

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

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

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

所以：

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 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;