1 |
tony |
335 |
(*
|
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 |
tony |
345 |
writeln(Outfile);
|
247 |
tony |
335 |
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 |
|
|
|