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
#	User	Rev	Content
1	tony	315	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