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 User Rev File contents
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 tony 381 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 tony 335 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 tony 345 writeln(Outfile);
251 tony 335 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