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}

{Test 1: 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 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.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:	353
Committed:	Sat Oct 23 14:11:37 2021 UTC (3 years, 1 month ago) by tony
Content type:	text/x-pascal
File size:	6246 byte(s)
Log Message:	Fixes Merged
#	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	tony	345	{Test 1: Create and Drop a Database}
35	tony	45	{
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	315	procedure GetFBVersion(Attachment: IAttachment);
64	tony	45	public
65	tony	56	function TestTitle: AnsiString; override;
66			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
67	tony	45	end;
68
69			implementation
70
71			{ TTest1 }
72
73			procedure TTest1.DoQuery(Attachment: IAttachment);
74			var Transaction: ITransaction;
75			Statement: IStatement;
76			ResultSet: IResultSet;
77			i: integer;
78			begin
79			Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
80			Statement := Attachment.Prepare(Transaction,'Select * from RDB$Database',3);
81			ResultSet := Statement.OpenCursor;
82			ResultSet.SetRetainInterfaces(true);
83			try
84			while ResultSet.FetchNext do
85			begin
86			for i := 0 to ResultSet.getCount - 1 do
87	tony	308	writeln(OutFile,ResultSet[i].Name,' = ',Trim(ResultSet[i].AsString));
88	tony	45	end;
89			finally
90			ResultSet.Close;
91			ResultSet.SetRetainInterfaces(false);
92			end;
93			end;
94
95	tony	315	procedure TTest1.GetFBVersion(Attachment: IAttachment);
96			var Version: TStrings;
97			i: integer;
98			begin
99			Version := TStringList.Create;
100			try
101			Attachment.getFBVersion(Version);
102			for i := 0 to Version.Count - 1 do
103			writeln(OutFile,Version[i]);
104			finally
105			Version.Free;
106			end;
107			end;
108
109	tony	56	function TTest1.TestTitle: AnsiString;
110	tony	45	begin
111			Result := 'Test 1: Create and Drop a Database';
112			end;
113
114	tony	56	procedure TTest1.RunTest(CharSet: AnsiString; SQLDialect: integer);
115	tony	45	var DPB: IDPB;
116			Attachment: IAttachment;
117	tony	56	createSQL: AnsiString;
118	tony	263	libpath: string;
119			FBLibrary: IFirebirdLibrary;
120	tony	45	begin
121			writeln(OutFile,'Creating a Database with empty parameters');
122			Attachment := FirebirdAPI.CreateDatabase('',nil,false);
123			if Attachment = nil then
124			writeln(OutFile,'Create Database fails (as expected): ',FirebirdAPI.GetStatus.GetMessage)
125			else
126			Attachment.DropDatabase;
127
128	tony	47	writeln(OutFile,'Creating a Database using an SQL Statement');
129	tony	117	createSQL := Format('create database ''%s'' USER ''%s'' PASSWORD ''%s'' DEFAULT CHARACTER SET %s',
130	tony	341	[Owner.GetNewDatabaseName, Owner.GetUserName, Owner.GetPassword, CharSet]);
131	tony	47	Attachment := FirebirdAPI.CreateDatabase(createSQL,SQLDialect);
132			WriteDBInfo(Attachment.GetDBInformation([isc_info_db_id,isc_info_db_SQL_Dialect]));
133	tony	143	WriteAttachmentInfo(Attachment);
134	tony	117	PrintDPB(Attachment.getDPB);
135	tony	315	writeln(OutFile,'Firebird Server Version Info');
136			GetFBVersion(Attachment);
137			writeln(OutFile);
138	tony	47
139	tony	119	{$IFDEF HASREQEX}
140	tony	117	{Demonstrate reconnect when database created with SQL Statement}
141	tony	119	try
142			Attachment.Disconnect;
143			Attachment.Connect;
144			except on E:Exception do
145			writeln(OutFile,'Error reconnecting to Database: ',E.Message);
146			end;
147			{$ENDIF}
148	tony	117
149	tony	47	writeln(OutFile,'Dropping Database');
150			if Attachment <> nil then
151			Attachment.DropDatabase;
152
153	tony	45	writeln(OutFile,'Creating a Database with a DPD');
154			DPB := FirebirdAPI.AllocateDPB;
155			DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
156			DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
157			DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
158			DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
159
160	tony	341	Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
161	tony	45
162	tony	143	WriteAttachmentInfo(Attachment);
163	tony	117
164	tony	45	writeln(OutFile,'Dropping Database');
165			if Attachment <> nil then
166			Attachment.DropDatabase;
167
168			{Open Database}
169
170			PrintDPB(DPB);
171			writeln(OutFile,'Creating a Database with a DPD');
172	tony	341	Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
173	tony	45	if Attachment = nil then
174			begin
175			writeln(OutFile,'Create Database Failed');
176			Exit;
177			end;
178	tony	47	WriteDBInfo(Attachment.GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version]));
179	tony	143	WriteAttachmentInfo(Attachment);
180	tony	45
181			{Querying Database}
182			DoQuery(Attachment);
183
184			writeln(OutFile,'Dropping Database');
185			Attachment.DropDatabase;
186	tony	263
187			libpath := GetEnvironmentVariable('TESTFIREBIRDLIBRARY');
188			if libpath <> '' then
189			begin
190			FBLibrary := LoadFBLibrary(libpath);
191
192			writeln(OutFile,'Creating a Database with a DPD using Firebird Library in ',libpath);
193	tony	341	Attachment := FBLibrary.GetFirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
194	tony	263	if Attachment = nil then
195			begin
196			writeln(OutFile,'Create Database Failed');
197			Exit;
198			end;
199			WriteDBInfo(Attachment.GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version]));
200			WriteAttachmentInfo(Attachment);
201
202			{Querying Database}
203			DoQuery(Attachment);
204
205			writeln(OutFile,'Dropping Database');
206			Attachment.DropDatabase;
207			end;
208	tony	45	end;
209
210
211			initialization
212			RegisterTest(TTest1);
213
214			end.
215