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
#	Content
1	unit Test10;
2	{$IFDEF MSWINDOWS}
3	{$DEFINE WINDOWS}
4	{$ENDIF}
5
6	{$IFDEF FPC}
7	{$mode delphi}
8	{$codepage utf8}
9	{$ENDIF}
10
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	procedure ShowEventCounts(Intf: IEvents);
45	public
46	function TestTitle: AnsiString; override;
47	procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
48	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	FEventSignalled := false;
64	EventHandler := Attachment.GetEventHandler('TESTEVENT');
65	writeln(OutFile,'Call Async Wait');
66	EventHandler.AsyncWaitForEvent(EventReport);
67	writeln(OutFile,'Async Wait Called');
68	sleep(500);
69	if FEventSignalled then
70	begin
71	writeln(OutFile,'First Event - usually ignored');
72	FEventSignalled := false;
73	EventHandler.AsyncWaitForEvent(EventReport);
74	sleep(100);
75	if FEventSignalled then
76	begin
77	writeln(OutFile,'Unexpected Event 1');
78	Exit;
79	end;
80	end;
81	writeln(OutFile,'Signal Event');
82	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
83	while not FEventSignalled do Sleep(50);
84	ShowEventCounts(EventHandler);
85	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	if FEventSignalled then
91	begin
92	writeln(OutFile,'Unexpected Event 2');
93	FEventSignalled := false
94	end;
95	writeln(OutFile,'Call Async Wait');
96	EventHandler.AsyncWaitForEvent(EventReport);
97	writeln(OutFile,'Async Wait Called');
98	sleep(500);
99	if FEventSignalled then
100	begin
101	writeln(OutFile,'Deferred Events Caught');
102	ShowEventCounts(EventHandler);
103	FEventSignalled := false;
104	EventHandler.AsyncWaitForEvent(EventReport);
105	sleep(100);
106	if FEventSignalled then
107	writeln(OutFile,'Unexpected Event 3');
108	end;
109	writeln(OutFile,'Signal Event');
110	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
111	while not FEventSignalled do;
112	ShowEventCounts(EventHandler);
113
114	FEventSignalled := false;
115	writeln(OutFile,'Async Wait: Test Cancel');
116	EventHandler.AsyncWaitForEvent(EventReport);
117	writeln(OutFile,'Async Wait Called');
118	EventHandler.Cancel;
119	writeln(OutFile,'Event Cancelled');
120	FEventSignalled := false;
121	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	ShowEventCounts(EventHandler);
133	EventHandler := nil;
134	end;
135
136	procedure TTest10.EventReport(Sender: IEvents);
137	begin
138	FEventSignalled := true;
139	writeln(OutFile,'Event Signalled');
140	end;
141
142	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	function TTest10.TestTitle: AnsiString;
153	begin
154	Result := 'Test 10: Event Handling';
155	end;
156
157	procedure TTest10.RunTest(CharSet: AnsiString; SQLDialect: integer);
158	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