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} |
58 |
|
interface |
59 |
|
|
60 |
|
uses |
61 |
< |
Classes, SysUtils, TestManager, IB; |
61 |
> |
Classes, SysUtils, TestApplication, FBTestApp, IB; |
62 |
|
|
63 |
|
type |
64 |
|
|
65 |
|
{ TTest10 } |
66 |
|
|
67 |
< |
TTest10 = class(TTestBase) |
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; |
86 |
|
|
87 |
|
procedure TTest10.EventsTest(Attachment: IAttachment); |
88 |
|
var EventHandler: IEvents; |
60 |
– |
i: integer; |
89 |
|
WaitCount: integer; |
90 |
|
begin |
91 |
|
FEventSignalled := false; |
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'); |
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'); |
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'); |
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 |
|
|