trunk/testsuite/Test03.pas

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