fbintf/testsuite/Test10.pas

(*
 *  Firebird Interface (fbintf) Test suite. This program is used to
 *  test the Firebird Pascal Interface and provide a semi-automated
 *  pass/fail check for each test.
 *
 *  The contents of this file are subject to the Initial Developer's
 *  Public License Version 1.0 (the "License"); you may not use this
 *  file except in compliance with the License. You may obtain a copy
 *  of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2016 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)

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, TestApplication, FBTestApp, IB;

type

{ TTest10 }

  TTest10 = class(TFBTestBase)
  private
    FEventSignalled: boolean;
    procedure EventsTest(Attachment: IAttachment);
    procedure EventReport(Sender: IEvents);
    procedure ShowEventReport;
    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;
    WaitCount: integer;
begin
  FEventSignalled := false;
  EventHandler := Attachment.GetEventHandler('TESTEVENT');
  writeln(OutFile,'Call Async Wait');
  EventHandler.AsyncWaitForEvent(EventReport);
  writeln(OutFile,'Async Wait Called');
  sleep(500);
  CheckSynchronize;
  if FEventSignalled then
  begin
    writeln(OutFile,'First Event - usually ignored');
    FEventSignalled := false;
    EventHandler.AsyncWaitForEvent(EventReport);
    sleep(100);
    CheckSynchronize;
    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
  begin
    Sleep(50);
    CheckSynchronize;
  end;
  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);
  CheckSynchronize;
  if FEventSignalled then
  begin
    writeln(OutFile,'Deferred Events Caught');
    ShowEventCounts(EventHandler);
    FEventSignalled := false;
    EventHandler.AsyncWaitForEvent(EventReport);
    CheckSynchronize;
    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);
  CheckSynchronize;
  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');
  CheckSynchronize;
  Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
  EventHandler.WaitForEvent;
  writeln(OutFile,'Event Signalled');
  ShowEventCounts(EventHandler);
  EventHandler := nil;
  CheckSynchronize;
end;

procedure TTest10.EventReport(Sender: IEvents);
begin
  FEventSignalled := true;
  TThread.Synchronize(nil,ShowEventReport);
end;

procedure TTest10.ShowEventReport;
begin
  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.Find(isc_dpb_password).setAsString(Owner.GetPassword);
  Attachment := FirebirdAPI.OpenDatabase(Owner.GetEmployeeDatabaseName,DPB);
  EventsTest(Attachment);
  Attachment.Disconnect;
end;

initialization
  RegisterTest(TTest10);

end.

