trunk/testsuite/Test02.pas

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