trunk/testsuite/Test11.pas

(*
 *  IBX Test suite. This program is used to test the IBX non-visual
 *  components and provides a semi-automated pass/fail check for each test.
 *
 *  The contents of this file are subject to the Initial Developer's
 *  Public License Version 1.0 (the "License"); you may not use this
 *  file except in compliance with the License. You may obtain a copy
 *  of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2021 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)      
unit Test11;

{$mode objfpc}{$H+}

{Test 11: Event Handling}

{ This tests calling an event handler in response to a database event.
  A simple database is used consisting of a stored procedure only.
  Two cases are tested: event registration before and after DB Open.
}

interface

uses
  Classes, SysUtils,   TestApplication, IBXTestBase, IB, IBEvents,
  IBStoredProc;

const
  aTestID    = '11';
  aTestTitle = 'Event Handling';

type

{ TTest11 }

  TTest11 = class(TIBXTestBase)
  private
    FEvents: TIBEvents;
    FExecProc: TIBStoredProc;
    procedure EventHandler( Sender: TObject; EventName: string; EventCount: longint;
                           var CancelAlerts: Boolean);
  protected
    procedure CreateObjects(Application: TTestApplication); override;
    function GetTestID: AnsiString; override;
    function GetTestTitle: AnsiString; override;
    procedure InitTest; override;
  public
    procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
  end;


implementation

{ TTest11 }

procedure TTest11.EventHandler(Sender: TObject; EventName: string;
  EventCount: longint; var CancelAlerts: Boolean);
begin
  writeln(OutFile,'Event Handled: ',EventName, ', Count = ',EventCount);
end;

procedure TTest11.CreateObjects(Application: TTestApplication);
begin
  inherited CreateObjects(Application);
  FEvents := TIBEvents.Create(Application);
  FEvents.Database := IBDatabase;
  FEvents.OnEventAlert := @EventHandler;
  FEvents.Events.Add('EVENT1');
  FEvents.Events.Add('EVENT2');
  FExecProc := TIBStoredProc.Create(Application);
  FExecProc.Database := IBDatabase;
end;

function TTest11.GetTestID: AnsiString;
begin
  Result := aTestID;
end;

function TTest11.GetTestTitle: AnsiString;
begin
  Result := aTestTitle;
end;

procedure TTest11.InitTest;
begin
  IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
  IBDatabase.CreateIfNotExists := true;
  ReadWriteTransaction;
end;

procedure TTest11.RunTest(CharSet: AnsiString; SQLDialect: integer);
begin
  writeln(OutFile,'Case #1: Deferred Event Registration');
  FEvents.DeferredRegister := true;
  IBDatabase.Connected := true;
  try
    IBTransaction.Active := true;
    CheckSynchronize(1);
    FExecProc.StoredProcName := 'CALLEVENT';
    FExecProc.Prepare;
    FExecProc.Params[0].AsString := 'EVENT1';
    FExecProc.ExecProc;
    writeln(OutFile,'Event Called');
    IBTransaction.Commit;
    CheckSynchronize(100);
    FEvents.UnRegisterEvents;
  finally
    CheckSynchronize(100);
    IBDatabase.DropDatabase;
  end;
  writeln(OutFile,'Case #2: Event Registration after DB Open');
  IBDatabase.Connected := true;
  try
    FEvents.Registered := true;
    IBTransaction.Active := true;
    CheckSynchronize(1);
    FExecProc.StoredProcName := 'CALLEVENT';
    FExecProc.Prepare;
    FExecProc.Params[0].AsString := 'EVENT2';
    FExecProc.ExecProc;
    writeln(OutFile,'Event Called');
    IBTransaction.Commit;
    CheckSynchronize(100);
//    Sleep(1000);
    FEvents.UnRegisterEvents;
  finally
    CheckSynchronize(100);
    IBDatabase.DropDatabase;
  end;
end;

initialization
  RegisterTest(TTest11);

end.

