fbintf/testsuite/Test10.pas

unit Test10;
{$IFDEF MSWINDOWS} 
{$DEFINE WINDOWS} 
{$ENDIF}

{$IFDEF FPC}
{$mode delphi}
{$codepage utf8}
{$ENDIF}

{Test 10: Event Handling}

{
  This test opens the employee example databases with the supplied user name/password
  and then tests event handling.

  1. Simple wait for async event.

  2. Signal two more events to show that events counts are maintained.

  3. Async Event wait followed by signal event. Event Counts should include all
     previous events.

  4. Demonstrate event cancel by waiting for event, cancelling it and then signalling
     event. No change to signal flag after waiting in a tight loop implies event cancelled.

  5. Wait for sync Event.
}

interface

uses
  Classes, SysUtils, TestManager, IB;

type

{ TTest10 }

  TTest10 = class(TTestBase)
  private
    FEventSignalled: boolean;
    procedure EventsTest(Attachment: IAttachment);
    procedure EventReport(Sender: IEvents);
    procedure ShowEventCounts(Intf: IEvents);
  public
    function TestTitle: AnsiString; override;
    procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
  end;


implementation

{ TTest10 }

const
  sqlEvent = 'Execute Block As Begin Post_Event(''TESTEVENT''); End';

procedure TTest10.EventsTest(Attachment: IAttachment);
var EventHandler: IEvents;
    i: integer;
    WaitCount: integer;
begin
  FEventSignalled := false;
  EventHandler := Attachment.GetEventHandler('TESTEVENT');
  writeln(OutFile,'Call Async Wait');
  EventHandler.AsyncWaitForEvent(EventReport);
  writeln(OutFile,'Async Wait Called');
  sleep(500);
  if FEventSignalled then
  begin
    writeln(OutFile,'First Event - usually ignored');
    FEventSignalled := false;
    EventHandler.AsyncWaitForEvent(EventReport);
    sleep(100);
    if FEventSignalled then
    begin
      writeln(OutFile,'Unexpected Event 1');
      Exit;
    end;
  end;
  writeln(OutFile,'Signal Event');
  Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
  while not FEventSignalled do Sleep(50);
  ShowEventCounts(EventHandler);
  FEventSignalled := false;

  writeln(OutFile,'Two more events');
  Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
  Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
  if FEventSignalled then
  begin
    writeln(OutFile,'Unexpected Event 2');
    FEventSignalled := false
  end;
  writeln(OutFile,'Call Async Wait');
  EventHandler.AsyncWaitForEvent(EventReport);
  writeln(OutFile,'Async Wait Called');
  sleep(500);
  if FEventSignalled then
  begin
    writeln(OutFile,'Deferred Events Caught');
    ShowEventCounts(EventHandler);
    FEventSignalled := false;
    EventHandler.AsyncWaitForEvent(EventReport);
    sleep(100);
    if FEventSignalled then
      writeln(OutFile,'Unexpected Event 3');
  end;
  writeln(OutFile,'Signal Event');
  Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
  while not FEventSignalled do;
  ShowEventCounts(EventHandler);

  FEventSignalled := false;
  writeln(OutFile,'Async Wait: Test Cancel');
  EventHandler.AsyncWaitForEvent(EventReport);
  writeln(OutFile,'Async Wait Called');
  EventHandler.Cancel;
  writeln(OutFile,'Event Cancelled');
  FEventSignalled := false;
  Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
  WaitCount := 100000000;
  while not FEventSignalled and (WaitCount > 0) do Dec(WaitCount);
  if WaitCount = 0 then writeln(OutFile,'Time Out - Cancel Worked!')
  else
    writeln(OutFile,'Event called - so Cancel failed');

  writeln(OutFile,'Sync wait');
  Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
  EventHandler.WaitForEvent;
  writeln(OutFile,'Event Signalled');
  ShowEventCounts(EventHandler);
  EventHandler := nil;
end;

