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

{$mode objfpc}{$H+}

{Test 3: Database Information}

{ Open the employee database and show database information.

  Also tests wire compression and hence config overrides, along with a lookup table
  for a system table.
}

interface

uses
  Classes, SysUtils,  TestApplication, IBXTestBase, IB, IBDatabaseInfo, IBQuery, IBDatabase;

const
  aTestID    = '03';
  aTestTitle = 'Database Information';

type

{ Test3 }

  Test3 = class(TIBXTestBase)
  private
    FIBDatabaseInfo: TIBDatabaseInfo;
    FTableNameLookup: TIBQuery;
    procedure AddPerfStats(Heading: string; stats: TStrings);
    function HexString(s: AnsiString): string;
  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

{ Test3 }

procedure Test3.AddPerfStats(Heading: string; stats: TStrings);
var i: integer;
begin
  if stats.count = 0 then exit;
  writeln(OutFile,'');
  writeln(OutFile,Heading);
  for i := 0 to stats.Count - 1 do
  begin
    if FTableNameLookup.Locate('RDB$RELATION_ID',stats.Names[i],[]) then
      writeln(OutFile,'  ' + FTableNameLookup.FieldByName('RDB$RELATION_NAME').AsString + ' = ' + stats.ValueFromIndex[i]);
  end;
end;

function Test3.HexString(s: AnsiString): string;
var i: integer;
begin
  Result := '';
  for i := 1 to length(s) do
    Result += Format('%x ',[byte(s[i])]);
end;

procedure Test3.CreateObjects(Application: TTestApplication);
begin
  inherited CreateObjects(Application);
  FIBDatabaseInfo := TIBDatabaseInfo.Create(Application);
  FIBDatabaseInfo.Database := IBDatabase;
  FTableNameLookup := TIBQuery.Create(Application);
  FTableNameLookup.Database := IBDatabase;
  FTableNameLookup.Transaction := IBTransaction;
  FTableNameLookup.SQL.Text := 'SELECT r.RDB$RELATION_ID, trim(r.RDB$RELATION_NAME) as RDB$RELATION_NAME FROM RDB$RELATIONS r';
end;

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

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

procedure Test3.InitTest;
begin
  IBDatabase.DatabaseName := Owner.GetEmployeeDatabaseName;
  ReadOnlyTransaction;
end;

procedure Test3.RunTest(CharSet: AnsiString; SQLDialect: integer);
var S: TStrings;
    i: integer;
begin
  if FirebirdAPI.GetClientMajor >= 3 then
    IBDatabase.WireCompression := true;
  IBDatabase.Connected := true;
  IBTransaction.Active := true;
  FTableNameLookup.Active := true;
  writeln(OutFile,'Authentication Method = '+ IBDatabase.AuthenticationMethod);
  writeln(OutFile,'Remote Protocol = ' + IBDatabase.RemoteProtocol);
  writeln(OutFile,'Attachment SQLDialect = ' + IntToStr(IBDatabase.DBSQLDialect));
  S := TStringList.Create;
  try
    IBDatabase.Attachment.getFBVersion(S);
    for i := 0 to S.Count - 1 do
      writeln(OutFile,S[i]);
  finally
    S.Free;
  end;
  ShowFBVersion(IBDatabase.attachment);  {Wire Compression on if includes 'Z' flag}
  with FIBDatabaseInfo do
  begin
    writeln(OutFile,'Firebird Library Pathname = ' + IBDatabase.FirebirdAPI.GetFBLibrary.GetLibraryFilePath);
    writeln(OutFile,'DB SQLDialect = ' + IntToStr(DBSQLDialect));
    writeln(OutFile,'Allocation = ' + IntToStr(Allocation));
    writeln(OutFile,'Base Level = ' + IntToStr(BaseLevel));
    writeln(OutFile,'DB File Name = ' + DBFileName);
    writeln(OutFile,'DB Site Name = ' + DBSiteName);
    writeln(OutFile,'DB Implementation No = ' + IntToStr(DBImplementationNo));
    writeln(OutFile,'Database Created: ' + DateTimeToStr(DateDBCreated));
    writeln(OutFile,'DB Implementation Class = ' + IntToStr(DBImplementationClass));
    ShowBoolValue(NoReserve, 'No Space Reserved','Space is Reserved');
    writeln(OutFile,'ODS Minor Version = ' + IntToStr(ODSMinorVersion));
    writeln(OutFile,'ODS Major Version = ' + IntToStr(ODSMajorVersion));
    writeln(OutFile,'Page Size = ' + IntToStr(PageSize));
    writeln(OutFile,'Version = ' + Version);
    writeln(OutFile,'Current Memory = ' + IntToStr(CurrentMemory));
    ShowBoolValue(ForcedWrites,'Forced Writes Enabled','Forced Writes Disabled');
    writeln(OutFile,'Max Memory = ' + IntToStr(MaxMemory));
    writeln(OutFile,'Number of Buffers = ' + IntToStr(NumBuffers));
    writeln(OutFile,'Sweep Interval = ' + IntToStr(SweepInterval));
    ShowStrings('User Names',UserNames);
    writeln(OutFile,'Fetches = ' + IntToStr(Fetches));
    writeln(OutFile,'Marks = ' + IntToStr(Marks));
    writeln(OutFile,'Reads = ' + IntToStr(Reads));
    writeln(OutFile,'Writes = ' + IntToStr(Writes));
    if ODSMajorVersion >= 12 then
    begin
      writeln(OutFile,'Pages Free = ' + IntToStr(PagesFree));
      writeln(OutFile,'Pages Used = ' + IntToStr(PagesUsed));
    end;
    writeln(OutFile,'Transaction Count = ' + IntToStr(TransactionCount));
    AddPerfStats('Backout Count',BackoutCount);
    AddPerfStats('Delete Count',DeleteCount);
    AddPerfStats('Expunge Count',ExpungeCount);
    AddPerfStats('Insert Count',InsertCount);
    AddPerfStats('Purge Count',PurgeCount);
    AddPerfStats('Read Idx Count',ReadIdxCount);
    AddPerfStats('Read Seq Count',ReadSeqCount);
    AddPerfStats('Update Count',UpdateCount);
    writeln(OutFile,'');
    ShowBoolValue(ReadOnly,'Database is Read Only','Database is Read/Write');
    writeln(OutFile,'Hex Dump of Database Page 100:');
    writeln(OutFile,HexString(GetDatabasePage(100)));
  end;
