fbintf/testsuite/Test10.pas

unit Test10;
{$IFDEF MSWINDOWS} 
{$DEFINE WINDOWS} 
{$ENDIF}

{$IFDEF FPC}
{$mode delphi}
{$codepage utf8}
{$ENDIF}

{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 ShowEventReport;
    procedure ShowEventCounts(Intf: IEvents);
  public
    function TestTitle: AnsiString; override;
    procedure RunTest(CharSet: AnsiString; 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);
  CheckSynchronize;
  if FEventSignalled then
  begin
    writeln(OutFile,'First Event - usually ignored');
    FEventSignalled := false;
    EventHandler.AsyncWaitForEvent(EventReport);
    sleep(100);
    CheckSynchronize;
    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);
  CheckSynchronize;
  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);
  CheckSynchronize;
  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');
  CheckSynchronize;
  Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
  EventHandler.WaitForEvent;
  writeln(OutFile,'Event Signalled');
  ShowEventCounts(EventHandler);
  EventHandler := nil;
  CheckSynchronize;
end;

procedure TTest10.EventReport(Sender: IEvents);
begin
  FEventSignalled := true;
  TThread.Synchronize(nil,ShowEventReport);
end;

procedure TTest10.ShowEventReport;
begin
  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: AnsiString;
begin
  Result := 'Test 10: Event Handling';
end;

procedure TTest10.RunTest(CharSet: AnsiString; 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:	217
Committed:	Fri Mar 16 10:27:26 2018 UTC (6 years, 9 months ago) by tony
Content type:	text/x-pascal
File size:	5218 byte(s)
Log Message:	Fixes Merged
#	User	Rev	Content
1	tony	45	unit Test10;
2	tony	56	{$IFDEF MSWINDOWS}
3			{$DEFINE WINDOWS}
4			{$ENDIF}
5	tony	45
6	tony	56	{$IFDEF FPC}
7			{$mode delphi}
8	tony	45	{$codepage utf8}
9	tony	56	{$ENDIF}
10	tony	45
11			{Test 10: Event Handling}
12
13			{
14			This test opens the employee example databases with the supplied user name/password
15			and then tests event handling.
16
17			1. Simple wait for async event.
18
19			2. Signal two more events to show that events counts are maintained.
20
21			3. Async Event wait followed by signal event. Event Counts should include all
22			previous events.
23
24			4. Demonstrate event cancel by waiting for event, cancelling it and then signalling
25			event. No change to signal flag after waiting in a tight loop implies event cancelled.
26
27			5. Wait for sync Event.
28			}
29
30			interface
31
32			uses
33			Classes, SysUtils, TestManager, IB;
34
35			type
36
37			{ TTest10 }
38
39			TTest10 = class(TTestBase)
40			private
41			FEventSignalled: boolean;
42			procedure EventsTest(Attachment: IAttachment);
43			procedure EventReport(Sender: IEvents);
44	tony	217	procedure ShowEventReport;
45	tony	47	procedure ShowEventCounts(Intf: IEvents);
46	tony	45	public
47	tony	56	function TestTitle: AnsiString; override;
48			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
49	tony	45	end;
50
51
52			implementation
53
54			{ TTest10 }
55
56			const
57			sqlEvent = 'Execute Block As Begin Post_Event(''TESTEVENT''); End';
58
59			procedure TTest10.EventsTest(Attachment: IAttachment);
60			var EventHandler: IEvents;
61			i: integer;
62			WaitCount: integer;
63			begin
64	tony	47	FEventSignalled := false;
65	tony	45	EventHandler := Attachment.GetEventHandler('TESTEVENT');
66			writeln(OutFile,'Call Async Wait');
67	tony	56	EventHandler.AsyncWaitForEvent(EventReport);
68	tony	45	writeln(OutFile,'Async Wait Called');
69	tony	47	sleep(500);
70	tony	217	CheckSynchronize;
71	tony	47	if FEventSignalled then
72			begin
73			writeln(OutFile,'First Event - usually ignored');
74			FEventSignalled := false;
75	tony	56	EventHandler.AsyncWaitForEvent(EventReport);
76	tony	47	sleep(100);
77	tony	217	CheckSynchronize;
78	tony	47	if FEventSignalled then
79			begin
80			writeln(OutFile,'Unexpected Event 1');
81			Exit;
82			end;
83			end;
84	tony	45	writeln(OutFile,'Signal Event');
85			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
86	tony	47	while not FEventSignalled do Sleep(50);
87			ShowEventCounts(EventHandler);
88	tony	45	FEventSignalled := false;
89
90			writeln(OutFile,'Two more events');
91			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
92			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
93	tony	47	if FEventSignalled then
94			begin
95			writeln(OutFile,'Unexpected Event 2');
96			FEventSignalled := false
97			end;
98	tony	45	writeln(OutFile,'Call Async Wait');
99	tony	56	EventHandler.AsyncWaitForEvent(EventReport);
100	tony	45	writeln(OutFile,'Async Wait Called');
101	tony	47	sleep(500);
102	tony	217	CheckSynchronize;
103	tony	47	if FEventSignalled then
104			begin
105			writeln(OutFile,'Deferred Events Caught');
106			ShowEventCounts(EventHandler);
107			FEventSignalled := false;
108	tony	56	EventHandler.AsyncWaitForEvent(EventReport);
109	tony	47	sleep(100);
110			if FEventSignalled then
111			writeln(OutFile,'Unexpected Event 3');
112			end;
113	tony	45	writeln(OutFile,'Signal Event');
114			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
115			while not FEventSignalled do;
116	tony	47	ShowEventCounts(EventHandler);
117	tony	45
118			FEventSignalled := false;
119			writeln(OutFile,'Async Wait: Test Cancel');
120	tony	56	EventHandler.AsyncWaitForEvent(EventReport);
121	tony	217	CheckSynchronize;
122	tony	45	writeln(OutFile,'Async Wait Called');
123			EventHandler.Cancel;
124	tony	47	writeln(OutFile,'Event Cancelled');
125			FEventSignalled := false;
126	tony	45	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
127			WaitCount := 100000000;
128			while not FEventSignalled and (WaitCount > 0) do Dec(WaitCount);
129			if WaitCount = 0 then writeln(OutFile,'Time Out - Cancel Worked!')
130			else
131			writeln(OutFile,'Event called - so Cancel failed');
132
133			writeln(OutFile,'Sync wait');
134	tony	217	CheckSynchronize;
135	tony	45	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
136			EventHandler.WaitForEvent;
137			writeln(OutFile,'Event Signalled');
138	tony	47	ShowEventCounts(EventHandler);
139			EventHandler := nil;
140	tony	217	CheckSynchronize;
141	tony	45	end;
142
143			procedure TTest10.EventReport(Sender: IEvents);
144			begin
145			FEventSignalled := true;
146	tony	217	TThread.Synchronize(nil,ShowEventReport);
147			end;
148
149			procedure TTest10.ShowEventReport;
150			begin
151	tony	47	writeln(OutFile,'Event Signalled');
152	tony	45	end;
153
154	tony	47	procedure TTest10.ShowEventCounts(Intf: IEvents);
155			var
156			i: integer;
157			EventCounts: TEventCounts;
158			begin
159			EventCounts := Intf.ExtractEventCounts;
160			for i := 0 to length(EventCounts) - 1 do
161			writeln(OutFile,'Event Counts: ',EventCounts[i].EventName,', Count = ',EventCounts[i].Count);
162			end;
163
164	tony	56	function TTest10.TestTitle: AnsiString;
165	tony	45	begin
166			Result := 'Test 10: Event Handling';
167			end;
168
169	tony	56	procedure TTest10.RunTest(CharSet: AnsiString; SQLDialect: integer);
170	tony	45	var Attachment: IAttachment;
171			DPB: IDPB;
172			begin
173			DPB := FirebirdAPI.AllocateDPB;
174			DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
175			DPB.Add(isc_dpb_password).setAsString(' ');
176			DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
177			DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
178			DPB.Find(isc_dpb_password).setAsString(Owner.GetPassword);
179			Attachment := FirebirdAPI.OpenDatabase(Owner.GetEmployeeDatabaseName,DPB);
180			EventsTest(Attachment);
181			Attachment.Disconnect;
182			end;
183
184			initialization
185			RegisterTest(TTest10);
186
187			end.
188