ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/fbintf/testsuite/Test1.pas
Revision: 363
Committed: Tue Dec 7 13:30:05 2021 UTC (8 months ago) by tony
File size: 6380 byte(s)
Log Message:
add fbintf
Line File contents
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 {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
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 GetFBVersion(Attachment: IAttachment);
64 public
65 function TestTitle: AnsiString; override;
66 procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
67 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 writeln(OutFile,ResultSet[i].Name,' = ',Trim(ResultSet[i].AsString));
88 end;
89 finally
90 ResultSet.Close;
91 ResultSet.SetRetainInterfaces(false);
92 end;
93 end;
94
95 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 function TTest1.TestTitle: AnsiString;
110 begin
111 Result := 'Test 1: Create and Drop a Database';
112 end;
113
114 procedure TTest1.RunTest(CharSet: AnsiString; SQLDialect: integer);
115 var DPB: IDPB;
116 Attachment: IAttachment;
117 createSQL: AnsiString;
118 libpath: string;
119 FBLibrary: IFirebirdLibrary;
120 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 writeln(OutFile,'Creating a Database using an SQL Statement');
129 createSQL := Format('create database ''%s'' USER ''%s'' PASSWORD ''%s'' DEFAULT CHARACTER SET %s',
130 [Owner.GetNewDatabaseName, Owner.GetUserName, Owner.GetPassword, CharSet]);
131 Attachment := FirebirdAPI.CreateDatabase(createSQL,SQLDialect);
132 WriteDBInfo(Attachment.GetDBInformation([isc_info_db_id,isc_info_db_SQL_Dialect]));
133 WriteAttachmentInfo(Attachment);
134 PrintDPB(Attachment.getDPB);
135 writeln(OutFile,'Firebird Server Version Info');
136 GetFBVersion(Attachment);
137 writeln(OutFile);
138
139 {$IFDEF HASREQEX}
140 {Demonstrate reconnect when database created with SQL Statement}
141 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
149 writeln(OutFile,'Dropping Database');
150 if Attachment <> nil then
151 Attachment.DropDatabase;
152
153 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 Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
161
162 WriteAttachmentInfo(Attachment);
163
164 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 Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
173 if Attachment = nil then
174 begin
175 writeln(OutFile,'Create Database Failed');
176 Exit;
177 end;
178 WriteDBInfo(Attachment.GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version]));
179 writeln(OutFile,'Attachment ID = ',Attachment.GetAttachmentID);
180 WriteAttachmentInfo(Attachment);
181
182 {Querying Database}
183 DoQuery(Attachment);
184
185 writeln(OutFile,'Dropping Database');
186 Attachment.DropDatabase;
187
188 libpath := GetEnvironmentVariable('TESTFIREBIRDLIBRARY');
189 if libpath <> '' then
190 begin
191 FBLibrary := LoadFBLibrary(libpath);
192
193 writeln(OutFile,'Creating a Database with a DPD using Firebird Library in ',libpath);
194 Attachment := FBLibrary.GetFirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
195 if Attachment = nil then
196 begin
197 writeln(OutFile,'Create Database Failed');
198 Exit;
199 end;
200 WriteDBInfo(Attachment.GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version]));
201 writeln(OutFile,'Attachment ID = ',Attachment.GetAttachmentID);
202 WriteAttachmentInfo(Attachment);
203
204 {Querying Database}
205 DoQuery(Attachment);
206
207 writeln(OutFile,'Dropping Database');
208 Attachment.DropDatabase;
209 end;
210 end;
211
212
213 initialization
214 RegisterTest(TTest1);
215
216 end.
217