end;

initialization
  RegisterTest(Test3);

end.

Revision:	380
Committed:	Mon Jan 10 10:13:17 2022 UTC (2 years, 10 months ago) by tony
Content type:	text/x-pascal
File size:	6538 byte(s)
Log Message:	propset for eol-style
#	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 Test03;
28
29			{$mode objfpc}{$H+}
30
31			{Test 3: Database Information}
32
33			{ Open the employee database and show database information.
34
35			Also tests wire compression and hence config overrides, along with a lookup table
36			for a system table.
37			}
38
39			interface
40
41			uses
42			Classes, SysUtils, TestApplication, IBXTestBase, IB, IBDatabaseInfo, IBQuery, IBDatabase;
43
44			const
45			aTestID = '03';
46			aTestTitle = 'Database Information';
47
48			type
49
50			{ Test3 }
51
52			Test3 = class(TIBXTestBase)
53			private
54			FIBDatabaseInfo: TIBDatabaseInfo;
55			FTableNameLookup: TIBQuery;
56			procedure AddPerfStats(Heading: string; stats: TStrings);
57			function HexString(s: AnsiString): string;
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			{ Test3 }
71
72			procedure Test3.AddPerfStats(Heading: string; stats: TStrings);
73			var i: integer;
74			begin
75			if stats.count = 0 then exit;
76			writeln(OutFile,'');
77			writeln(OutFile,Heading);
78			for i := 0 to stats.Count - 1 do
79			begin
80			if FTableNameLookup.Locate('RDB$RELATION_ID',stats.Names[i],[]) then
81			writeln(OutFile,' ' + FTableNameLookup.FieldByName('RDB$RELATION_NAME').AsString + ' = ' + stats.ValueFromIndex[i]);
82			end;
83			end;
84
85			function Test3.HexString(s: AnsiString): string;
86			var i: integer;
87			begin
88			Result := '';
89			for i := 1 to length(s) do
90			Result += Format('%x ',[byte(s[i])]);
91			end;
92
93			procedure Test3.CreateObjects(Application: TTestApplication);
94			begin
95			inherited CreateObjects(Application);
96			FIBDatabaseInfo := TIBDatabaseInfo.Create(Application);
97			FIBDatabaseInfo.Database := IBDatabase;
98			FTableNameLookup := TIBQuery.Create(Application);
99			FTableNameLookup.Database := IBDatabase;
100			FTableNameLookup.Transaction := IBTransaction;
101			FTableNameLookup.SQL.Text := 'SELECT r.RDB$RELATION_ID, trim(r.RDB$RELATION_NAME) as RDB$RELATION_NAME FROM RDB$RELATIONS r';
102			end;
103
104			function Test3.GetTestID: AnsiString;
105			begin
106			Result := aTestID;
107			end;
108
109			function Test3.GetTestTitle: AnsiString;
110			begin
111			Result := aTestTitle;
112			end;
113
114			procedure Test3.InitTest;
115			begin
116			IBDatabase.DatabaseName := Owner.GetEmployeeDatabaseName;
117			ReadOnlyTransaction;
118			end;
119
120			procedure Test3.RunTest(CharSet: AnsiString; SQLDialect: integer);
121			var S: TStrings;
122			i: integer;
123			begin
124			if FirebirdAPI.GetClientMajor >= 3 then
125			IBDatabase.WireCompression := true;
126			IBDatabase.Connected := true;
127			IBTransaction.Active := true;
128			FTableNameLookup.Active := true;
129			writeln(OutFile,'Authentication Method = '+ IBDatabase.AuthenticationMethod);
130			writeln(OutFile,'Remote Protocol = ' + IBDatabase.RemoteProtocol);
131			writeln(OutFile,'Attachment SQLDialect = ' + IntToStr(IBDatabase.DBSQLDialect));
132			S := TStringList.Create;
133			try
134			IBDatabase.Attachment.getFBVersion(S);
135			for i := 0 to S.Count - 1 do
136			writeln(OutFile,S[i]);
137			finally
138			S.Free;
139			end;
140			ShowFBVersion(IBDatabase.attachment); {Wire Compression on if includes 'Z' flag}
141			with FIBDatabaseInfo do
142			begin
143			writeln(OutFile,'Firebird Library Pathname = ' + IBDatabase.FirebirdAPI.GetFBLibrary.GetLibraryFilePath);
144			writeln(OutFile,'DB SQLDialect = ' + IntToStr(DBSQLDialect));
145			writeln(OutFile,'Allocation = ' + IntToStr(Allocation));
146			writeln(OutFile,'Base Level = ' + IntToStr(BaseLevel));
147			writeln(OutFile,'DB File Name = ' + DBFileName);
148			writeln(OutFile,'DB Site Name = ' + DBSiteName);
149			writeln(OutFile,'DB Implementation No = ' + IntToStr(DBImplementationNo));
150			writeln(OutFile,'Database Created: ' + DateTimeToStr(DateDBCreated));
151			writeln(OutFile,'DB Implementation Class = ' + IntToStr(DBImplementationClass));
152			ShowBoolValue(NoReserve, 'No Space Reserved','Space is Reserved');
153			writeln(OutFile,'ODS Minor Version = ' + IntToStr(ODSMinorVersion));
154			writeln(OutFile,'ODS Major Version = ' + IntToStr(ODSMajorVersion));
155			writeln(OutFile,'Page Size = ' + IntToStr(PageSize));
156			writeln(OutFile,'Version = ' + Version);
157			writeln(OutFile,'Current Memory = ' + IntToStr(CurrentMemory));
158			ShowBoolValue(ForcedWrites,'Forced Writes Enabled','Forced Writes Disabled');
159			writeln(OutFile,'Max Memory = ' + IntToStr(MaxMemory));
160			writeln(OutFile,'Number of Buffers = ' + IntToStr(NumBuffers));
161			writeln(OutFile,'Sweep Interval = ' + IntToStr(SweepInterval));
162			ShowStrings('User Names',UserNames);
163			writeln(OutFile,'Fetches = ' + IntToStr(Fetches));
164			writeln(OutFile,'Marks = ' + IntToStr(Marks));
165			writeln(OutFile,'Reads = ' + IntToStr(Reads));
166			writeln(OutFile,'Writes = ' + IntToStr(Writes));
167			if ODSMajorVersion >= 12 then
168			begin
169			writeln(OutFile,'Pages Free = ' + IntToStr(PagesFree));
170			writeln(OutFile,'Pages Used = ' + IntToStr(PagesUsed));
171			end;
172			writeln(OutFile,'Transaction Count = ' + IntToStr(TransactionCount));
173			AddPerfStats('Backout Count',BackoutCount);
174			AddPerfStats('Delete Count',DeleteCount);
175			AddPerfStats('Expunge Count',ExpungeCount);
176			AddPerfStats('Insert Count',InsertCount);
177			AddPerfStats('Purge Count',PurgeCount);
178			AddPerfStats('Read Idx Count',ReadIdxCount);
179			AddPerfStats('Read Seq Count',ReadSeqCount);
180			AddPerfStats('Update Count',UpdateCount);
181			writeln(OutFile,'');
182			ShowBoolValue(ReadOnly,'Database is Read Only','Database is Read/Write');
183			writeln(OutFile,'Hex Dump of Database Page 100:');
184			writeln(OutFile,HexString(GetDatabasePage(100)));
185			end;
186			end;
187
188			initialization
189			RegisterTest(Test3);
190
191			end.
192