Revision:	410
Committed:	Thu Jun 22 13:52:39 2023 UTC (17 months ago) by tony
Content type:	text/x-pascal
File size:	4071 byte(s)
Log Message:	Release 2.6.0 beta
#	User	Rev	Content
1	tony	323	(*
2			* IBX Test suite. This program is used to test the IBX non-visual
3			* components and provides a semi-automated pass/fail check for each test.
4			*
5			* The contents of this file are subject to the Initial Developer's
6			* Public License Version 1.0 (the "License"); you may not use this
7			* file except in compliance with the License. You may obtain a copy
8			* of the License here:
9			*
10			* http://www.firebirdsql.org/index.php?op=doc&id=idpl
11			*
12			* Software distributed under the License is distributed on an "AS
13			* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
14			* implied. See the License for the specific language governing rights
15			* and limitations under the License.
16			*
17			* The Initial Developer of the Original Code is Tony Whyman.
18			*
19			* The Original Code is (C) 2021 Tony Whyman, MWA Software
20			* (http://www.mwasoftware.co.uk).
21			*
22			* All Rights Reserved.
23			*
24			* Contributor(s): ______________________________________.
25			*
26			*)
27	tony	315	unit Test11;
28
29			{$mode objfpc}{$H+}
30
31			{Test 11: Event Handling}
32
33			{ This tests calling an event handler in response to a database event.
34			A simple database is used consisting of a stored procedure only.
35			Two cases are tested: event registration before and after DB Open.
36			}
37
38			interface
39
40			uses
41			Classes, SysUtils, TestApplication, IBXTestBase, IB, IBEvents,
42			IBStoredProc;
43
44			const
45			aTestID = '11';
46			aTestTitle = 'Event Handling';
47
48			type
49
50			{ TTest11 }
51
52			TTest11 = class(TIBXTestBase)
53			private
54			FEvents: TIBEvents;
55			FExecProc: TIBStoredProc;
56			procedure EventHandler( Sender: TObject; EventName: string; EventCount: longint;
57			var CancelAlerts: Boolean);
58			protected
59			procedure CreateObjects(Application: TTestApplication); override;
60			function GetTestID: AnsiString; override;
61			function GetTestTitle: AnsiString; override;
62			procedure InitTest; override;
63			public
64			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
65			end;
66
67
68			implementation
69
70			{ TTest11 }
71
72			procedure TTest11.EventHandler(Sender: TObject; EventName: string;
73			EventCount: longint; var CancelAlerts: Boolean);
74			begin
75			writeln(OutFile,'Event Handled: ',EventName, ', Count = ',EventCount);
76			end;
77
78			procedure TTest11.CreateObjects(Application: TTestApplication);
79			begin
80			inherited CreateObjects(Application);
81			FEvents := TIBEvents.Create(Application);
82			FEvents.Database := IBDatabase;
83			FEvents.OnEventAlert := @EventHandler;
84			FEvents.Events.Add('EVENT1');
85			FEvents.Events.Add('EVENT2');
86			FExecProc := TIBStoredProc.Create(Application);
87			FExecProc.Database := IBDatabase;
88			end;
89
90			function TTest11.GetTestID: AnsiString;
91			begin
92			Result := aTestID;
93			end;
94
95			function TTest11.GetTestTitle: AnsiString;
96			begin
97			Result := aTestTitle;
98			end;
99
100			procedure TTest11.InitTest;
101			begin
102			IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
103			IBDatabase.CreateIfNotExists := true;
104			ReadWriteTransaction;
105			end;
106
107			procedure TTest11.RunTest(CharSet: AnsiString; SQLDialect: integer);
108			begin
109			writeln(OutFile,'Case #1: Deferred Event Registration');
110			FEvents.DeferredRegister := true;
111			IBDatabase.Connected := true;
112			try
113			IBTransaction.Active := true;
114			CheckSynchronize(1);
115			FExecProc.StoredProcName := 'CALLEVENT';
116			FExecProc.Prepare;
117			FExecProc.Params[0].AsString := 'EVENT1';
118			FExecProc.ExecProc;
119			writeln(OutFile,'Event Called');
120			IBTransaction.Commit;
121	tony	410	CheckSynchronize(100);
122			FEvents.UnRegisterEvents;
123	tony	315	finally
124	tony	410	CheckSynchronize(100);
125	tony	315	IBDatabase.DropDatabase;
126			end;
127			writeln(OutFile,'Case #2: Event Registration after DB Open');
128			IBDatabase.Connected := true;
129			try
130			FEvents.Registered := true;
131			IBTransaction.Active := true;
132			CheckSynchronize(1);
133			FExecProc.StoredProcName := 'CALLEVENT';
134			FExecProc.Prepare;
135			FExecProc.Params[0].AsString := 'EVENT2';
136			FExecProc.ExecProc;
137			writeln(OutFile,'Event Called');
138			IBTransaction.Commit;
139	tony	410	CheckSynchronize(100);
140			// Sleep(1000);
141	tony	315	FEvents.UnRegisterEvents;
142			finally
143	tony	410	CheckSynchronize(100);
144	tony	315	IBDatabase.DropDatabase;
145			end;
146			end;
147
148			initialization
149			RegisterTest(TTest11);
150
151			end.
152