trunk/testsuite/Test02.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 Test02;

{$mode objfpc}{$H+}

{Test 2: Database Event Handlers and Idle disconnect}

{ This test opens and closes a database in order to test the connect/disconnect
  handlers. The database is re-opened to test disconnect on idle.

  The transaction handlers are also tested, along with Transaction end on idle.

  SQL Dialect Downgrade warning tested.
}

interface

uses
  Classes, SysUtils,   TestApplication, IBXTestBase, IB;

const
  aTestID    = '02';
  aTestTitle = 'Database Event Handlers and Idle disconnect';

type

{ TTest02 }

  TTest02 = class(TIBXTestBase)
  private
    FConnectedAt: TDateTime;
    FStartedAt: TDateTime;
    procedure HandleBeforeConnect(Sender: TObject);
    procedure HandleAfterConnect(Sender: TObject);
    procedure HandleBeforeDisconnect(Sender: TObject);
    procedure HandleAfterDisconnect(Sender: TObject);
    procedure HandleIdleTime(Sender: TObject);
    procedure HandleDialectDowngradeWarning(Sender: TObject);
    procedure HandleTransactionStart(Sender: TObject);
    procedure HandleBeforeTransactionEnd(Sender: TObject);
    procedure HandleAfterTransactionEnd(Sender: TObject);
  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

uses DateUtils, IBDatabase;

{ TTest02 }

procedure TTest02.HandleBeforeConnect(Sender: TObject);
begin
  writeln(OutFile,'Before Connect');
end;

procedure TTest02.HandleAfterConnect(Sender: TObject);
begin
  FConnectedAt := Now;
  writeln(OutFile,'Connected to ' + (Sender as TIBDatabase).DatabaseName);
  PrintDPB((Sender as TIBDatabase).attachment.getDPB);
end;

procedure TTest02.HandleBeforeDisconnect(Sender: TObject);
begin
  writeln(OutFile,'Before Disconnect');
end;

procedure TTest02.HandleAfterDisconnect(Sender: TObject);
begin
  writeln(OutFile,(Sender as TIBDatabase).DatabaseName,' Disconnected after ',MilliSecondsBetween(FConnectedAt,Now),' ms');
end;

procedure TTest02.HandleIdleTime(Sender: TObject);
begin
  writeln(OutFile,'Idle Timer Expired for ',(Sender as TComponent).Name);
end;

procedure TTest02.HandleDialectDowngradeWarning(Sender: TObject);
begin
  writeln(OutFile,'Warning: SQL Dialect Downgrade of ',(Sender as TIBDatabase).DatabaseName);
end;

procedure TTest02.HandleTransactionStart(Sender: TObject);
begin
  write(OutFile,'Requested ');
  PrintTPB((Sender as TIBTransaction).TPB);
  writeln(OutFile,'Transaction Starts');
  PrintTPB((Sender as TIBTransaction).TransactionIntf.getTPB);
  FStartedAt := Now;
end;

procedure TTest02.HandleBeforeTransactionEnd(Sender: TObject);
begin
  writeln(OutFile,'Transaction Ending');
end;

procedure TTest02.HandleAfterTransactionEnd(Sender: TObject);
begin
  writeln(OutFile,'Transaction Ended after ',MilliSecondsBetween(FStartedAt,Now),' ms');
end;

procedure TTest02.CreateObjects(Application: TTestApplication);
begin
  inherited CreateObjects(Application);
end;

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

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

procedure TTest02.InitTest;
begin
  IBDatabase.DatabaseName := Owner.GetEmployeeDatabaseName;
  IBDatabase.BeforeConnect := @HandleBeforeConnect;
  IBDatabase.AfterConnect := @HandleAfterConnect;
  IBDatabase.BeforeDisconnect := @HandleBeforeDisconnect;
  IBDatabase.AfterDisconnect := @HandleAfterDisconnect;
  IBDatabase.OnIdleTimer := @HandleIdleTime;
  IBDatabase.OnDialectDowngradeWarning := @HandleDialectDowngradeWarning;
  IBTransaction.OnStartTransaction := @HandleTransactionStart;
  IBTransaction.BeforeTransactionEnd := @HandleBeforeTransactionEnd;
  IBTransaction.AfterTransactionEnd := @HandleAfterTransactionEnd;
  IBTransaction.OnIdleTimer := @HandleIdleTime;
  ReadOnlyTransaction;
