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 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);
  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.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:	315
Committed:	Thu Feb 25 11:56:36 2021 UTC (3 years, 9 months ago) by tony
Content type:	text/x-pascal
File size:	6220 byte(s)
Log Message:	Updated for IBX 4 release
#	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 Sleep(50);
114	ShowEventCounts(EventHandler);
115	FEventSignalled := false;
116
117	writeln(OutFile,'Two more events');
118	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
119	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
120	if FEventSignalled then
121	begin
122	writeln(OutFile,'Unexpected Event 2');
123	FEventSignalled := false
124	end;
125	writeln(OutFile,'Call Async Wait');
126	EventHandler.AsyncWaitForEvent(EventReport);
127	writeln(OutFile,'Async Wait Called');
128	sleep(500);
129	CheckSynchronize;
130	if FEventSignalled then
131	begin
132	writeln(OutFile,'Deferred Events Caught');
133	ShowEventCounts(EventHandler);
134	FEventSignalled := false;
135	EventHandler.AsyncWaitForEvent(EventReport);
136	CheckSynchronize;
137	sleep(100);
138	if FEventSignalled then
139	writeln(OutFile,'Unexpected Event 3');
140	end;
141	writeln(OutFile,'Signal Event');
142	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
143	while not FEventSignalled do;
144	ShowEventCounts(EventHandler);
145
146	FEventSignalled := false;
147	writeln(OutFile,'Async Wait: Test Cancel');
148	EventHandler.AsyncWaitForEvent(EventReport);
149	CheckSynchronize;
150	writeln(OutFile,'Async Wait Called');
151	EventHandler.Cancel;
152	writeln(OutFile,'Event Cancelled');
153	FEventSignalled := false;
154	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
155	WaitCount := 100000000;
156	while not FEventSignalled and (WaitCount > 0) do Dec(WaitCount);
157	if WaitCount = 0 then writeln(OutFile,'Time Out - Cancel Worked!')
158	else
159	writeln(OutFile,'Event called - so Cancel failed');
160
161	writeln(OutFile,'Sync wait');
162	CheckSynchronize;
163	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
164	EventHandler.WaitForEvent;
165	writeln(OutFile,'Event Signalled');
166	ShowEventCounts(EventHandler);
167	EventHandler := nil;
168	CheckSynchronize;
169	end;
170
171	procedure TTest10.EventReport(Sender: IEvents);
172	begin
173	FEventSignalled := true;
174	TThread.Synchronize(nil,ShowEventReport);
175	end;
176
177	procedure TTest10.ShowEventReport;
178	begin
179	writeln(OutFile,'Event Signalled');
180	end;
181
182	procedure TTest10.ShowEventCounts(Intf: IEvents);
183	var
184	i: integer;
185	EventCounts: TEventCounts;
186	begin
187	EventCounts := Intf.ExtractEventCounts;
188	for i := 0 to length(EventCounts) - 1 do
189	writeln(OutFile,'Event Counts: ',EventCounts[i].EventName,', Count = ',EventCounts[i].Count);
190	end;
191
192	function TTest10.TestTitle: AnsiString;
193	begin
194	Result := 'Test 10: Event Handling';
195	end;
196
197	procedure TTest10.RunTest(CharSet: AnsiString; SQLDialect: integer);
198	var Attachment: IAttachment;
199	DPB: IDPB;
200	begin
201	DPB := FirebirdAPI.AllocateDPB;
202	DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
203	DPB.Add(isc_dpb_password).setAsString(' ');
204	DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
205	DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
206	DPB.Find(isc_dpb_password).setAsString(Owner.GetPassword);
207	Attachment := FirebirdAPI.OpenDatabase(Owner.GetEmployeeDatabaseName,DPB);
208	EventsTest(Attachment);
209	Attachment.Disconnect;
210	end;
211
212	initialization
213	RegisterTest(TTest10);
214
215	end.
216