paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 07:06:08 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ Expanded test also for qword->double and int32->single conversions.

Browse Source 
git-svn-id: trunk@28311 -
This commit is contained in:
sergei 2014-08-04 21:45:34 +00:00
parent ca0ff3d2ea
commit ff5410b152
1 changed files with 101 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

106
tests/test/units/math/troundm.pp
View File

@ -1,13 +1,37 @@
{ Converting 64-bit integers with more than 53 significant bits to double-precision
floating point format is subject to rounding. Hence result depends on rounding mode. }
floating point format is subject to rounding. Hence result depends on rounding mode.
The same goes for 32-bit integers with more than 23 significant bits converted to
single. }
uses math;
type
TExpected=array[TFPURoundingMode] of qword;
const
res1_single: TExpected = (
$4E800000,
$4E800000,
$4E800001,
$4E800000
);
res2_single: TExpected = (
$4EFFFFFF,
$4EFFFFFF,
$4F000000,
$4EFFFFFF
);
res3_single: TExpected = (
$CEFFFFFF,
$CF000000,
$CEFFFFFF,
$CEFFFFFF
);
res1: TExpected = (
$43D0000000000000,
$43D0000000000000,
@ -38,7 +62,35 @@ begin
has_errors:=true;
end;
procedure test(x: int64; const res: TExpected);
procedure test32(x: longint; const res: texpected);
var
y: single;
yd: longword absolute y;
begin
writeln('integer value=',hexstr(x,8));
y:=x;
writeln('rmNearest ',y, ' ',hexstr(yd,8));
if yd<>res[rmNearest] then fail;
setroundmode(rmUp);
y:=x;
writeln('rmUp ',y, ' ',hexstr(yd,8));
if yd<>res[rmUp] then fail;
setroundmode(rmDown);
y:=x;
writeln('rmDown ',y, ' ',hexstr(yd,8));
if yd<>res[rmDown] then fail;
setroundmode(rmTruncate);
y:=x;
writeln('rmTruncate ',y, ' ',hexstr(yd,8));
if yd<>res[rmTruncate] then fail;
end;
procedure testint64(x: int64; const res: TExpected);
var
y: double;
yq: qword absolute y;
@ -66,13 +118,57 @@ begin
end;
procedure testqword(x: qword; const res: TExpected);
var
y: double;
yq: qword absolute y;
begin
writeln('integer value=',hexstr(x,16));
setroundmode(rmNearest);
y:=x;
writeln('rmNearest ',y, ' ',hexstr(yq,16));
if yq<>res[rmNearest] then fail;
setroundmode(rmUp);
y:=x;
writeln('rmUp ',y, ' ',hexstr(yq,16));
if yq<>res[rmUp] then fail;
setroundmode(rmDown);
y:=x;
writeln('rmDown ',y, ' ',hexstr(yq,16));
if yq<>res[rmDown] then fail;
setroundmode(rmTruncate);
y:=x;
writeln('rmTruncate ',y, ' ',hexstr(yq,16));
if yq<>res[rmTruncate] then fail;
end;
begin
test($4000000000000001,res1);
writeln('Testing longint->single conversion');
test32($40000001,res1_single);
writeln;
test($7fffffffffffffff,res2);
test32($7fffffff,res2_single);
writeln;
test(int64($8000000000000001),res3);
test32(longint($80000001),res3_single);
writeln;
writeln('Testing int64->double conversion');
testint64($4000000000000001,res1);
writeln;
testint64($7fffffffffffffff,res2);
writeln;
testint64(int64($8000000000000001),res3);
writeln;
writeln('Testing qword->double conversion');
testqword($4000000000000001,res1);
writeln;
testqword($7fffffffffffffff,res2);
writeln;
if has_errors then
halt(1);
end.