end;

procedure TTest02.RunTest(CharSet: AnsiString; SQLDialect: integer);
begin
  IBDatabase.Connected := true;
  IBDatabase.Connected := false;
  IBDatabase.IdleTimer := 2000; {miliseconds}
  IBDatabase.Connected := true;
  while IBDatabase.Connected do
    CheckSynchronize(100);
  writeln(OutFile,'Database Closed');

  writeln(OutFile,'Transaction Events');
  IBDatabase.Connected := true;
  IBTransaction.Active := true;
  IBTransaction.Active := false;
  writeln(Outfile,'Transaction idle timer test');
  IBTransaction.IdleTimer := 1000; {millseconds}
  IBTransaction.Active := true;
  while IBTransaction.Active do
    CheckSynchronize(100);
  IBDatabase.Connected := false;

  writeln(OutFile,'SQL Dialect Downgrade test');
  IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
  IBDatabase.CreateIfNotExists := true;
  IBDatabase.SQLDialect := 1;
  ReadWriteTransaction;
  IBDatabase.Connected := true;
  if IBDatabase.Connected then
  begin
    writeln(OutFile,IBDatabase.DatabaseName,' created');
    IBDatabase.Connected := false;
    IBDatabase.SQLDialect := 3;
    IBDatabase.Connected := true;
    IBDatabase.DropDatabase;
  end;
end;

initialization
  RegisterTest(TTest02);

end.

