ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/testsuite/Test10.pas
Revision: 381
Committed: Sat Jan 15 00:06:22 2022 UTC (2 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 6261 byte(s)
Log Message:
Release Candidate 1

File Contents

# 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.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
210 DPB.Find(isc_dpb_password).setAsString(Owner.GetPassword);
211 Attachment := FirebirdAPI.OpenDatabase(Owner.GetEmployeeDatabaseName,DPB);
212 EventsTest(Attachment);
213 Attachment.Disconnect;
214 end;
215
216 initialization
217 RegisterTest(TTest10);
218
219 end.
220

Properties

Name Value
svn:eol-style native