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
#	User	Rev	Content
1	tony	315	(*
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	tony	45	unit Test10;
30	tony	56	{$IFDEF MSWINDOWS}
31			{$DEFINE WINDOWS}
32			{$ENDIF}
33	tony	45
34	tony	56	{$IFDEF FPC}
35			{$mode delphi}
36	tony	45	{$codepage utf8}
37	tony	56	{$ENDIF}
38	tony	45
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	tony	315	Classes, SysUtils, TestApplication, FBTestApp, IB;
62	tony	45
63			type
64
65			{ TTest10 }
66
67	tony	315	TTest10 = class(TFBTestBase)
68	tony	45	private
69			FEventSignalled: boolean;
70			procedure EventsTest(Attachment: IAttachment);
71			procedure EventReport(Sender: IEvents);
72	tony	217	procedure ShowEventReport;
73	tony	47	procedure ShowEventCounts(Intf: IEvents);
74	tony	45	public
75	tony	56	function TestTitle: AnsiString; override;
76			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
77	tony	45	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	tony	47	FEventSignalled := false;
92	tony	45	EventHandler := Attachment.GetEventHandler('TESTEVENT');
93			writeln(OutFile,'Call Async Wait');
94	tony	56	EventHandler.AsyncWaitForEvent(EventReport);
95	tony	45	writeln(OutFile,'Async Wait Called');
96	tony	47	sleep(500);
97	tony	217	CheckSynchronize;
98	tony	47	if FEventSignalled then
99			begin
100			writeln(OutFile,'First Event - usually ignored');
101			FEventSignalled := false;
102	tony	56	EventHandler.AsyncWaitForEvent(EventReport);
103	tony	47	sleep(100);
104	tony	217	CheckSynchronize;
105	tony	47	if FEventSignalled then
106			begin
107			writeln(OutFile,'Unexpected Event 1');
108			Exit;
109			end;
110			end;
111	tony	45	writeln(OutFile,'Signal Event');
112			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
113	tony	47	while not FEventSignalled do Sleep(50);
114			ShowEventCounts(EventHandler);
115	tony	45	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	tony	47	if FEventSignalled then
121			begin
122			writeln(OutFile,'Unexpected Event 2');
123			FEventSignalled := false
124			end;
125	tony	45	writeln(OutFile,'Call Async Wait');
126	tony	56	EventHandler.AsyncWaitForEvent(EventReport);
127	tony	45	writeln(OutFile,'Async Wait Called');
128	tony	47	sleep(500);
129	tony	217	CheckSynchronize;
130	tony	47	if FEventSignalled then
131			begin
132			writeln(OutFile,'Deferred Events Caught');
133			ShowEventCounts(EventHandler);
134			FEventSignalled := false;
135	tony	56	EventHandler.AsyncWaitForEvent(EventReport);
136	tony	224	CheckSynchronize;
137	tony	47	sleep(100);
138			if FEventSignalled then
139			writeln(OutFile,'Unexpected Event 3');
140			end;
141	tony	45	writeln(OutFile,'Signal Event');
142			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
143			while not FEventSignalled do;
144	tony	47	ShowEventCounts(EventHandler);
145	tony	45
146			FEventSignalled := false;
147			writeln(OutFile,'Async Wait: Test Cancel');
148	tony	56	EventHandler.AsyncWaitForEvent(EventReport);
149	tony	217	CheckSynchronize;
150	tony	45	writeln(OutFile,'Async Wait Called');
151			EventHandler.Cancel;
152	tony	47	writeln(OutFile,'Event Cancelled');
153			FEventSignalled := false;
154	tony	45	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	tony	217	CheckSynchronize;
163	tony	45	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
164			EventHandler.WaitForEvent;
165			writeln(OutFile,'Event Signalled');
166	tony	47	ShowEventCounts(EventHandler);
167			EventHandler := nil;
168	tony	217	CheckSynchronize;
169	tony	45	end;
170
171			procedure TTest10.EventReport(Sender: IEvents);
172			begin
173			FEventSignalled := true;
174	tony	217	TThread.Synchronize(nil,ShowEventReport);
175			end;
176
177			procedure TTest10.ShowEventReport;
178			begin
179	tony	47	writeln(OutFile,'Event Signalled');
180	tony	45	end;
181
182	tony	47	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	tony	56	function TTest10.TestTitle: AnsiString;
193	tony	45	begin
194			Result := 'Test 10: Event Handling';
195			end;
196
197	tony	56	procedure TTest10.RunTest(CharSet: AnsiString; SQLDialect: integer);
198	tony	45	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