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.