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
#	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			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