ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/testsuite/Test18.pas
Revision: 381
Committed: Sat Jan 15 00:06:22 2022 UTC (4 months, 1 week ago) by tony
File size: 9614 byte(s)
Log Message:
Release Candidate 1
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) 2020 Tony Whyman, MWA Software
21 * (http://www.mwasoftware.co.uk).
22 *
23 * All Rights Reserved.
24 *
25 * Contributor(s): ______________________________________.
26 *
27 *)
28
29 unit Test18;
30
31 {$IFDEF MSWINDOWS}
32 {$DEFINE WINDOWS}
33 {$ENDIF}
34
35 {$IFDEF FPC}
36 {$mode delphi}
37 {$codepage UTF8}
38 {$ENDIF}
39
40 {$DEFINE TESTINT128ARRAY} {Depends on resolution of CORE-6302}
41
42 {Test 18: Firebird 4 extensions: DecFloat data types}
43
44 {
45 This test provides tests for the new DECFloat16 and DECFloat34 types. The test
46 is skipped if not a Firebird 4 Client.
47
48 1. A new temporary database is created and a single table added containing
49 columns for each DecFloat data type.
50
51 2. Data insert is performed for the various ways of setting the column values.
52
53 3. A Select query is used to read back the rows, testing out the data read variations.
54
55 }
56
57 interface
58
59 uses
60 Classes, SysUtils, TestApplication, FBTestApp, IB {$IFDEF WINDOWS},Windows{$ENDIF};
61
62 type
63
64 { TTest18 }
65
66 TTest18 = class(TFBTestBase)
67 private
68 procedure QueryDatabase4_DECFloat(Attachment: IAttachment);
69 procedure UpdateDatabase4_DECFloat(Attachment: IAttachment);
70 procedure ArrayTest(Attachment: IAttachment);
71 public
72 function TestTitle: AnsiString; override;
73 procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
74 end;
75
76
77 implementation
78
79 uses IBUtils, FmtBCD;
80
81 const
82 sqlCreateTable =
83 'Create Table FB4TestData_DECFloat ('+
84 'RowID Integer not null,'+
85 'Float16 DecFloat(16),'+
86 'Float34 DecFloat(34),'+
87 'BigNumber NUMERIC(24,6),'+
88 'BiggerNumber NUMERIC(34,4),'+
89 'BigInteger INT128, '+
90 'Primary Key(RowID)'+
91 ')';
92
93 sqlCreateTable2 =
94 'Create Table FB4TestData_DECFloat_AR ('+
95 'RowID Integer not null,'+
96 'Float16 DecFloat(16) [0:16],'+
97 'Float34 DecFloat(34) [0:16],'+
98 'BigNumber NUMERIC(24,6) [0:16],'+
99 'Primary Key(RowID)'+
100 ')';
101
102 { TTest18 }
103
104 procedure TTest18.UpdateDatabase4_DECFloat(Attachment: IAttachment);
105 var Transaction: ITransaction;
106 Statement: IStatement;
107 sqlInsert: AnsiString;
108 begin
109 Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
110 sqlInsert := 'Insert into FB4TestData_DECFLoat(RowID,Float16,Float34,BigNumber,BigInteger) ' +
111 'Values(1,64000000000.01,123456789123456789.12345678,123456123456.123456,123456789123456789)';
112 Attachment.ExecuteSQL(Transaction,sqlInsert,[]);
113 sqlInsert := 'Insert into FB4TestData_DECFLoat(RowID,Float16,Float34,BigNumber) '+
114 'Values(2,-64000000000.01,-123456789123456789.12345678,-123456123456.123456)';
115 Attachment.ExecuteSQL(Transaction,sqlInsert,[]);
116
117
118 Statement := Attachment.Prepare(Transaction,'Insert into FB4TestData_DECFLoat(RowID,Float16,Float34,BigNumber,BiggerNumber) VALUES (?,?,?,?,?)');
119
120 Statement.SQLParams[0].AsInteger := 3;
121 Statement.SQLParams[1].AsBCD := StrToBCD('64100000000.011');
122 Statement.SQLParams[2].AsCurrency := 12345678912.12;
123 try
124 Statement.SQLParams[3].AsString := '1234561234567.123456';
125 except on E:Exception do
126 writeln(OutFile,'Delphi has a problem with this big a number: ',E.Message);
127 end;
128 Statement.SQLParams[4].AsBCD := StrToBCD('11123456123456123456123456123456.123456'); {last digit should be dropped}
129 Statement.Execute;
130
131 Statement.SQLParams[0].AsInteger := 4;
132 Statement.SQLParams[1].AsBCD := StrToBCD('0');
133 Statement.SQLParams[2].AsBCD := StrToBCD('-1');
134 Statement.SQLParams[3].AsBCD := StrToBCD('0');
135 Statement.SQLParams[4].AsBCD := StrToBCD('0');
136 Statement.Execute;
137 end;
138
139 procedure TTest18.ArrayTest(Attachment: IAttachment);
140 var Transaction: ITransaction;
141 Statement: IStatement;
142 ResultSet: IResultSet;
143 ar: IArray;
144 value: tBCD;
145 i: integer;
146 begin
147 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable2);
148 Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
149 Statement := Attachment.Prepare(Transaction,'Select * From FB4TestData_DECFloat_AR');
150 Printmetadata(Statement.MetaData);
151 Attachment.Prepare(Transaction,'Insert into FB4TestData_DECFloat_AR (RowID) Values(1)').Execute;
152
153 {Float16}
154 ar := Attachment.CreateArray(Transaction,'FB4TestData_DECFloat_AR','Float16');
155 value := StrToBCD('64100000000.011');
156 for i := 0 to 16 do
157 begin
158 ar.SetAsBcd(i,value);
159 BcdAdd(value,IntegerToBCD(1),Value);
160 end;
161
162 Statement := Attachment.Prepare(Transaction,'Update FB4TestData_DECFloat_AR Set Float16 = ? Where RowID = 1');
163 Statement.SQLParams[0].AsArray := ar;
164 Statement.Execute;
165
166 {Float 34}
167 ar := Attachment.CreateArray(Transaction,'FB4TestData_DECFloat_AR','Float34');
168 value := StrToBCD('123456789123456789.12345678');
169 for i := 0 to 16 do
170 begin
171 ar.SetAsBcd(i,value);
172 BcdAdd(value,IntegerToBCD(1),Value);
173 end;
174
175 Statement := Attachment.Prepare(Transaction,'Update FB4TestData_DECFloat_AR Set Float34 = ? Where RowID = 1');
176 Statement.SQLParams[0].AsArray := ar;
177 Statement.Execute;
178
179 {NUMERIC(24,6)}
180 {$IFDEF TESTINT128ARRAY}
181 ar := Attachment.CreateArray(Transaction,'FB4TestData_DECFloat_AR','BigNumber');
182 value := StrToBCD('123456123400.123456');
183 for i := 0 to 16 do
184 begin
185 ar.SetAsBcd(i,value);
186 BcdAdd(value,DoubleToBCD(1.5),value);
187 end;
188
189 Statement := Attachment.Prepare(Transaction,'Update FB4TestData_DECFloat_AR Set BigNumber = ? Where RowID = 1');
190 Statement.SQLParams[0].AsArray := ar;
191 Statement.Execute;
192 {$ENDIF}
193
194 Statement := Attachment.Prepare(Transaction,'Select RowID, Float16, Float34,BigNumber From FB4TestData_DECFloat_AR');
195 writeln(OutFile);
196 writeln(OutFile,'Decfloat Arrays');
197 ResultSet := Statement.OpenCursor;
198 while ResultSet.FetchNext do
199 begin
200 writeln(OutFile,'Row No ',ResultSet[0].AsInteger);
201 write(OutFile,'Float16 ');
202 ar := ResultSet[1].AsArray;
203 WriteArray(ar);
204 write(OutFile,'Float34 ');
205 ar := ResultSet[2].AsArray;
206 WriteArray(ar);
207 {$IFDEF TESTINT128ARRAY}
208 write(OutFile,'BigNumber ');
209 ar := ResultSet[3].AsArray;
210 WriteArray(ar);
211 {$ENDIF}
212 end;
213 end;
214
215 procedure TTest18.QueryDatabase4_DECFloat(Attachment: IAttachment);
216 var Transaction: ITransaction;
217 Statement: IStatement;
218 Results: IResultSet;
219 begin
220 Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
221 Statement := Attachment.Prepare(Transaction,'Select * from FB4TestData_DECFloat');
222 writeln(OutFile);
223 writeln(OutFile,'FB4 Testdata_DECFloat');
224 writeln(OutFile);
225 PrintMetaData(Statement.MetaData);
226 Results := Statement.OpenCursor;
227 try
228 while Results.FetchNext do
229 with Results do
230 begin
231 writeln(OutFile,'RowID = ',ByName('ROWID').GetAsString);
232 writeln(OutFile,'Float16 = ', ByName('Float16').GetAsString);
233 DumpBCD(ByName('Float16').GetAsBCD);
234 writeln(OutFile,'Float34 = ', ByName('Float34').GetAsString);
235 DumpBCD(ByName('Float34').GetAsBCD);
236 writeln(OutFile,'BigNumber = ', ByName('BigNumber').GetAsString);
237 DumpBCD(ByName('BigNumber').GetAsBCD);
238 if not ByName('BiggerNumber').IsNull then
239 begin
240 writeln(OutFile,'BiggerNumber = ', ByName('BiggerNumber').GetAsString);
241 DumpBCD(ByName('BiggerNumber').GetAsBCD);
242 end;
243 if ByName('BigInteger').IsNull then
244 writeln(OutFile,'BigInteger = Null')
245 else
246 begin
247 writeln(OutFile,'BigInteger = ', ByName('BigInteger').GetAsString);
248 DumpBCD(ByName('BigInteger').GetAsBCD);
249 end;
250 writeln(Outfile);
251 end;
252 finally
253 Results.Close;
254 end;
255 end;
256
257 function TTest18.TestTitle: AnsiString;
258 begin
259 Result := 'Test 18: Firebird 4 Decfloat extensions';
260 end;
261
262 procedure TTest18.RunTest(CharSet: AnsiString; SQLDialect: integer);
263 var DPB: IDPB;
264 Attachment: IAttachment;
265 VerStrings: TStringList;
266 begin
267 DPB := FirebirdAPI.AllocateDPB;
268 DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
269 DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
270 DPB.Add(isc_dpb_lc_ctype).setAsString('UTF8');
271 DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
272 Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
273 VerStrings := TStringList.Create;
274 try
275 Attachment.getFBVersion(VerStrings);
276 writeln(OutFile,' FBVersion = ',VerStrings[0]);
277 finally
278 VerStrings.Free;
279 end;
280
281 if (FirebirdAPI.GetClientMajor < 4) or (Attachment.GetODSMajorVersion < 13) then
282 writeln(OutFile,'Skipping test for Firebird 4 and later')
283 else
284 begin
285 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
286 UpdateDatabase4_DECFloat(Attachment);
287 QueryDatabase4_DECFloat(Attachment);
288 ArrayTest(Attachment);
289 end;
290 Attachment.DropDatabase;
291 end;
292
293 initialization
294 RegisterTest(TTest18);
295 end.
296
297

Properties

Name Value
svn:eol-style native