ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/fbintf/testsuite/Test1.pas

Comparing ibx/trunk/fbintf/testsuite/Test1.pas (file contents):
Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 345 by tony, Mon Aug 23 14:22:29 2021 UTC

#	Line 1 | Line 1
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}
34	>	{Test 1: 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
#	Line 11 | Line 42 | unit Test1;
42		A basic query is performed and finally the database dropped.
43		}
44
45	<	{$mode objfpc}{$H+}
45	>	{$IFDEF FPC}
46	>	{$mode delphi}
47		{$codepage utf8}
48	+	{$define HASREQEX}
49	+	{$ENDIF}
50
51		interface
52
53		uses
54	<	Classes, SysUtils, TestManager, IB;
54	>	Classes, SysUtils, TestApplication, FBTestApp, IB;
55
56		type
57
58		{ TTest1 }
59
60	<	TTest1 = class(TTestBase)
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: string; override;
67	<	procedure RunTest(CharSet: string; SQLDialect: integer); override;
66	>	function TestTitle: AnsiString; override;
67	>	procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
68		end;
69
70		implementation
#	Line 49 | Line 85 | begin
85		while ResultSet.FetchNext do
86		begin
87		for i := 0 to ResultSet.getCount - 1 do
88	<	writeln(OutFile,ResultSet[i].Name,' = ',ResultSet[i].AsString);
88	>	writeln(OutFile,ResultSet[i].Name,' = ',Trim(ResultSet[i].AsString));
89		end;
90		finally
91		ResultSet.Close;
#	Line 57 | Line 93 | begin
93		end;
94		end;
95
96	<	function TTest1.TestTitle: string;
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: string; SQLDialect: integer);
128	>	procedure TTest1.RunTest(CharSet: AnsiString; SQLDialect: integer);
129		var DPB: IDPB;
130		Attachment: IAttachment;
131	<	DBInfo: IDBInformation;
132	<	ConType: integer;
133	<	DBFileName: string;
71	<	DBSiteName: string;
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);
#	Line 77 | Line 139 | begin
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);
#	Line 86 | Line 173 | begin
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;
#	Line 100 | Line 189 | begin
189		writeln(OutFile,'Create Database Failed');
190		Exit;
191		end;
192	<	DBInfo := Attachment.GetDBInformation([isc_info_db_id]);
193	<	DBInfo[0].DecodeIDCluster(ConType,DBFileName,DBSiteName);
105	<	writeln(OutFile,'Database ID = ', ConType,' FB = ', DBFileName, ' SN = ',DBSiteName);
106	<	DBInfo := Attachment.GetDBInformation([isc_info_ods_version]);
107	<	write(OutFile,'ODS major = ',DBInfo[0].getAsInteger);
108	<	DBInfo := Attachment.GetDBInformation([isc_info_ods_minor_version]);
109	<	writeln(OutFile,' minor = ', DBInfo[0].getAsInteger );
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

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines