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);
    CheckSynchronize;
    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:	224
Committed:	Mon Mar 19 10:53:56 2018 UTC (6 years, 9 months ago) by tony
Content type:	text/x-pascal
File size:	5240 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	224	CheckSynchronize;
110	tony	47	sleep(100);
111			if FEventSignalled then
112			writeln(OutFile,'Unexpected Event 3');
113			end;
114	tony	45	writeln(OutFile,'Signal Event');
115			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
116			while not FEventSignalled do;
117	tony	47	ShowEventCounts(EventHandler);
118	tony	45
119			FEventSignalled := false;
120			writeln(OutFile,'Async Wait: Test Cancel');
121	tony	56	EventHandler.AsyncWaitForEvent(EventReport);
122	tony	217	CheckSynchronize;
123	tony	45	writeln(OutFile,'Async Wait Called');
124			EventHandler.Cancel;
125	tony	47	writeln(OutFile,'Event Cancelled');
126			FEventSignalled := false;
127	tony	45	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
128			WaitCount := 100000000;
129			while not FEventSignalled and (WaitCount > 0) do Dec(WaitCount);
130			if WaitCount = 0 then writeln(OutFile,'Time Out - Cancel Worked!')
131			else
132			writeln(OutFile,'Event called - so Cancel failed');
133
134			writeln(OutFile,'Sync wait');
135	tony	217	CheckSynchronize;
136	tony	45	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],sqlEvent);
137			EventHandler.WaitForEvent;
138			writeln(OutFile,'Event Signalled');
139	tony	47	ShowEventCounts(EventHandler);
140			EventHandler := nil;
141	tony	217	CheckSynchronize;
142	tony	45	end;
143
144			procedure TTest10.EventReport(Sender: IEvents);
145			begin
146			FEventSignalled := true;
147	tony	217	TThread.Synchronize(nil,ShowEventReport);
148			end;
149
150			procedure TTest10.ShowEventReport;
151			begin
152	tony	47	writeln(OutFile,'Event Signalled');
153	tony	45	end;
154
155	tony	47	procedure TTest10.ShowEventCounts(Intf: IEvents);
156			var
157			i: integer;
158			EventCounts: TEventCounts;
159			begin
160			EventCounts := Intf.ExtractEventCounts;
161			for i := 0 to length(EventCounts) - 1 do
162			writeln(OutFile,'Event Counts: ',EventCounts[i].EventName,', Count = ',EventCounts[i].Count);
163			end;
164
165	tony	56	function TTest10.TestTitle: AnsiString;
166	tony	45	begin
167			Result := 'Test 10: Event Handling';
168			end;
169
170	tony	56	procedure TTest10.RunTest(CharSet: AnsiString; SQLDialect: integer);
171	tony	45	var Attachment: IAttachment;
172			DPB: IDPB;
173			begin
174			DPB := FirebirdAPI.AllocateDPB;
175			DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
176			DPB.Add(isc_dpb_password).setAsString(' ');
177			DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
178			DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
179			DPB.Find(isc_dpb_password).setAsString(Owner.GetPassword);
180			Attachment := FirebirdAPI.OpenDatabase(Owner.GetEmployeeDatabaseName,DPB);
181			EventsTest(Attachment);
182			Attachment.Disconnect;
183			end;
184
185			initialization
186			RegisterTest(TTest10);
187
188			end.
189