diff --git a/tests/test/units/math/troundm.pp b/tests/test/units/math/troundm.pp index 4ca393350a..9f09721774 100644 --- a/tests/test/units/math/troundm.pp +++ b/tests/test/units/math/troundm.pp @@ -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.