Unittest von OnWhatever Events?

[Stevie]

Hatte vor einiger Zeit schonmal was in DSharp für async/await in Delphi zusammen gebaut, was mir hier in abgewandelter Form nützlich erschien:

Delphi-Quellcode:

unit Unit1;

interface

uses
  MyDings,
  SyncObjs,
  TestFramework;

type
  TDingsTest = class(TTestCase)
  private
    fSUT: TMyDings;
    fInitDoneEvent: TEvent;
    procedure HandleInitDone(Sender: TObject);
  protected
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure OnInitDone_Is_Fired_Within_Ten_Seconds_After_Calling_Init;
  end;

implementation

uses
  Classes,
  Diagnostics,
  Forms,
  Math,
  Windows;

function WaitFor(handle: THandle; timeout: Cardinal): TWaitResult;
var
  handles: array[0..1] of THandle;
  stopwatch: TStopwatch;
begin
  if GetCurrentThreadId = MainThreadID then
  begin
    handles[0] := handle;
    handles[1] := SyncEvent;
    stopwatch := TStopwatch.StartNew;
    repeat
      case MsgWaitForMultipleObjects(2, handles, False, IfThen(timeout = INFINITE,
        INFINITE, timeout - stopwatch.ElapsedMilliseconds), QS_ALLINPUT) of
        WAIT_OBJECT_0: Exit(wrSignaled);
        WAIT_OBJECT_0 + 1: CheckSynchronize;
        WAIT_OBJECT_0 + 2: Application.ProcessMessages;
        WAIT_ABANDONED: Exit(wrAbandoned);
        WAIT_FAILED: Exit(wrError);
      end;
    until stopwatch.ElapsedMilliseconds >= timeout;
    Result := wrTimeout;
  end
  else
    case WaitForSingleObject(handle, timeout) of
      WAIT_OBJECT_0: Result := wrSignaled;
      WAIT_ABANDONED: Result := wrAbandoned;
      WAIT_TIMEOUT: Result := wrTimeout;
    else
      Result := wrError;
    end;
end;

{ TDingsTest }

procedure TDingsTest.HandleInitDone(Sender: TObject);
begin
  fInitDoneEvent.SetEvent;
end;

procedure TDingsTest.OnInitDone_Is_Fired_Within_Ten_Seconds_After_Calling_Init;
begin
  fSUT.Init;
  CheckTrue(WaitFor(fInitDoneEvent.Handle, 10000) = wrSignaled);
end;

procedure TDingsTest.Setup;
begin
  fSUT := TMyDings.Create;
  fSUT.OnInitDone := HandleInitDone;
  fInitDoneEvent := TEvent.Create;
end;

procedure TDingsTest.Teardown;
begin
  fInitDoneEvent.Free;
  fSUT.Free;
end;

initialization
  RegisterTest(TDingsTest.Suite);

end.