ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/testsuite/Test10.pas
Revision: 315
Committed: Thu Feb 25 11:56:36 2021 UTC (17 months, 2 weeks ago) by tony
File size: 6220 byte(s)
Log Message:
Updated for IBX 4 release
Line File contents
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