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 |
Statement.SQLParams[3].AsString := '1234561234567.123456';
|
124 |
Statement.SQLParams[4].AsBCD := StrToBCD('11123456123456123456123456123456.123456'); {last digit should be dropped}
|
125 |
Statement.Execute;
|
126 |
|
127 |
Statement.SQLParams[0].AsInteger := 4;
|
128 |
Statement.SQLParams[1].AsBCD := StrToBCD('0');
|
129 |
Statement.SQLParams[2].AsBCD := StrToBCD('-1');
|
130 |
Statement.SQLParams[3].AsBCD := StrToBCD('0');
|
131 |
Statement.SQLParams[4].AsBCD := StrToBCD('0');
|
132 |
Statement.Execute;
|
133 |
end;
|
134 |
|
135 |
procedure TTest18.ArrayTest(Attachment: IAttachment);
|
136 |
var Transaction: ITransaction;
|
137 |
Statement: IStatement;
|
138 |
ResultSet: IResultSet;
|
139 |
ar: IArray;
|
140 |
value: tBCD;
|
141 |
i: integer;
|
142 |
begin
|
143 |
Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable2);
|
144 |
Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
|
145 |
Statement := Attachment.Prepare(Transaction,'Select * From FB4TestData_DECFloat_AR');
|
146 |
Printmetadata(Statement.MetaData);
|
147 |
Attachment.Prepare(Transaction,'Insert into FB4TestData_DECFloat_AR (RowID) Values(1)').Execute;
|
148 |
|
149 |
{Float16}
|
150 |
ar := Attachment.CreateArray(Transaction,'FB4TestData_DECFloat_AR','Float16');
|
151 |
value := StrToBCD('64100000000.011');
|
152 |
for i := 0 to 16 do
|
153 |
begin
|
154 |
ar.SetAsBcd(i,value);
|
155 |
BcdAdd(value,IntegerToBCD(1),Value);
|
156 |
end;
|
157 |
|
158 |
Statement := Attachment.Prepare(Transaction,'Update FB4TestData_DECFloat_AR Set Float16 = ? Where RowID = 1');
|
159 |
Statement.SQLParams[0].AsArray := ar;
|
160 |
Statement.Execute;
|
161 |
|
162 |
{Float 34}
|
163 |
ar := Attachment.CreateArray(Transaction,'FB4TestData_DECFloat_AR','Float34');
|
164 |
value := StrToBCD('123456789123456789.12345678');
|
165 |
for i := 0 to 16 do
|
166 |
begin
|
167 |
ar.SetAsBcd(i,value);
|
168 |
BcdAdd(value,IntegerToBCD(1),Value);
|
169 |
end;
|
170 |
|
171 |
Statement := Attachment.Prepare(Transaction,'Update FB4TestData_DECFloat_AR Set Float34 = ? Where RowID = 1');
|
172 |
Statement.SQLParams[0].AsArray := ar;
|
173 |
Statement.Execute;
|
174 |
|
175 |
{NUMERIC(24,6)}
|
176 |
{$IFDEF TESTINT128ARRAY}
|
177 |
ar := Attachment.CreateArray(Transaction,'FB4TestData_DECFloat_AR','BigNumber');
|
178 |
value := StrToBCD('123456123400.123456');
|
179 |
for i := 0 to 16 do
|
180 |
begin
|
181 |
ar.SetAsBcd(i,value);
|
182 |
BcdAdd(value,DoubleToBCD(1.5),value);
|
183 |
end;
|
184 |
|
185 |
Statement := Attachment.Prepare(Transaction,'Update FB4TestData_DECFloat_AR Set BigNumber = ? Where RowID = 1');
|
186 |
Statement.SQLParams[0].AsArray := ar;
|
187 |
Statement.Execute;
|
188 |
{$ENDIF}
|
189 |
|
190 |
Statement := Attachment.Prepare(Transaction,'Select RowID, Float16, Float34,BigNumber From FB4TestData_DECFloat_AR');
|
191 |
writeln(OutFile);
|
192 |
writeln(OutFile,'Decfloat Arrays');
|
193 |
ResultSet := Statement.OpenCursor;
|
194 |
while ResultSet.FetchNext do
|
195 |
begin
|
196 |
writeln(OutFile,'Row No ',ResultSet[0].AsInteger);
|
197 |
write(OutFile,'Float16 ');
|
198 |
ar := ResultSet[1].AsArray;
|
199 |
WriteArray(ar);
|
200 |
write(OutFile,'Float34 ');
|
201 |
ar := ResultSet[2].AsArray;
|
202 |
WriteArray(ar);
|
203 |
{$IFDEF TESTINT128ARRAY}
|
204 |
write(OutFile,'BigNumber ');
|
205 |
ar := ResultSet[3].AsArray;
|
206 |
WriteArray(ar);
|
207 |
{$ENDIF}
|
208 |
end;
|
209 |
end;
|
210 |
|
211 |
procedure TTest18.QueryDatabase4_DECFloat(Attachment: IAttachment);
|
212 |
var Transaction: ITransaction;
|
213 |
Statement: IStatement;
|
214 |
Results: IResultSet;
|
215 |
begin
|
216 |
Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
|
217 |
Statement := Attachment.Prepare(Transaction,'Select * from FB4TestData_DECFloat');
|
218 |
writeln(OutFile);
|
219 |
writeln(OutFile,'FB4 Testdata_DECFloat');
|
220 |
writeln(OutFile);
|
221 |
PrintMetaData(Statement.MetaData);
|
222 |
Results := Statement.OpenCursor;
|
223 |
try
|
224 |
while Results.FetchNext do
|
225 |
with Results do
|
226 |
begin
|
227 |
writeln(OutFile,'RowID = ',ByName('ROWID').GetAsString);
|
228 |
writeln(OutFile,'Float16 = ', ByName('Float16').GetAsString);
|
229 |
DumpBCD(ByName('Float16').GetAsBCD);
|
230 |
writeln(OutFile,'Float34 = ', ByName('Float34').GetAsString);
|
231 |
DumpBCD(ByName('Float34').GetAsBCD);
|
232 |
writeln(OutFile,'BigNumber = ', ByName('BigNumber').GetAsString);
|
233 |
DumpBCD(ByName('BigNumber').GetAsBCD);
|
234 |
if not ByName('BiggerNumber').IsNull then
|
235 |
begin
|
236 |
writeln(OutFile,'BiggerNumber = ', ByName('BiggerNumber').GetAsString);
|
237 |
DumpBCD(ByName('BiggerNumber').GetAsBCD);
|
238 |
end;
|
239 |
if ByName('BigInteger').IsNull then
|
240 |
writeln(OutFile,'BigInteger = Null')
|
241 |
else
|
242 |
begin
|
243 |
writeln(OutFile,'BigInteger = ', ByName('BigInteger').GetAsString);
|
244 |
DumpBCD(ByName('BigInteger').GetAsBCD);
|
245 |
end;
|
246 |
writeln(Outfile);
|
247 |
end;
|
248 |
finally
|
249 |
Results.Close;
|
250 |
end;
|
251 |
end;
|
252 |
|
253 |
function TTest18.TestTitle: AnsiString;
|
254 |
begin
|
255 |
Result := 'Test 18: Firebird 4 Decfloat extensions';
|
256 |
end;
|
257 |
|
258 |
procedure TTest18.RunTest(CharSet: AnsiString; SQLDialect: integer);
|
259 |
var DPB: IDPB;
|
260 |
Attachment: IAttachment;
|
261 |
VerStrings: TStringList;
|
262 |
begin
|
263 |
DPB := FirebirdAPI.AllocateDPB;
|
264 |
DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
|
265 |
DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
|
266 |
DPB.Add(isc_dpb_lc_ctype).setAsString('UTF8');
|
267 |
DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
|
268 |
Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
|
269 |
VerStrings := TStringList.Create;
|
270 |
try
|
271 |
Attachment.getFBVersion(VerStrings);
|
272 |
writeln(OutFile,' FBVersion = ',VerStrings[0]);
|
273 |
finally
|
274 |
VerStrings.Free;
|
275 |
end;
|
276 |
|
277 |
if (FirebirdAPI.GetClientMajor < 4) or (Attachment.GetODSMajorVersion < 13) then
|
278 |
writeln(OutFile,'Skipping test for Firebird 4 and later')
|
279 |
else
|
280 |
begin
|
281 |
Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
|
282 |
UpdateDatabase4_DECFloat(Attachment);
|
283 |
QueryDatabase4_DECFloat(Attachment);
|
284 |
ArrayTest(Attachment);
|
285 |
end;
|
286 |
Attachment.DropDatabase;
|
287 |
end;
|
288 |
|
289 |
initialization
|
290 |
RegisterTest(TTest18);
|
291 |
end.
|
292 |
|
293 |
|