Revision:	402
Committed:	Mon Aug 1 10:07:24 2022 UTC (2 years, 4 months ago) by tony
Content type:	text/x-pascal
File size:	6200 byte(s)
Log Message:	IBX Release 2.5.0
#	Content
1	(*
2	* Firebird Interface (fbintf) Test suite. This program is used to
3	* test the Firebird Pascal Interface and provide a semi-automated
4	* pass/fail check for each test.
5	*
6	* The contents of this file are subject to the Initial Developer's
7	* Public License Version 1.0 (the "License"); you may not use this
8	* file except in compliance with the License. You may obtain a copy
9	* of the License here:
10	*
11	* http://www.firebirdsql.org/index.php?op=doc&id=idpl
12	*
13	* Software distributed under the License is distributed on an "AS
14	* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
15	* implied. See the License for the specific language governing rights
16	* and limitations under the License.
17	*
18	* The Initial Developer of the Original Code is Tony Whyman.
19	*
20	* The Original Code is (C) 2016 Tony Whyman, MWA Software
21	* (http://www.mwasoftware.co.uk).
22	*
23	* All Rights Reserved.
24	*
25	* Contributor(s): ______________________________________.
26	*
27	*)
28
29	unit Test10;
30	{$IFDEF MSWINDOWS}
31	{$DEFINE WINDOWS}
32	{$ENDIF}
33
34	{$IFDEF FPC}
35	{$mode delphi}
36	{$codepage utf8}
37	{$ENDIF}
38
39	{Test 10: Event Handling}
40
41	{
42	This test opens the employee example databases with the supplied user name/password
43	and then tests event handling.
44
45	1. Simple wait for async event.
46
47	2. Signal two more events to show that events counts are maintained.
48
49	3. Async Event wait followed by signal event. Event Counts should include all
50	previous events.
51
52	4. Demonstrate event cancel by waiting for event, cancelling it and then signalling
53	event. No change to signal flag after waiting in a tight loop implies event cancelled.
54
55	5. Wait for sync Event.
56	}
57
58	interface
59
60	uses
61	Classes, SysUtils, TestApplication, FBTestApp, IB;
62
63	type
64
65	{ TTest10 }
66
67	TTest10 = class(TFBTestBase)
68	private
69	FEventSignalled: boolean;
70	procedure EventsTest(Attachment: IAttachment);
71	procedure EventReport(Sender: IEvents);
72	procedure ShowEventReport;
73	procedure ShowEventCounts(Intf: IEvents);
74	public
75	function TestTitle: AnsiString; override;
76	procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
77	end;
78
79
80	implementation
81
82	{ TTest10 }
83
84	const
85	sqlEvent = 'Execute Block As Begin Post_Event(''TESTEVENT''); End';
86
87	procedure TTest10.EventsTest(Attachment: IAttachment);
88	var EventHandler: IEvents;
89	WaitCount: integer;
90	begin
91	FEventSignalled := false;
92	EventHandler := Attachment.GetEventHandler('TESTEVENT');
93	writeln(OutFile,'Call Async Wait');
94	EventHandler.AsyncWaitForEvent(EventReport);
95	writeln(OutFile,'Async Wait Called');
96	sleep(500);
97	CheckSynchronize;
98	if FEventSignalled then
99	begin
100	writeln(OutFile,'First Event - usually ignored');
101	FEventSignalled := false;
102	EventHandler.AsyncWaitForEvent(EventReport);
103	sleep(100);
104	CheckSynchronize;
105	if FEventSignalled then
106	begin
107	writeln(OutFile,'Unexpected Event 1');
108	Exit;
109	end;
110	end;
111	writeln(OutFile,'Signal Event');
112	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
113	while not FEventSignalled do
114	begin
115	Sleep(50);
116	CheckSynchronize;
117	end;
118	ShowEventCounts(EventHandler);
119	FEventSignalled := false;
120
121	writeln(OutFile,'Two more events');
122	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
123	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
124	if FEventSignalled then
125	begin
126	writeln(OutFile,'Unexpected Event 2');
127	FEventSignalled := false
128	end;
129	writeln(OutFile,'Call Async Wait');
130	EventHandler.AsyncWaitForEvent(EventReport);
131	writeln(OutFile,'Async Wait Called');
132	sleep(500);
133	CheckSynchronize;
134	if FEventSignalled then
135	begin
136	writeln(OutFile,'Deferred Events Caught');
137	ShowEventCounts(EventHandler);
138	FEventSignalled := false;
139	EventHandler.AsyncWaitForEvent(EventReport);
140	CheckSynchronize;
141	sleep(100);
142	if FEventSignalled then
143	writeln(OutFile,'Unexpected Event 3');
144	end;
145	writeln(OutFile,'Signal Event');
146	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
147	while not FEventSignalled do;
148	ShowEventCounts(EventHandler);
149
150	FEventSignalled := false;
151	writeln(OutFile,'Async Wait: Test Cancel');
152	EventHandler.AsyncWaitForEvent(EventReport);
153	CheckSynchronize;
154	writeln(OutFile,'Async Wait Called');
155	EventHandler.Cancel;
156	writeln(OutFile,'Event Cancelled');
157	FEventSignalled := false;
158	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
159	WaitCount := 100000000;
160	while not FEventSignalled and (WaitCount > 0) do Dec(WaitCount);
161	if WaitCount = 0 then writeln(OutFile,'Time Out - Cancel Worked!')
162	else
163	writeln(OutFile,'Event called - so Cancel failed');
164
165	writeln(OutFile,'Sync wait');
166	CheckSynchronize;
167	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
168	EventHandler.WaitForEvent;
169	writeln(OutFile,'Event Signalled');
170	ShowEventCounts(EventHandler);
171	EventHandler := nil;
172	CheckSynchronize;
173	end;
174
175	procedure TTest10.EventReport(Sender: IEvents);
176	begin
177	FEventSignalled := true;
178	TThread.Synchronize(nil,ShowEventReport);
179	end;
180
181	procedure TTest10.ShowEventReport;
182	begin
183	writeln(OutFile,'Event Signalled');
184	end;
185
186	procedure TTest10.ShowEventCounts(Intf: IEvents);
187	var
188	i: integer;
189	EventCounts: TEventCounts;
190	begin
191	EventCounts := Intf.ExtractEventCounts;
192	for i := 0 to length(EventCounts) - 1 do
193	writeln(OutFile,'Event Counts: ',EventCounts[i].EventName,', Count = ',EventCounts[i].Count);
194	end;
195
196	function TTest10.TestTitle: AnsiString;
197	begin
198	Result := 'Test 10: Event Handling';
199	end;
200
201	procedure TTest10.RunTest(CharSet: AnsiString; SQLDialect: integer);
202	var Attachment: IAttachment;
203	DPB: IDPB;
204	begin
205	DPB := FirebirdAPI.AllocateDPB;
206	DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
207	DPB.Add(isc_dpb_password).setAsString(' ');
208	DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
209	DPB.Find(isc_dpb_password).setAsString(Owner.GetPassword);
210	Attachment := FirebirdAPI.OpenDatabase(Owner.GetEmployeeDatabaseName,DPB);
211	EventsTest(Attachment);
212	Attachment.Disconnect;
213	end;
214
215	initialization
216	RegisterTest(TTest10);
217
218	end.
219