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',
                      [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(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(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(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:	341
Committed:	Wed Jul 7 13:11:53 2021 UTC (3 years, 5 months ago) by tony
Content type:	text/x-pascal
File size:	7106 byte(s)
Log Message:	Fixed Merged
#	Content
1	(*
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	unit Test1;
30	{$IFDEF MSWINDOWS}
31	{$DEFINE WINDOWS}
32	{$ENDIF}
33
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	{$IFDEF FPC}
46	{$mode delphi}
47	{$codepage utf8}
48	{$define HASREQEX}
49	{$ENDIF}
50
51	interface
52
53	uses
54	Classes, SysUtils, TestApplication, FBTestApp, IB;
55
56	type
57
58	{ TTest1 }
59
60	TTest1 = class(TFBTestBase)
61	private
62	procedure DoQuery(Attachment: IAttachment);
63	procedure WriteAttachmentInfo(Attachment: IAttachment);
64	procedure GetFBVersion(Attachment: IAttachment);
65	public
66	function TestTitle: AnsiString; override;
67	procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
68	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	writeln(OutFile,ResultSet[i].Name,' = ',Trim(ResultSet[i].AsString));
89	end;
90	finally
91	ResultSet.Close;
92	ResultSet.SetRetainInterfaces(false);
93	end;
94	end;
95
96	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	writeln(outfile,'Firebird Library Path = ',Attachment.getFirebirdAPI.GetFBLibrary.GetLibraryFilePath);
106	writeln(outfile,'DB Client Implementation Version = ',Attachment.getFirebirdAPI.GetImplementationVersion);
107	end;
108
109	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	function TTest1.TestTitle: AnsiString;
124	begin
125	Result := 'Test 1: Create and Drop a Database';
126	end;
127
128	procedure TTest1.RunTest(CharSet: AnsiString; SQLDialect: integer);
129	var DPB: IDPB;
130	Attachment: IAttachment;
131	createSQL: AnsiString;
132	libpath: string;
133	FBLibrary: IFirebirdLibrary;
134	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	writeln(OutFile,'Creating a Database using an SQL Statement');
143	createSQL := Format('create database ''%s'' USER ''%s'' PASSWORD ''%s'' DEFAULT CHARACTER SET %s',
144	[Owner.GetNewDatabaseName, Owner.GetUserName, Owner.GetPassword, CharSet]);
145	Attachment := FirebirdAPI.CreateDatabase(createSQL,SQLDialect);
146	WriteDBInfo(Attachment.GetDBInformation([isc_info_db_id,isc_info_db_SQL_Dialect]));
147	WriteAttachmentInfo(Attachment);
148	PrintDPB(Attachment.getDPB);
149	writeln(OutFile,'Firebird Server Version Info');
150	GetFBVersion(Attachment);
151	writeln(OutFile);
152
153	{$IFDEF HASREQEX}
154	{Demonstrate reconnect when database created with SQL Statement}
155	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
163	writeln(OutFile,'Dropping Database');
164	if Attachment <> nil then
165	Attachment.DropDatabase;
166
167	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	Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
175
176	WriteAttachmentInfo(Attachment);
177
178	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	Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
187	if Attachment = nil then
188	begin
189	writeln(OutFile,'Create Database Failed');
190	Exit;
191	end;
192	WriteDBInfo(Attachment.GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version]));
193	WriteAttachmentInfo(Attachment);
194
195	{Querying Database}
196	DoQuery(Attachment);
197
198	writeln(OutFile,'Dropping Database');
199	Attachment.DropDatabase;
200
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	Attachment := FBLibrary.GetFirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
208	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	end;
223
224
225	initialization
226	RegisterTest(TTest1);
227
228	end.
229