ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/testsuite/Test1.pas
Revision: 315
Committed: Thu Feb 25 11:56:36 2021 UTC (3 years, 1 month ago) by tony
Content type: text/x-pascal
File size: 7166 byte(s)
Log Message:
Updated for IBX 4 release

File Contents

# 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 [ExtractDBName(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(ExtractDBName(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(ExtractDBName(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(ExtractDBName(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