fbintf/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);
  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;
    EventCounts: TEventCounts;
    i: integer;
    WaitCount: integer;
begin
  EventHandler := Attachment.GetEventHandler('TESTEVENT');
  writeln(OutFile,'Call Async Wait');
  EventHandler.AsyncWaitForEvent(@EventReport);
  writeln(OutFile,'Async Wait Called');

  writeln(OutFile,'Signal Event');
  Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
  while not FEventSignalled do;
  writeln(OutFile,'Event Signalled');
  EventCounts := EventHandler.ExtractEventCounts;
  for i := 0 to length(EventCounts) - 1 do
    writeln(OutFile,'Event: ',EventCounts[i].EventName,', Count = ',EventCounts[i].Count);
  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);
  writeln(OutFile,'Call Async Wait');
  EventHandler.AsyncWaitForEvent(@EventReport);
  writeln(OutFile,'Async Wait Called');
  writeln(OutFile,'Signal Event');
  Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
  while not FEventSignalled do;
  writeln(OutFile,'Event Signalled');
  EventCounts := EventHandler.ExtractEventCounts;
  for i := 0 to length(EventCounts) - 1 do
    writeln(OutFile,'Event: ',EventCounts[i].EventName,', Count = ',EventCounts[i].Count);

  FEventSignalled := false;
  writeln(OutFile,'Async Wait: Test Cancel');
  EventHandler.AsyncWaitForEvent(@EventReport);
  writeln(OutFile,'Async Wait Called');
  EventHandler.Cancel;
  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');
  EventCounts := EventHandler.ExtractEventCounts;
  for i := 0 to length(EventCounts) - 1 do
    writeln(OutFile,'Event: ',EventCounts[i].EventName,', Count = ',EventCounts[i].Count);
end;

procedure TTest10.EventReport(Sender: IEvents);
begin
  FEventSignalled := true;
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:	45
Committed:	Tue Dec 6 10:33:46 2016 UTC (8 years ago) by tony
Content type:	text/x-pascal
File size:	4228 byte(s)
Log Message:	Committing updates for Release R2-0-0
#	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