procedure TTest10.EventReport(Sender: IEvents);
begin
  FEventSignalled := true;
  writeln(OutFile,'Event Signalled');
end;

procedure TTest10.ShowEventCounts(Intf: IEvents);
var
  i: integer;
  EventCounts: TEventCounts;
begin
  EventCounts := Intf.ExtractEventCounts;
  for i := 0 to length(EventCounts) - 1 do
    writeln(OutFile,'Event Counts: ',EventCounts[i].EventName,', Count = ',EventCounts[i].Count);
end;

function TTest10.TestTitle: AnsiString;
begin
  Result := 'Test 10: Event Handling';
end;

procedure TTest10.RunTest(CharSet: AnsiString; SQLDialect: integer);
var Attachment: IAttachment;
    DPB: IDPB;
begin
  DPB := FirebirdAPI.AllocateDPB;
  DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
  DPB.Add(isc_dpb_password).setAsString(' ');
  DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
  DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
  DPB.Find(isc_dpb_password).setAsString(Owner.GetPassword);
  Attachment := FirebirdAPI.OpenDatabase(Owner.GetEmployeeDatabaseName,DPB);
  EventsTest(Attachment);
  Attachment.Disconnect;
end;

initialization
  RegisterTest(TTest10);

end.

Revision:	56
Committed:	Mon Mar 6 10:20:02 2017 UTC (7 years, 9 months ago) by tony
Content type:	text/x-pascal
File size:	4974 byte(s)
Log Message:	Committing updates for Trunk
#	User	Rev	Content
1	tony	45	unit Test10;
2	tony	56	{$IFDEF MSWINDOWS}
3			{$DEFINE WINDOWS}
4			{$ENDIF}
5	tony	45
6	tony	56	{$IFDEF FPC}
7			{$mode delphi}
8	tony	45	{$codepage utf8}
9	tony	56	{$ENDIF}
10	tony	45
11			{Test 10: Event Handling}
12
13			{
14			This test opens the employee example databases with the supplied user name/password
15			and then tests event handling.
16
17			1. Simple wait for async event.
18
19			2. Signal two more events to show that events counts are maintained.
20
21			3. Async Event wait followed by signal event. Event Counts should include all
22			previous events.
23
24			4. Demonstrate event cancel by waiting for event, cancelling it and then signalling
25			event. No change to signal flag after waiting in a tight loop implies event cancelled.
26
27			5. Wait for sync Event.
28			}
29
30			interface
31
32			uses
33			Classes, SysUtils, TestManager, IB;
34
35			type
36
37			{ TTest10 }
38
39			TTest10 = class(TTestBase)
40			private
41			FEventSignalled: boolean;
42			procedure EventsTest(Attachment: IAttachment);
43			procedure EventReport(Sender: IEvents);
44	tony	47	procedure ShowEventCounts(Intf: IEvents);
45	tony	45	public
46	tony	56	function TestTitle: AnsiString; override;
47			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
48	tony	45	end;
49
50
51			implementation
52
53			{ TTest10 }
54
55			const
56			sqlEvent = 'Execute Block As Begin Post_Event(''TESTEVENT''); End';
57
58			procedure TTest10.EventsTest(Attachment: IAttachment);
59			var EventHandler: IEvents;
60			i: integer;
61			WaitCount: integer;
62			begin
63	tony	47	FEventSignalled := false;
64	tony	45	EventHandler := Attachment.GetEventHandler('TESTEVENT');
65			writeln(OutFile,'Call Async Wait');
66	tony	56	EventHandler.AsyncWaitForEvent(EventReport);
67	tony	45	writeln(OutFile,'Async Wait Called');
68	tony	47	sleep(500);
69			if FEventSignalled then
70			begin
71			writeln(OutFile,'First Event - usually ignored');
72			FEventSignalled := false;
73	tony	56	EventHandler.AsyncWaitForEvent(EventReport);
74	tony	47	sleep(100);
75			if FEventSignalled then
76			begin
77			writeln(OutFile,'Unexpected Event 1');
78			Exit;
79			end;
80			end;
81	tony	45	writeln(OutFile,'Signal Event');
82			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
83	tony	47	while not FEventSignalled do Sleep(50);
84			ShowEventCounts(EventHandler);
85	tony	45	FEventSignalled := false;
86
87			writeln(OutFile,'Two more events');
88			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
89			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
90	tony	47	if FEventSignalled then
91			begin
92			writeln(OutFile,'Unexpected Event 2');
93			FEventSignalled := false
94			end;
95	tony	45	writeln(OutFile,'Call Async Wait');
96	tony	56	EventHandler.AsyncWaitForEvent(EventReport);
97	tony	45	writeln(OutFile,'Async Wait Called');
98	tony	47	sleep(500);
99			if FEventSignalled then
100			begin
101			writeln(OutFile,'Deferred Events Caught');
102			ShowEventCounts(EventHandler);
103			FEventSignalled := false;
104	tony	56	EventHandler.AsyncWaitForEvent(EventReport);
105	tony	47	sleep(100);
106			if FEventSignalled then
107			writeln(OutFile,'Unexpected Event 3');
108			end;
109	tony	45	writeln(OutFile,'Signal Event');
110			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
111			while not FEventSignalled do;
112	tony	47	ShowEventCounts(EventHandler);
113	tony	45
114			FEventSignalled := false;
115			writeln(OutFile,'Async Wait: Test Cancel');
116	tony	56	EventHandler.AsyncWaitForEvent(EventReport);
117	tony	45	writeln(OutFile,'Async Wait Called');
118			EventHandler.Cancel;
119	tony	47	writeln(OutFile,'Event Cancelled');
120			FEventSignalled := false;
121	tony	45	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
122			WaitCount := 100000000;
123			while not FEventSignalled and (WaitCount > 0) do Dec(WaitCount);
124			if WaitCount = 0 then writeln(OutFile,'Time Out - Cancel Worked!')
125			else
126			writeln(OutFile,'Event called - so Cancel failed');
127
128			writeln(OutFile,'Sync wait');
129			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
130			EventHandler.WaitForEvent;
131			writeln(OutFile,'Event Signalled');
132	tony	47	ShowEventCounts(EventHandler);
133			EventHandler := nil;
134	tony	45	end;
135
136			procedure TTest10.EventReport(Sender: IEvents);
137			begin
138			FEventSignalled := true;
139	tony	47	writeln(OutFile,'Event Signalled');
140	tony	45	end;
141
142	tony	47	procedure TTest10.ShowEventCounts(Intf: IEvents);
143			var
144			i: integer;
145			EventCounts: TEventCounts;
146			begin
147			EventCounts := Intf.ExtractEventCounts;
148			for i := 0 to length(EventCounts) - 1 do
149			writeln(OutFile,'Event Counts: ',EventCounts[i].EventName,', Count = ',EventCounts[i].Count);
150			end;
151
152	tony	56	function TTest10.TestTitle: AnsiString;
153	tony	45	begin
154			Result := 'Test 10: Event Handling';
155			end;
156
157	tony	56	procedure TTest10.RunTest(CharSet: AnsiString; SQLDialect: integer);
158	tony	45	var Attachment: IAttachment;
159			DPB: IDPB;
160			begin
161			DPB := FirebirdAPI.AllocateDPB;
162			DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
163			DPB.Add(isc_dpb_password).setAsString(' ');
164			DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
165			DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
166			DPB.Find(isc_dpb_password).setAsString(Owner.GetPassword);
167			Attachment := FirebirdAPI.OpenDatabase(Owner.GetEmployeeDatabaseName,DPB);
168			EventsTest(Attachment);
169			Attachment.Disconnect;
170			end;
171
172			initialization
173			RegisterTest(TTest10);
174
175			end.
176