ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/testsuite/Test10.pas
Revision: 45
Committed: Tue Dec 6 10:33:46 2016 UTC (7 years, 3 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/testsuite/Test10.pas
File size: 4228 byte(s)
Log Message:
Committing updates for Release R2-0-0

File Contents

# Content
1 unit Test10;
2
3 {$mode objfpc}{$H+}
4 {$codepage utf8}
5
6 {Test 10: Event Handling}
7
8 {
9 This test opens the employee example databases with the supplied user name/password
10 and then tests event handling.
11
12 1. Simple wait for async event.
13
14 2. Signal two more events to show that events counts are maintained.
15
16 3. Async Event wait followed by signal event. Event Counts should include all
17 previous events.
18
19 4. Demonstrate event cancel by waiting for event, cancelling it and then signalling
20 event. No change to signal flag after waiting in a tight loop implies event cancelled.
21
22 5. Wait for sync Event.
23 }
24
25 interface
26
27 uses
28 Classes, SysUtils, TestManager, IB;
29
30 type
31
32 { TTest10 }
33
34 TTest10 = class(TTestBase)
35 private
36 FEventSignalled: boolean;
37 procedure EventsTest(Attachment: IAttachment);
38 procedure EventReport(Sender: IEvents);
39 public
40 function TestTitle: string; override;
41 procedure RunTest(CharSet: string; SQLDialect: integer); override;
42 end;
43
44
45 implementation
46
47 { TTest10 }
48
49 const
50 sqlEvent = 'Execute Block As Begin Post_Event(''TESTEVENT''); End';
51
52 procedure TTest10.EventsTest(Attachment: IAttachment);
53 var EventHandler: IEvents;
54 EventCounts: TEventCounts;
55 i: integer;
56 WaitCount: integer;
57 begin
58 EventHandler := Attachment.GetEventHandler('TESTEVENT');
59 writeln(OutFile,'Call Async Wait');
60 EventHandler.AsyncWaitForEvent(@EventReport);
61 writeln(OutFile,'Async Wait Called');
62
63 writeln(OutFile,'Signal Event');
64 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
65 while not FEventSignalled do;
66 writeln(OutFile,'Event Signalled');
67 EventCounts := EventHandler.ExtractEventCounts;
68 for i := 0 to length(EventCounts) - 1 do
69 writeln(OutFile,'Event: ',EventCounts[i].EventName,', Count = ',EventCounts[i].Count);
70 FEventSignalled := false;
71
72 writeln(OutFile,'Two more events');
73 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
74 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
75 writeln(OutFile,'Call Async Wait');
76 EventHandler.AsyncWaitForEvent(@EventReport);
77 writeln(OutFile,'Async Wait Called');
78 writeln(OutFile,'Signal Event');
79 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
80 while not FEventSignalled do;
81 writeln(OutFile,'Event Signalled');
82 EventCounts := EventHandler.ExtractEventCounts;
83 for i := 0 to length(EventCounts) - 1 do
84 writeln(OutFile,'Event: ',EventCounts[i].EventName,', Count = ',EventCounts[i].Count);
85
86 FEventSignalled := false;
87 writeln(OutFile,'Async Wait: Test Cancel');
88 EventHandler.AsyncWaitForEvent(@EventReport);
89 writeln(OutFile,'Async Wait Called');
90 EventHandler.Cancel;
91 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
92 WaitCount := 100000000;
93 while not FEventSignalled and (WaitCount > 0) do Dec(WaitCount);
94 if WaitCount = 0 then writeln(OutFile,'Time Out - Cancel Worked!')
95 else
96 writeln(OutFile,'Event called - so Cancel failed');
97
98 writeln(OutFile,'Sync wait');
99 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
100 EventHandler.WaitForEvent;
101 writeln(OutFile,'Event Signalled');
102 EventCounts := EventHandler.ExtractEventCounts;
103 for i := 0 to length(EventCounts) - 1 do
104 writeln(OutFile,'Event: ',EventCounts[i].EventName,', Count = ',EventCounts[i].Count);
105 end;
106
107 procedure TTest10.EventReport(Sender: IEvents);
108 begin
109 FEventSignalled := true;
110 end;
111
112 function TTest10.TestTitle: string;
113 begin
114 Result := 'Test 10: Event Handling';
115 end;
116
117 procedure TTest10.RunTest(CharSet: string; SQLDialect: integer);
118 var Attachment: IAttachment;
119 DPB: IDPB;
120 begin
121 DPB := FirebirdAPI.AllocateDPB;
122 DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
123 DPB.Add(isc_dpb_password).setAsString(' ');
124 DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
125 DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
126 DPB.Find(isc_dpb_password).setAsString(Owner.GetPassword);
127 Attachment := FirebirdAPI.OpenDatabase(Owner.GetEmployeeDatabaseName,DPB);
128 EventsTest(Attachment);
129 Attachment.Disconnect;
130 end;
131
132 initialization
133 RegisterTest(TTest10);
134
135 end.
136