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) 2016 Tony Whyman, MWA Software |
21 |
* (http://www.mwasoftware.co.uk). |
22 |
* |
23 |
* All Rights Reserved. |
24 |
* |
25 |
* Contributor(s): ______________________________________. |
26 |
* |
27 |
*) |
28 |
|
29 |
unit Test21; |
30 |
|
31 |
{$IFDEF MSWINDOWS} |
32 |
{$DEFINE WINDOWS} |
33 |
{$ENDIF} |
34 |
|
35 |
{$IFDEF FPC} |
36 |
{$mode delphi} |
37 |
{$codepage utf8} |
38 |
{$ENDIF} |
39 |
|
40 |
{Test 21: Exercise setting and getting of numeric data types} |
41 |
|
42 |
interface |
43 |
|
44 |
uses |
45 |
Classes, SysUtils, TestApplication, FBTestApp, IB; |
46 |
|
47 |
type |
48 |
|
49 |
{ TTest21 } |
50 |
|
51 |
TTest21 = class(TFBTestBase) |
52 |
private |
53 |
procedure UpdateDatabase(Attachment: IAttachment); |
54 |
procedure QueryDatabase(Attachment: IAttachment); |
55 |
procedure ValidateStrToNumeric; |
56 |
procedure ValidateNumericInterface; |
57 |
public |
58 |
function TestTitle: AnsiString; override; |
59 |
procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override; |
60 |
end; |
61 |
|
62 |
|
63 |
|
64 |
implementation |
65 |
|
66 |
uses FBNumeric, FmtBCD; |
67 |
|
68 |
const |
69 |
sqlCreateTable = |
70 |
'Create Table TestData ('+ |
71 |
'RowID Integer not null,'+ |
72 |
'iType Integer,'+ |
73 |
'i64Type BIGINT,'+ |
74 |
'CurrType Numeric(12,4),'+ |
75 |
'dType DOUBLE PRECISION,'+ |
76 |
'FixedPoint Numeric(10,6),'+ |
77 |
'Primary Key (RowID)'+ |
78 |
')'; |
79 |
|
80 |
sqlInsert = 'Insert into TestData(RowID,iType,i64Type,CurrType,dType,FixedPoint) Values(?,?,?,?,?,?)'; |
81 |
|
82 |
|
83 |
{ TTest21 } |
84 |
|
85 |
procedure TTest21.UpdateDatabase(Attachment: IAttachment); |
86 |
var Transaction: ITransaction; |
87 |
Statement: IStatement; |
88 |
begin |
89 |
Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit); |
90 |
Statement := Attachment.Prepare(Transaction,sqlInsert); |
91 |
ParamInfo(Statement.GetSQLParams); |
92 |
with Statement.GetSQLParams do |
93 |
begin |
94 |
Params[0].AsInteger := 1; |
95 |
Params[1].AsString := '101'; |
96 |
Params[2].AsString := ' 9223372036854775807'; |
97 |
Params[3].AsString := '10000.1234'; |
98 |
Params[4].AsString := '9999.123456780'; |
99 |
Params[5].AsString := '1234567890.12345678'; |
100 |
end; |
101 |
Statement.Execute; |
102 |
with Statement.GetSQLParams do |
103 |
begin |
104 |
Params[0].AsInteger := 2; |
105 |
Params[1].AsString := '-32457'; |
106 |
Params[2].AsString := ' -9223372036854775808 '; |
107 |
Params[3].AsString := '+1000001.12'; |
108 |
Params[4].AsString := '1.7E308'; |
109 |
Params[5].AsString := '-1234567890.12345678'; |
110 |
end; |
111 |
Statement.Execute; |
112 |
with Statement.GetSQLParams do |
113 |
begin |
114 |
Params[0].AsInteger := 3; |
115 |
Params[1].AsString := '0'; |
116 |
Params[2].AsString := '0'; |
117 |
Params[3].AsString := '0'; |
118 |
Params[4].AsString := '0'; |
119 |
Params[5].AsString := '0'; |
120 |
end; |
121 |
Statement.Execute; |
122 |
with Statement.GetSQLParams do |
123 |
begin |
124 |
Params[0].AsInteger := 4; |
125 |
Params[1].AsString := '1.0'; |
126 |
Params[2].AsString := '10.'; |
127 |
Params[3].AsString := '2.3E-2'; |
128 |
Params[4].AsString := '11e-4'; |
129 |
Params[5].AsString := '2.33456E2'; |
130 |
end; |
131 |
Statement.Execute; |
132 |
{error handling} |
133 |
with Statement.GetSQLParams do |
134 |
try |
135 |
Params[0].AsInteger := 5; |
136 |
Params[1].AsString := '1,000'; |
137 |
Statement.Execute; |
138 |
except on E: Exception do |
139 |
writeln(Outfile,'Expected Error - ',E.Message); |
140 |
end; |
141 |
with Statement.GetSQLParams do |
142 |
try |
143 |
Params[0].AsInteger := 6; |
144 |
Params[5].AsString := '10.0.0'; |
145 |
Statement.Execute; |
146 |
except on E: Exception do |
147 |
writeln(Outfile,'Expected Error - ',E.Message); |
148 |
end; |
149 |
writeln(OutFile,'Test Numeric Type'); |
150 |
with Statement.GetSQLParams do |
151 |
begin |
152 |
Clear; |
153 |
Params[0].AsInteger := 7; |
154 |
Params[1].AsNumeric := DoubleToNumeric(1.0); |
155 |
Params[2].AsVariant := 1234567; |
156 |
Params[3].AsNumeric := DoubleToNumeric(StrToFloat('2.3E-2')); |
157 |
Params[4].AsNumeric := StrToNumeric('11e-4'); |
158 |
Params[5].AsVariant := 1234.25; |
159 |
end; |
160 |
Statement.Execute; |
161 |
end; |
162 |
|
163 |
procedure TTest21.QueryDatabase(Attachment: IAttachment); |
164 |
var Transaction: ITransaction; |
165 |
Statement: IStatement; |
166 |
begin |
167 |
Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit); |
168 |
Statement := Attachment.Prepare(Transaction,'Select * from TestData'); |
169 |
ReportResults(Statement); |
170 |
end; |
171 |
|
172 |
procedure TTest21.ValidateStrToNumeric; |
173 |
const |
174 |
TestValues: array of string = ['1234.567','-765.4321','0.1','0.01','+123', |
175 |
'1.23456E308','-1.2e-02','10.','.12', '0.12', |
176 |
'1.2E1.2', '1,000', '1e1e1', '1.2+3']; {bad syntax} |
177 |
var |
178 |
i: integer; |
179 |
aValue: Int64; |
180 |
aScale: integer; |
181 |
begin |
182 |
for i := 0 to Length(TestValues) - 1 do |
183 |
begin |
184 |
if TryStrToNumeric(TestValues[i],aValue,aScale) then |
185 |
begin |
186 |
writeln(Outfile,TestValues[i],' parsed to ',aValue,' scale = ',aScale); |
187 |
writeln(Outfile,'As Float = ',NumericToDouble(aValue,aScale)); |
188 |
end |
189 |
else |
190 |
writeln(Outfile,'Parsing of ',TestValues[i],' failed'); |
191 |
end; |
192 |
end; |
193 |
|
194 |
procedure TTest21.ValidateNumericInterface; |
195 |
var numeric: IFBNumeric; |
196 |
begin |
197 |
writeln(Outfile,'Validating Numeric Interface - IFBNumeric'); |
198 |
numeric := CurrToNumeric(StrToCurr('9999.123456780')); |
199 |
writeln(Outfile,'Value from Currency = ',numeric.getAsString); |
200 |
writeln(Outfile,'Raw Value = ',numeric.getRawValue,' Scale = ',numeric.getScale); |
201 |
numeric := CurrToNumeric(StrToCurr('9999.123456780')).AdjustScaleTo(-2); |
202 |
writeln(Outfile,'Value from Currency(rescaled) = ',numeric.getAsString); |
203 |
writeln(Outfile,'Raw Value = ',numeric.getRawValue,' Scale = ',numeric.getScale); |
204 |
numeric := DoubleToNumeric(StrToFloat('9999.123456780')); |
205 |
writeln(Outfile,'Value from Double = ',numeric.getAsString); |
206 |
writeln(Outfile,'Raw Value = ',numeric.getRawValue,' Scale = ',numeric.getScale); |
207 |
numeric := IntToNumeric(StrToInt64('9223372036854775807')); |
208 |
writeln(Outfile,'Value from Integer = ',numeric.getAsString); |
209 |
writeln(Outfile,'Raw Value = ',numeric.getRawValue,' Scale = ',numeric.getScale); |
210 |
numeric := StrToNumeric('9223372036854775807'); |
211 |
writeln(Outfile,'Value from string = ',numeric.getAsString); |
212 |
writeln(Outfile,'Raw Value = ',numeric.getRawValue,' Scale = ',numeric.getScale); |
213 |
numeric := StrToNumeric('9999.123456780'); |
214 |
writeln(Outfile,'Value from string = ',numeric.getAsString); |
215 |
writeln(Outfile,'Raw Value = ',numeric.getRawValue,' Scale = ',numeric.getScale); |
216 |
numeric := StrToNumeric('-1.2e-02'); |
217 |
writeln(Outfile,'Value from string = ',numeric.getAsString); |
218 |
writeln(Outfile,'Raw Value = ',numeric.getRawValue,' Scale = ',numeric.getScale); |
219 |
try |
220 |
numeric := BCDToNumeric(StrToBCD('9999.123456780')); |
221 |
writeln(Outfile,'Value from BCD = ',numeric.getAsString); |
222 |
writeln(Outfile,'Raw Value = ',numeric.getRawValue,' Scale = ',numeric.getScale); |
223 |
except on E:Exception do |
224 |
writeln(OutFile,'Delphi has a problem with this number: ',E.Message); |
225 |
end; |
226 |
numeric := NumericFromRawValues(9999123456780,-6); |
227 |
writeln(Outfile,'Value from Raw Data = ',numeric.getAsString); |
228 |
writeln(Outfile,'Raw Value = ',numeric.getRawValue,' Scale = ',numeric.getScale); |
229 |
|
230 |
writeln(outfile,'Numeric Operations'); |
231 |
writeln(Outfile,'Add 2.23 + 24.12345 = ',NumericAdd(StrToNumeric('2.23'),StrToNumeric('24.12345')).GetAsString); |
232 |
writeln(Outfile,'Add Double 2.23 + 24.12645 = ',NumericAdd(StrToNumeric('2.23'),24.12645).GetAsString); |
233 |
writeln(Outfile,'Add integer 2.23 + 2412345 = ',NumericAdd(StrToNumeric('2.23'),2412345).GetAsString); |
234 |
writeln(Outfile,'Subtract 2.23 - 24.12345 = ',NumericSubtract(StrToNumeric('2.23'),StrToNumeric('24.12345')).GetAsString); |
235 |
writeln(Outfile,'Subtract Double 24.12645 - 2.23 = ',NumericSubtract(StrToNumeric('24.12645'),2.23).GetAsString); |
236 |
writeln(Outfile,'Subtract integer 24123.45 - 223 = ',NumericSubtract(StrToNumeric('24123.45'),223).GetAsString); |
237 |
writeln(Outfile,'Multiply 2.23 * 24.12345 = ',NumericMultiply(StrToNumeric('2.23'),StrToNumeric('24.12345')).GetAsString); |
238 |
writeln(Outfile,'Multiply Double 24.12645 * 2.23 = ',NumericMultiply(StrToNumeric('24.12645'),2.23).GetAsString); |
239 |
writeln(Outfile,'Multiply integer 241.2345 * 223 = ',NumericMultiply(StrToNumeric('241.2345'),223).GetAsString); |
240 |
writeln(Outfile,'Divide 24.12345 / 2.23 = ',NumericDivide(StrToNumeric('24.12345'),StrToNumeric('2.23')).GetAsString); |
241 |
writeln(Outfile,'Divide Double 2.23 / 24.12645 = ',NumericDivide(StrToNumeric('2.23'),24.12645).GetAsString); |
242 |
writeln(Outfile,'Divide integer 241.2345 / 223 = ',NumericDivide(StrToNumeric('241.2345'),223).GetAsString); |
243 |
writeln(Outfile,'Compare 2.23, -24.12345 = ',NumericCompare(StrToNumeric('2.23'),DoubleToNumeric(-24.12645))); |
244 |
writeln(Outfile,'Compare integer 2.23, 3 = ',NumericCompare(StrToNumeric('2.23'),3)); |
245 |
writeln(Outfile,'Compare Double 2.23, 2.23 = ',NumericCompare(StrToNumeric('2.23'),2.23)); |
246 |
writeln(Outfile,'Negate 24.12345 = ',NegateNumeric(StrToNumeric('24.12345')).GetAsString); |
247 |
end; |
248 |
|
249 |
function TTest21.TestTitle: AnsiString; |
250 |
begin |
251 |
Result := 'Test 21: Exercise setting and getting of numeric data types'; |
252 |
end; |
253 |
|
254 |
procedure TTest21.RunTest(CharSet: AnsiString; SQLDialect: integer); |
255 |
var DPB: IDPB; |
256 |
Attachment: IAttachment; |
257 |
begin |
258 |
DPB := FirebirdAPI.AllocateDPB; |
259 |
DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName); |
260 |
DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword); |
261 |
DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet); |
262 |
DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect); |
263 |
Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB); |
264 |
try |
265 |
Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable); |
266 |
ValidateStrToNumeric; |
267 |
ValidateNumericInterface; |
268 |
SetFloatTemplate('#,###.00000000'); |
269 |
UpdateDatabase(Attachment); |
270 |
QueryDatabase(Attachment); |
271 |
finally |
272 |
Attachment.DropDatabase; |
273 |
end; |
274 |
end; |
275 |
|
276 |
initialization |
277 |
RegisterTest(TTest21); |
278 |
end. |
279 |
|