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 (2 years, 3 months ago) by tony
Content type: text/x-pascal
File size: 6380 byte(s)
Log Message:
add fbintf

File Contents

# 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 363 writeln(OutFile,'Attachment ID = ',Attachment.GetAttachmentID);
180 tony 143 WriteAttachmentInfo(Attachment);
181 tony 45
182     {Querying Database}
183     DoQuery(Attachment);
184    
185     writeln(OutFile,'Dropping Database');
186     Attachment.DropDatabase;
187 tony 263
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 tony 341 Attachment := FBLibrary.GetFirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
195 tony 263 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 tony 363 writeln(OutFile,'Attachment ID = ',Attachment.GetAttachmentID);
202 tony 263 WriteAttachmentInfo(Attachment);
203    
204     {Querying Database}
205     DoQuery(Attachment);
206    
207     writeln(OutFile,'Dropping Database');
208     Attachment.DropDatabase;
209     end;
210 tony 45 end;
211    
212    
213     initialization
214     RegisterTest(TTest1);
215    
216     end.
217