udr/testsuite/Test10.pas

unit Test10;

{$mode objfpc}{$H+}
{$codepage utf8}

{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, TestManager, IB;

type

{ TTest10 }

  TTest10 = class(TTestBase)
  private
    FEventSignalled: boolean;
    procedure EventsTest(Attachment: IAttachment);
    procedure EventReport(Sender: IEvents);
    procedure ShowEventCounts(Intf: IEvents);
  public
    function TestTitle: string; override;
    procedure RunTest(CharSet: string; SQLDialect: integer); override;
  end;


implementation

{ TTest10 }

const
  sqlEvent = 'Execute Block As Begin Post_Event(''TESTEVENT''); End';

procedure TTest10.EventsTest(Attachment: IAttachment);
var EventHandler: IEvents;
    i: integer;
    WaitCount: integer;
begin
  FEventSignalled := false;
  EventHandler := Attachment.GetEventHandler('TESTEVENT');
  writeln(OutFile,'Call Async Wait');
  EventHandler.AsyncWaitForEvent(@EventReport);
  writeln(OutFile,'Async Wait Called');
  sleep(500);
  if FEventSignalled then
  begin
    writeln(OutFile,'First Event - usually ignored');
    FEventSignalled := false;
    EventHandler.AsyncWaitForEvent(@EventReport);
    sleep(100);
    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);
  if FEventSignalled then
  begin
    writeln(OutFile,'Deferred Events Caught');
    ShowEventCounts(EventHandler);
    FEventSignalled := false;
    EventHandler.AsyncWaitForEvent(@EventReport);
    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);
  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');
  Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
  EventHandler.WaitForEvent;
  writeln(OutFile,'Event Signalled');
  ShowEventCounts(EventHandler);
  EventHandler := nil;
end;

procedure TTest10.EventReport(Sender: IEvents);
begin
  FEventSignalled := true;
  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: string;
begin
  Result := 'Test 10: Event Handling';
end;

procedure TTest10.RunTest(CharSet: string; 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:	47
Committed:	Mon Jan 9 15:31:51 2017 UTC (7 years, 3 months ago) by tony
Content type:	text/x-pascal
Original Path:	*ibx/trunk/fbintf/testsuite/Test10.pas*
File size:	4898 byte(s)
Log Message:	Committing updates for Release R2-0-1
#	User	Rev	Content
1	tony	45	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	tony	47	procedure ShowEventCounts(Intf: IEvents);
40	tony	45	public
41			function TestTitle: string; override;
42			procedure RunTest(CharSet: string; SQLDialect: integer); override;
43			end;
44
45
46			implementation
47
48			{ TTest10 }
49
50			const
51			sqlEvent = 'Execute Block As Begin Post_Event(''TESTEVENT''); End';
52
53			procedure TTest10.EventsTest(Attachment: IAttachment);
54			var EventHandler: IEvents;
55			i: integer;
56			WaitCount: integer;
57			begin
58	tony	47	FEventSignalled := false;
59	tony	45	EventHandler := Attachment.GetEventHandler('TESTEVENT');
60			writeln(OutFile,'Call Async Wait');
61			EventHandler.AsyncWaitForEvent(@EventReport);
62			writeln(OutFile,'Async Wait Called');
63	tony	47	sleep(500);
64			if FEventSignalled then
65			begin
66			writeln(OutFile,'First Event - usually ignored');
67			FEventSignalled := false;
68			EventHandler.AsyncWaitForEvent(@EventReport);
69			sleep(100);
70			if FEventSignalled then
71			begin
72			writeln(OutFile,'Unexpected Event 1');
73			Exit;
74			end;
75			end;
76	tony	45	writeln(OutFile,'Signal Event');
77			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
78	tony	47	while not FEventSignalled do Sleep(50);
79			ShowEventCounts(EventHandler);
80	tony	45	FEventSignalled := false;
81
82			writeln(OutFile,'Two more events');
83			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
84			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
85	tony	47	if FEventSignalled then
86			begin
87			writeln(OutFile,'Unexpected Event 2');
88			FEventSignalled := false
89			end;
90	tony	45	writeln(OutFile,'Call Async Wait');
91			EventHandler.AsyncWaitForEvent(@EventReport);
92			writeln(OutFile,'Async Wait Called');
93	tony	47	sleep(500);
94			if FEventSignalled then
95			begin
96			writeln(OutFile,'Deferred Events Caught');
97			ShowEventCounts(EventHandler);
98			FEventSignalled := false;
99			EventHandler.AsyncWaitForEvent(@EventReport);
100			sleep(100);
101			if FEventSignalled then
102			writeln(OutFile,'Unexpected Event 3');
103			end;
104	tony	45	writeln(OutFile,'Signal Event');
105			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
106			while not FEventSignalled do;
107	tony	47	ShowEventCounts(EventHandler);
108	tony	45
109			FEventSignalled := false;
110			writeln(OutFile,'Async Wait: Test Cancel');
111			EventHandler.AsyncWaitForEvent(@EventReport);
112			writeln(OutFile,'Async Wait Called');
113			EventHandler.Cancel;
114	tony	47	writeln(OutFile,'Event Cancelled');
115			FEventSignalled := false;
116	tony	45	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
117			WaitCount := 100000000;
118			while not FEventSignalled and (WaitCount > 0) do Dec(WaitCount);
119			if WaitCount = 0 then writeln(OutFile,'Time Out - Cancel Worked!')
120			else
121			writeln(OutFile,'Event called - so Cancel failed');
122
123			writeln(OutFile,'Sync wait');
124			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
125			EventHandler.WaitForEvent;
126			writeln(OutFile,'Event Signalled');
127	tony	47	ShowEventCounts(EventHandler);
128			EventHandler := nil;
129	tony	45	end;
130
131			procedure TTest10.EventReport(Sender: IEvents);
132			begin
133			FEventSignalled := true;
134	tony	47	writeln(OutFile,'Event Signalled');
135	tony	45	end;
136
137	tony	47	procedure TTest10.ShowEventCounts(Intf: IEvents);
138			var
139			i: integer;
140			EventCounts: TEventCounts;
141			begin
142			EventCounts := Intf.ExtractEventCounts;
143			for i := 0 to length(EventCounts) - 1 do
144			writeln(OutFile,'Event Counts: ',EventCounts[i].EventName,', Count = ',EventCounts[i].Count);
145			end;
146
147	tony	45	function TTest10.TestTitle: string;
148			begin
149			Result := 'Test 10: Event Handling';
150			end;
151
152			procedure TTest10.RunTest(CharSet: string; SQLDialect: integer);
153			var Attachment: IAttachment;
154			DPB: IDPB;
155			begin
156			DPB := FirebirdAPI.AllocateDPB;
157			DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
158			DPB.Add(isc_dpb_password).setAsString(' ');
159			DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
160			DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
161			DPB.Find(isc_dpb_password).setAsString(Owner.GetPassword);
162			Attachment := FirebirdAPI.OpenDatabase(Owner.GetEmployeeDatabaseName,DPB);
163			EventsTest(Attachment);
164			Attachment.Disconnect;
165			end;
166
167			initialization
168			RegisterTest(TTest10);
169
170			end.
171