fbintf/testsuite/Test1.pas

(*
 *  Firebird Interface (fbintf) Test suite. This program is used to
 *  test the Firebird Pascal Interface and provide 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) 2016 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)

unit Test1;
{$IFDEF MSWINDOWS} 
{$DEFINE WINDOWS} 
{$ENDIF}

{Create and Drop a Database}
{
 This test first attempts to create a database without specifying any parameters
 (should fail). It then goes on to create and drop a database, print out the
 parameters and then creates it again (will fail if the dropdatabase failed silently.

 Some basic database info is then accessed and printed.

 A basic query is performed and finally the database dropped.
}

{$IFDEF FPC}
{$mode delphi}
{$codepage utf8}
{$define HASREQEX}
{$ENDIF}

interface

uses
  Classes, SysUtils, TestApplication, FBTestApp, IB;

type

  { TTest1 }

  TTest1 = class(TFBTestBase)
  private
    procedure DoQuery(Attachment: IAttachment);
    procedure WriteAttachmentInfo(Attachment: IAttachment);
    procedure GetFBVersion(Attachment: IAttachment);
  public
    function TestTitle: AnsiString; override;
    procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
  end;

implementation

{ TTest1 }

procedure TTest1.DoQuery(Attachment: IAttachment);
var Transaction: ITransaction;
    Statement: IStatement;
    ResultSet: IResultSet;
    i: integer;
begin
    Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
    Statement := Attachment.Prepare(Transaction,'Select * from RDB$Database',3);
    ResultSet := Statement.OpenCursor;
    ResultSet.SetRetainInterfaces(true);
    try
      while ResultSet.FetchNext do
      begin
        for i := 0 to ResultSet.getCount - 1 do
          writeln(OutFile,ResultSet[i].Name,' = ',Trim(ResultSet[i].AsString));
      end;
    finally
      ResultSet.Close;
      ResultSet.SetRetainInterfaces(false);
    end;
end;

procedure TTest1.WriteAttachmentInfo(Attachment: IAttachment);
begin
  writeln(outfile,'DB Connect String = ',Attachment.GetConnectString);
  writeln(outfile,'DB Charset ID = ',Attachment.GetDefaultCharSetID);
  writeln(outfile,'DB SQL Dialect = ',Attachment.GetSQLDialect);
  writeln(outfile,'DB Remote Protocol = ', Attachment.GetRemoteProtocol);
  writeln(outfile,'DB ODS Major Version = ',Attachment.GetODSMajorVersion);
  writeln(outfile,'DB ODS Minor Version = ',Attachment.GetODSMinorVersion);
  writeln(outfile,'User Authentication Method = ',Attachment.GetAuthenticationMethod);
  writeln(outfile,'Firebird Library Path = ',Attachment.getFirebirdAPI.GetFBLibrary.GetLibraryFilePath);
  writeln(outfile,'DB Client Implementation Version = ',Attachment.getFirebirdAPI.GetImplementationVersion);
end;

procedure TTest1.GetFBVersion(Attachment: IAttachment);
var Version: TStrings;
    i: integer;
begin
  Version := TStringList.Create;
  try
    Attachment.getFBVersion(Version);
    for i := 0 to Version.Count - 1 do
      writeln(OutFile,Version[i]);
  finally
    Version.Free;
  end;
end;

function TTest1.TestTitle: AnsiString;
begin
  Result := 'Test 1: Create and Drop a Database';
end;

procedure TTest1.RunTest(CharSet: AnsiString; SQLDialect: integer);
var DPB: IDPB;
    Attachment: IAttachment;
    createSQL: AnsiString;
    libpath: string;
    FBLibrary: IFirebirdLibrary;
begin
  writeln(OutFile,'Creating a Database with empty parameters');
  Attachment := FirebirdAPI.CreateDatabase('',nil,false);
  if Attachment = nil then
    writeln(OutFile,'Create Database fails (as expected): ',FirebirdAPI.GetStatus.GetMessage)
  else
    Attachment.DropDatabase;

  writeln(OutFile,'Creating a Database using an SQL Statement');
  createSQL := Format('create database ''%s'' USER ''%s'' PASSWORD ''%s'' DEFAULT CHARACTER SET %s',
                      [ExtractDBName(Owner.GetNewDatabaseName), Owner.GetUserName, Owner.GetPassword, CharSet]);
  Attachment := FirebirdAPI.CreateDatabase(createSQL,SQLDialect);
  WriteDBInfo(Attachment.GetDBInformation([isc_info_db_id,isc_info_db_SQL_Dialect]));
  WriteAttachmentInfo(Attachment);
  PrintDPB(Attachment.getDPB);
  writeln(OutFile,'Firebird Server Version Info');
  GetFBVersion(Attachment);
  writeln(OutFile);

  {$IFDEF HASREQEX}
  {Demonstrate reconnect when database created with SQL Statement}
  try
    Attachment.Disconnect;
    Attachment.Connect;
  except on E:Exception do
    writeln(OutFile,'Error reconnecting to Database: ',E.Message);
  end;
  {$ENDIF}

  writeln(OutFile,'Dropping Database');
  if Attachment <> nil then
    Attachment.DropDatabase;

  writeln(OutFile,'Creating a Database with a DPD');
  DPB := FirebirdAPI.AllocateDPB;
  DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
  DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
  DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
  DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);

  Attachment := FirebirdAPI.CreateDatabase(ExtractDBName(Owner.GetNewDatabaseName),DPB);

  WriteAttachmentInfo(Attachment);

  writeln(OutFile,'Dropping Database');
  if Attachment <> nil then
    Attachment.DropDatabase;

  {Open Database}

  PrintDPB(DPB);
  writeln(OutFile,'Creating a Database with a DPD');
  Attachment := FirebirdAPI.CreateDatabase(ExtractDBName(Owner.GetNewDatabaseName),DPB);
  if Attachment = nil then
  begin
    writeln(OutFile,'Create Database Failed');
    Exit;
  end;
  WriteDBInfo(Attachment.GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version]));
  WriteAttachmentInfo(Attachment);

  {Querying Database}
  DoQuery(Attachment);

  writeln(OutFile,'Dropping Database');
  Attachment.DropDatabase;

  libpath := GetEnvironmentVariable('TESTFIREBIRDLIBRARY');
  if libpath <> '' then
  begin
    FBLibrary := LoadFBLibrary(libpath);

    writeln(OutFile,'Creating a Database with a DPD using Firebird Library in ',libpath);
    Attachment := FBLibrary.GetFirebirdAPI.CreateDatabase(ExtractDBName(Owner.GetNewDatabaseName),DPB);
    if Attachment = nil then
    begin
      writeln(OutFile,'Create Database Failed');
      Exit;
    end;
    WriteDBInfo(Attachment.GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version]));
    WriteAttachmentInfo(Attachment);

    {Querying Database}
    DoQuery(Attachment);

    writeln(OutFile,'Dropping Database');
    Attachment.DropDatabase;
  end;
