@@ -166,7 +166,7 @@ function TestRandom(const Max: Integer): Integer;
166
166
end ;
167
167
{ $R+} { $Q+}
168
168
169
- procedure AssertEqual (S: UnicodeString);
169
+ procedure AssertEqual (S: UnicodeString; WarnPrint: Boolean = False );
170
170
var
171
171
A, B: Double;
172
172
ABin: UInt64 absolute A;
@@ -178,7 +178,25 @@ procedure AssertEqual(S: UnicodeString);
178
178
if @dll_pure_parse_float <> nil then
179
179
begin
180
180
CountB := PureStringToDoubleUserDll(S, B);
181
+ if WarnPrint then
182
+ begin
183
+ if CountA <> CountB then
184
+ begin
185
+ Writeln(' Fail Length!' );
186
+ Writeln(' String: "' , S, ' "' );
187
+ Writeln(' Expected: ' , CountA, ' , Actual: ' , CountB);
188
+ end ;
189
+ end ;
181
190
Assert(CountA = CountB);
191
+ if WarnPrint then
192
+ begin
193
+ if ABin <> BBin then
194
+ begin
195
+ Writeln(' Fail Bin!' );
196
+ Writeln(' String: "' , S, ' "' );
197
+ Writeln(' Expected: 0x' , IntToHex(ABin, 8 ), ' , Actual: 0x' , IntToHex(BBin, 8 ));
198
+ end ;
199
+ end ;
182
200
Assert(ABin = BBin);
183
201
exit;
184
202
end ;
@@ -215,6 +233,11 @@ procedure AssertEqual(S: UnicodeString);
215
233
Assert(ABin = BBin);
216
234
end ;
217
235
236
+ procedure AssertEqualWarn (S: UnicodeString);
237
+ begin
238
+ AssertEqual(S, True);
239
+ end ;
240
+
218
241
type
219
242
TUlpDiffType = (udtSame, udtOne, udtMoreThanOne);
220
243
{ $R-} { $Q-}
@@ -291,75 +314,75 @@ function MakeTest(Name: UnicodeString; Proc: TProcedure): TTest;
291
314
292
315
procedure SimpleIntegerTest ();
293
316
begin
294
- AssertEqual (' 0' );
295
- AssertEqual (' 666999' );
296
- AssertEqual (' +12345' );
297
- AssertEqual (' 100000000000000001' );
298
- AssertEqual (' -329' );
299
- AssertEqual (' 00000000000004' );
300
- AssertEqual (' -00000000000009' );
301
- AssertEqual (' +00000000000009' );
317
+ AssertEqualWarn (' 0' );
318
+ AssertEqualWarn (' 666999' );
319
+ AssertEqualWarn (' +12345' );
320
+ AssertEqualWarn (' 100000000000000001' );
321
+ AssertEqualWarn (' -329' );
322
+ AssertEqualWarn (' 00000000000004' );
323
+ AssertEqualWarn (' -00000000000009' );
324
+ AssertEqualWarn (' +00000000000009' );
302
325
end ;
303
326
304
327
procedure SimpleFloatTest ();
305
328
begin
306
- AssertEqual (' 0.0' );
307
- AssertEqual (' 10.2' );
308
- AssertEqual (' -1.2' );
309
- AssertEqual (' 0.2' );
329
+ AssertEqualWarn (' 0.0' );
330
+ AssertEqualWarn (' 10.2' );
331
+ AssertEqualWarn (' -1.2' );
332
+ AssertEqualWarn (' 0.2' );
310
333
end ;
311
334
312
335
procedure SimpleExponentTest ();
313
336
begin
314
- AssertEqual (' 0.0e0' );
315
- AssertEqual (' 10.2e10' );
316
- AssertEqual (' -1.2e99' );
317
- AssertEqual (' 0.2e-12' );
337
+ AssertEqualWarn (' 0.0e0' );
338
+ AssertEqualWarn (' 10.2e10' );
339
+ AssertEqualWarn (' -1.2e99' );
340
+ AssertEqualWarn (' 0.2e-12' );
318
341
end ;
319
342
320
343
procedure SpecialStringTest ();
321
344
begin
322
- AssertEqual (' Nan' );
323
- AssertEqual (' Inf' );
324
- AssertEqual (' +Inf' );
325
- AssertEqual (' -Inf' );
326
- AssertEqual (' +Infinity' );
327
- AssertEqual (' -Infinity' );
328
- AssertEqual (' +Nan' );
329
- AssertEqual (' -Nan' );
345
+ AssertEqualWarn (' Nan' );
346
+ AssertEqualWarn (' Inf' );
347
+ AssertEqualWarn (' +Inf' );
348
+ AssertEqualWarn (' -Inf' );
349
+ AssertEqualWarn (' +Infinity' );
350
+ AssertEqualWarn (' -Infinity' );
351
+ AssertEqualWarn (' +Nan' );
352
+ AssertEqualWarn (' -Nan' );
330
353
end ;
331
354
332
355
procedure HardParseTest ();
333
356
begin
334
- AssertEqual (' .e1' );// not a number
335
- AssertEqual (' 1.e1' );
336
- AssertEqual (' .1' );
337
- AssertEqual (' .1e000000000010' );
338
- AssertEqual (' -.1e-000000000010' );
339
- AssertEqual (' 1.' );
340
- AssertEqual (' 2e.10' );
341
- AssertEqual (' -0.00e-214' );
342
- AssertEqual (' 0e320' );
343
- AssertEqual (' .123e10' );
344
- AssertEqual (' 123' + DupeString(' 0' , 10000 ) + ' e-10000' );// 123.0
345
- AssertEqual (' 1234567891234567891234567891234' + DupeString(' 0' , 10000 ) + ' e-10000' );// 1234567891234567891234567891234.0
346
- AssertEqual (' -0.' + DupeString(' 0' , 10000 ) + ' 9e10000' );// -0.9
357
+ AssertEqualWarn (' .e1' );// not a number
358
+ AssertEqualWarn (' 1.e1' );
359
+ AssertEqualWarn (' .1' );
360
+ AssertEqualWarn (' .1e000000000010' );
361
+ AssertEqualWarn (' -.1e-000000000010' );
362
+ AssertEqualWarn (' 1.' );
363
+ AssertEqualWarn (' 2e.10' );
364
+ AssertEqualWarn (' -0.00e-214' );
365
+ AssertEqualWarn (' 0e320' );
366
+ AssertEqualWarn (' .123e10' );
367
+ AssertEqualWarn (' 123' + DupeString(' 0' , 10000 ) + ' e-10000' );// 123.0
368
+ AssertEqualWarn (' 1234567891234567891234567891234' + DupeString(' 0' , 10000 ) + ' e-10000' );// 1234567891234567891234567891234.0
369
+ AssertEqualWarn (' -0.' + DupeString(' 0' , 10000 ) + ' 9e10000' );// -0.9
347
370
// special values
348
- AssertEqual (' 6.69692879491417e+299' );
349
- AssertEqual (' 3.7252902984619140625e-09' );
350
- AssertEqual (' 1.1754943508222875080e-38' );
351
- AssertEqual (' 1.4012984643248170709e-45' );
352
- AssertEqual (' 340282346638528859811704183484516925440.0' );
353
- AssertEqual (' 2.2250738585072013831e-308' );
354
- AssertEqual (' 4.9406564584124654418e-324' );
355
- AssertEqual (' 1.7976931348623157081e+308' );
356
- AssertEqual (' 1.8145860519450699870567321328132e-5' );
357
- AssertEqual (' 0.34657359027997265470861606072909' );
371
+ AssertEqualWarn (' 6.69692879491417e+299' );
372
+ AssertEqualWarn (' 3.7252902984619140625e-09' );
373
+ AssertEqualWarn (' 1.1754943508222875080e-38' );
374
+ AssertEqualWarn (' 1.4012984643248170709e-45' );
375
+ AssertEqualWarn (' 340282346638528859811704183484516925440.0' );
376
+ AssertEqualWarn (' 2.2250738585072013831e-308' );
377
+ AssertEqualWarn (' 4.9406564584124654418e-324' );
378
+ AssertEqualWarn (' 1.7976931348623157081e+308' );
379
+ AssertEqualWarn (' 1.8145860519450699870567321328132e-5' );
380
+ AssertEqualWarn (' 0.34657359027997265470861606072909' );
358
381
// inf
359
- AssertEqual (' 1000000000000e307' );// +inf
360
- AssertEqual (' -1000000000000e307' );// -inf
382
+ AssertEqualWarn (' 1000000000000e307' );// +inf
383
+ AssertEqualWarn (' -1000000000000e307' );// -inf
361
384
// demo values
362
- AssertEqual (' 18014398509481993' );
385
+ AssertEqualWarn (' 18014398509481993' );
363
386
end ;
364
387
365
388
procedure RandomIntegerTest ();
0 commit comments