ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/testsuite/Test18.pas
Revision: 379
Committed: Mon Jan 10 10:08:03 2022 UTC (2 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 9492 byte(s)
Log Message:
set line ending property

File Contents

# User Rev Content
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    

Properties

Name Value
svn:eol-style native