Блок-тест Delphi для TThread с FreeOnTerminate = True

Question

Каков наилучший способ написать тест Delphi DUnit для потомка TThread, когда FreeOnTerminate = True? Потомок 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 по OnTerminate EventHandler.

Кроме того, ваша логика конструктора немного грязная, так как вы не должны инициализировать поле до вызова унаследованного конструктора.

Итак:

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; 

Это должно сделать работу.

EDIT: Исправленные глупые исправления, протестированные, работает.

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; 

---

Update, так как 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;