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, 8 months ago) by tony
Content type:	text/x-pascal
File size:	6110 byte(s)
Log Message:	Fixed Merged
#	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 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