end;


initialization
  RegisterTest(TTest1);

end.

Revision:	315
Committed:	Thu Feb 25 11:56:36 2021 UTC (3 years, 9 months ago) by tony
Content type:	text/x-pascal
File size:	7166 byte(s)
Log Message:	Updated for IBX 4 release
#	User	Rev	Content
1	tony	315	(*
2			* Firebird Interface (fbintf) Test suite. This program is used to
3			* test the Firebird Pascal Interface and provide a semi-automated
4			* pass/fail check for each test.
5			*
6			* The contents of this file are subject to the Initial Developer's
7			* Public License Version 1.0 (the "License"); you may not use this
8			* file except in compliance with the License. You may obtain a copy
9			* of the License here:
10			*
11			* http://www.firebirdsql.org/index.php?op=doc&id=idpl
12			*
13			* Software distributed under the License is distributed on an "AS
14			* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
15			* implied. See the License for the specific language governing rights
16			* and limitations under the License.
17			*
18			* The Initial Developer of the Original Code is Tony Whyman.
19			*
20			* The Original Code is (C) 2016 Tony Whyman, MWA Software
21			* (http://www.mwasoftware.co.uk).
22			*
23			* All Rights Reserved.
24			*
25			* Contributor(s): ______________________________________.
26			*
27			*)
28
29	tony	45	unit Test1;
30	tony	56	{$IFDEF MSWINDOWS}
31			{$DEFINE WINDOWS}
32			{$ENDIF}
33	tony	45
34			{Create and Drop a Database}
35			{
36			This test first attempts to create a database without specifying any parameters
37			(should fail). It then goes on to create and drop a database, print out the
38			parameters and then creates it again (will fail if the dropdatabase failed silently.
39
40			Some basic database info is then accessed and printed.
41
42			A basic query is performed and finally the database dropped.
43			}
44
45	tony	56	{$IFDEF FPC}
46			{$mode delphi}
47	tony	45	{$codepage utf8}
48	tony	119	{$define HASREQEX}
49	tony	56	{$ENDIF}
50	tony	45
51			interface
52
53			uses
54	tony	315	Classes, SysUtils, TestApplication, FBTestApp, IB;
55	tony	45
56			type
57
58			{ TTest1 }
59
60	tony	315	TTest1 = class(TFBTestBase)
61	tony	45	private
62			procedure DoQuery(Attachment: IAttachment);
63	tony	143	procedure WriteAttachmentInfo(Attachment: IAttachment);
64	tony	315	procedure GetFBVersion(Attachment: IAttachment);
65	tony	45	public
66	tony	56	function TestTitle: AnsiString; override;
67			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
68	tony	45	end;
69
70			implementation
71
72			{ TTest1 }
73
74			procedure TTest1.DoQuery(Attachment: IAttachment);
75			var Transaction: ITransaction;
76			Statement: IStatement;
77			ResultSet: IResultSet;
78			i: integer;
79			begin
80			Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
81			Statement := Attachment.Prepare(Transaction,'Select * from RDB$Database',3);
82			ResultSet := Statement.OpenCursor;
83			ResultSet.SetRetainInterfaces(true);
84			try
85			while ResultSet.FetchNext do
86			begin
87			for i := 0 to ResultSet.getCount - 1 do
88	tony	308	writeln(OutFile,ResultSet[i].Name,' = ',Trim(ResultSet[i].AsString));
89	tony	45	end;
90			finally
91			ResultSet.Close;
92			ResultSet.SetRetainInterfaces(false);
93			end;
94			end;
95
96	tony	143	procedure TTest1.WriteAttachmentInfo(Attachment: IAttachment);
97			begin
98			writeln(outfile,'DB Connect String = ',Attachment.GetConnectString);
99			writeln(outfile,'DB Charset ID = ',Attachment.GetDefaultCharSetID);
100			writeln(outfile,'DB SQL Dialect = ',Attachment.GetSQLDialect);
101			writeln(outfile,'DB Remote Protocol = ', Attachment.GetRemoteProtocol);
102			writeln(outfile,'DB ODS Major Version = ',Attachment.GetODSMajorVersion);
103			writeln(outfile,'DB ODS Minor Version = ',Attachment.GetODSMinorVersion);
104			writeln(outfile,'User Authentication Method = ',Attachment.GetAuthenticationMethod);
105	tony	263	writeln(outfile,'Firebird Library Path = ',Attachment.getFirebirdAPI.GetFBLibrary.GetLibraryFilePath);
106			writeln(outfile,'DB Client Implementation Version = ',Attachment.getFirebirdAPI.GetImplementationVersion);
107	tony	143	end;
108
109	tony	315	procedure TTest1.GetFBVersion(Attachment: IAttachment);
110			var Version: TStrings;
111			i: integer;
112			begin
113			Version := TStringList.Create;
114			try
115			Attachment.getFBVersion(Version);
116			for i := 0 to Version.Count - 1 do
117			writeln(OutFile,Version[i]);
118			finally
119			Version.Free;
120			end;
121			end;
122
123	tony	56	function TTest1.TestTitle: AnsiString;
124	tony	45	begin
125			Result := 'Test 1: Create and Drop a Database';
126			end;
127
128	tony	56	procedure TTest1.RunTest(CharSet: AnsiString; SQLDialect: integer);
129	tony	45	var DPB: IDPB;
130			Attachment: IAttachment;
131	tony	56	createSQL: AnsiString;
132	tony	263	libpath: string;
133			FBLibrary: IFirebirdLibrary;
134	tony	45	begin
135			writeln(OutFile,'Creating a Database with empty parameters');
136			Attachment := FirebirdAPI.CreateDatabase('',nil,false);
137			if Attachment = nil then
138			writeln(OutFile,'Create Database fails (as expected): ',FirebirdAPI.GetStatus.GetMessage)
139			else
140			Attachment.DropDatabase;
141
142	tony	47	writeln(OutFile,'Creating a Database using an SQL Statement');
143	tony	117	createSQL := Format('create database ''%s'' USER ''%s'' PASSWORD ''%s'' DEFAULT CHARACTER SET %s',
144	tony	308	[ExtractDBName(Owner.GetNewDatabaseName), Owner.GetUserName, Owner.GetPassword, CharSet]);
145	tony	47	Attachment := FirebirdAPI.CreateDatabase(createSQL,SQLDialect);
146			WriteDBInfo(Attachment.GetDBInformation([isc_info_db_id,isc_info_db_SQL_Dialect]));
147	tony	143	WriteAttachmentInfo(Attachment);
148	tony	117	PrintDPB(Attachment.getDPB);
149	tony	315	writeln(OutFile,'Firebird Server Version Info');
150			GetFBVersion(Attachment);
151			writeln(OutFile);
152	tony	47
153	tony	119	{$IFDEF HASREQEX}
154	tony	117	{Demonstrate reconnect when database created with SQL Statement}
155	tony	119	try
156			Attachment.Disconnect;
157			Attachment.Connect;
158			except on E:Exception do
159			writeln(OutFile,'Error reconnecting to Database: ',E.Message);
160			end;
161			{$ENDIF}
162	tony	117
163	tony	47	writeln(OutFile,'Dropping Database');
164			if Attachment <> nil then
165			Attachment.DropDatabase;
166
167	tony	45	writeln(OutFile,'Creating a Database with a DPD');
168			DPB := FirebirdAPI.AllocateDPB;
169			DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
170			DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
171			DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
172			DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
173
174	tony	308	Attachment := FirebirdAPI.CreateDatabase(ExtractDBName(Owner.GetNewDatabaseName),DPB);
175	tony	45
176	tony	143	WriteAttachmentInfo(Attachment);
177	tony	117
178	tony	45	writeln(OutFile,'Dropping Database');
179			if Attachment <> nil then
180			Attachment.DropDatabase;
181
182			{Open Database}
183
184			PrintDPB(DPB);
185			writeln(OutFile,'Creating a Database with a DPD');
186	tony	308	Attachment := FirebirdAPI.CreateDatabase(ExtractDBName(Owner.GetNewDatabaseName),DPB);
187	tony	45	if Attachment = nil then
188			begin
189			writeln(OutFile,'Create Database Failed');
190			Exit;
191			end;
192	tony	47	WriteDBInfo(Attachment.GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version]));
193	tony	143	WriteAttachmentInfo(Attachment);
194	tony	45
195			{Querying Database}
196			DoQuery(Attachment);
197
198			writeln(OutFile,'Dropping Database');
199			Attachment.DropDatabase;
200	tony	263
201			libpath := GetEnvironmentVariable('TESTFIREBIRDLIBRARY');
202			if libpath <> '' then
203			begin
204			FBLibrary := LoadFBLibrary(libpath);
205
206			writeln(OutFile,'Creating a Database with a DPD using Firebird Library in ',libpath);
207	tony	308	Attachment := FBLibrary.GetFirebirdAPI.CreateDatabase(ExtractDBName(Owner.GetNewDatabaseName),DPB);
208	tony	263	if Attachment = nil then
209			begin
210			writeln(OutFile,'Create Database Failed');
211			Exit;
212			end;
213			WriteDBInfo(Attachment.GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version]));
214			WriteAttachmentInfo(Attachment);
215
216			{Querying Database}
217			DoQuery(Attachment);
218
219			writeln(OutFile,'Dropping Database');
220			Attachment.DropDatabase;
221			end;
222	tony	45	end;
223
224
225			initialization
226			RegisterTest(TTest1);
227
228			end.
229