fbintf/testsuite/Test10.pas

unit Test10;

{$mode objfpc}{$H+}
{$codepage utf8}

{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: string; override;
    procedure RunTest(CharSet: string; 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: string;
begin
  Result := 'Test 10: Event Handling';
end;

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