Revision:	323
Committed:	Thu Feb 25 12:14:35 2021 UTC (3 years, 2 months ago) by tony
Content type:	text/x-pascal
File size:	6110 byte(s)
Log Message:	Fixed Merged
#	Content
1	(*
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	unit Test02;
28
29	{$mode objfpc}{$H+}
30
31	{Test 2: Database Event Handlers and Idle disconnect}
32
33	{ This test opens and closes a database in order to test the connect/disconnect
34	handlers. The database is re-opened to test disconnect on idle.
35
36	The transaction handlers are also tested, along with Transaction end on idle.
37
38	SQL Dialect Downgrade warning tested.
39	}
40
41	interface
42
43	uses
44	Classes, SysUtils, TestApplication, IBXTestBase, IB;
45
46	const
47	aTestID = '02';
48	aTestTitle = 'Database Event Handlers and Idle disconnect';
49
50	type
51
52	{ TTest02 }
53
54	TTest02 = class(TIBXTestBase)
55	private
56	FConnectedAt: TDateTime;
57	FStartedAt: TDateTime;
58	procedure HandleBeforeConnect(Sender: TObject);
59	procedure HandleAfterConnect(Sender: TObject);
60	procedure HandleBeforeDisconnect(Sender: TObject);
61	procedure HandleAfterDisconnect(Sender: TObject);
62	procedure HandleIdleTime(Sender: TObject);
63	procedure HandleDialectDowngradeWarning(Sender: TObject);
64	procedure HandleTransactionStart(Sender: TObject);
65	procedure HandleBeforeTransactionEnd(Sender: TObject);
66	procedure HandleAfterTransactionEnd(Sender: TObject);
67	protected
68	procedure CreateObjects(Application: TTestApplication); override;
69	function GetTestID: AnsiString; override;
70	function GetTestTitle: AnsiString; override;
71	procedure InitTest; override;
72	public
73	procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
74	end;
75
76
77	implementation
78
79	uses DateUtils, IBDatabase;
80
81	{ TTest02 }
82
83	procedure TTest02.HandleBeforeConnect(Sender: TObject);
84	begin
85	writeln(OutFile,'Before Connect');
86	end;
87
88	procedure TTest02.HandleAfterConnect(Sender: TObject);
89	begin
90	FConnectedAt := Now;
91	writeln(OutFile,'Connected to ' + (Sender as TIBDatabase).DatabaseName);
92	PrintDPB((Sender as TIBDatabase).attachment.getDPB);
93	end;
94
95	procedure TTest02.HandleBeforeDisconnect(Sender: TObject);
96	begin
97	writeln(OutFile,'Before Disconnect');
98	end;
99
100	procedure TTest02.HandleAfterDisconnect(Sender: TObject);
101	begin
102	writeln(OutFile,(Sender as TIBDatabase).DatabaseName,' Disconnected after ',MilliSecondsBetween(FConnectedAt,Now),' ms');
103	end;
104
105	procedure TTest02.HandleIdleTime(Sender: TObject);
106	begin
107	writeln(OutFile,'Idle Timer Expired for ',(Sender as TComponent).Name);
108	end;
109
110	procedure TTest02.HandleDialectDowngradeWarning(Sender: TObject);
111	begin
112	writeln(OutFile,'Warning: SQL Dialect Downgrade of ',(Sender as TIBDatabase).DatabaseName);
113	end;
114
115	procedure TTest02.HandleTransactionStart(Sender: TObject);
116	begin
117	write(OutFile,'Requested ');
118	PrintTPB((Sender as TIBTransaction).TPB);
119	writeln(OutFile,'Transaction Starts');
120	PrintTPB((Sender as TIBTransaction).TransactionIntf.getTPB);
121	FStartedAt := Now;
122	end;
123
124	procedure TTest02.HandleBeforeTransactionEnd(Sender: TObject);
125	begin
126	writeln(OutFile,'Transaction Ending');
127	end;
128
129	procedure TTest02.HandleAfterTransactionEnd(Sender: TObject);
130	begin
131	writeln(OutFile,'Transaction Ended after ',MilliSecondsBetween(FStartedAt,Now),' ms');
132	end;
133
134	procedure TTest02.CreateObjects(Application: TTestApplication);
135	begin
136	inherited CreateObjects(Application);
137	end;
138
139	function TTest02.GetTestID: AnsiString;
140	begin
141	Result := aTestID;
142	end;
143
144	function TTest02.GetTestTitle: AnsiString;
145	begin
146	Result := aTestTitle;
147	end;
148
149	procedure TTest02.InitTest;
150	begin
151	IBDatabase.DatabaseName := Owner.GetEmployeeDatabaseName;
152	IBDatabase.BeforeConnect := @HandleBeforeConnect;
153	IBDatabase.AfterConnect := @HandleAfterConnect;
154	IBDatabase.BeforeDisconnect := @HandleBeforeDisconnect;
155	IBDatabase.AfterDisconnect := @HandleAfterDisconnect;
156	IBDatabase.OnIdleTimer := @HandleIdleTime;
157	IBDatabase.OnDialectDowngradeWarning := @HandleDialectDowngradeWarning;
158	IBTransaction.OnStartTransaction := @HandleTransactionStart;
159	IBTransaction.BeforeTransactionEnd := @HandleBeforeTransactionEnd;
160	IBTransaction.AfterTransactionEnd := @HandleAfterTransactionEnd;
161	IBTransaction.OnIdleTimer := @HandleIdleTime;
162	ReadOnlyTransaction;
163	end;
164
165	procedure TTest02.RunTest(CharSet: AnsiString; SQLDialect: integer);
166	begin
167	IBDatabase.Connected := true;
168	IBDatabase.Connected := false;
169	IBDatabase.IdleTimer := 2000; {miliseconds}
170	IBDatabase.Connected := true;
171	while IBDatabase.Connected do
172	CheckSynchronize(100);
173	writeln(OutFile,'Database Closed');
174
175	writeln(OutFile,'Transaction Events');
176	IBDatabase.Connected := true;
177	IBTransaction.Active := true;
178	IBTransaction.Active := false;
179	writeln(Outfile,'Transaction idle timer test');
180	IBTransaction.IdleTimer := 1000; {millseconds}
181	IBTransaction.Active := true;
182	while IBTransaction.Active do
183	CheckSynchronize(100);
184	IBDatabase.Connected := false;
185
186	writeln(OutFile,'SQL Dialect Downgrade test');
187	IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
188	IBDatabase.CreateIfNotExists := true;
189	IBDatabase.SQLDialect := 1;
190	ReadWriteTransaction;
191	IBDatabase.Connected := true;
192	if IBDatabase.Connected then
193	begin
194	writeln(OutFile,IBDatabase.DatabaseName,' created');
195	IBDatabase.Connected := false;
196	IBDatabase.SQLDialect := 3;
197	IBDatabase.Connected := true;
198	IBDatabase.DropDatabase;
199	end;
200	end;
201
202	initialization
203	RegisterTest(TTest02);
204
205	end.
206