paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 00:29:33 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed generic round(...) for large values based on a comment by Alexander Hofmann on fpc-devel

Browse Source 
* extended test

git-svn-id: trunk@44235 -
This commit is contained in:
florian 2020-02-23 10:41:18 +00:00
parent 2acc6337d8
commit af1a4c06c5
2 changed files with 76 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
rtl/inc/genmath.inc
View File

@ -1340,7 +1340,7 @@ type
if j0>=63 then { Overflow, let trunc() raise an exception }
exit(trunc(d)) { and/or return +/-MaxInt64 if it's masked }
else
result:=((int64(hx) shl 32) or float64low(d)) shl (j0-52);
result:=((int64(hx) shl 32) or dword(float64low(d))) shl (j0-52);
end
else
begin

84
tests/test/units/system/tround.pp
View File

@ -1,10 +1,6 @@
{ this tests the round routine }
program tround;
{$ifdef VER1_0}
{$define SKIP_CURRENCY_TEST}
{$endif }
{$ifndef MACOS}
{$APPTYPE CONSOLE}
{$else}
@ -18,7 +14,12 @@ const
RESULT_TWO = -1235;
VALUE_TWO = -1234.5678;
RESULT_CONST_TWO = round(VALUE_TWO);
VALUE_LARGE = 1.5000000000000000E+018;
RESULT_LARGE= 1500000000000000000;
RESULT_CONST_LARGE = round(1.5000000000000000E+018);
VALUE_HUGE = 1.500000549755813888E+018;
RESULT_HUGE = 1500000549755813888;
RESULT_CONST_HUGE = round(1.500000549755813888E+018);
procedure fail;
begin
@ -31,6 +32,7 @@ var
r: real;
_success : boolean;
l: longint;
i64: int64;
Begin
Write('Round() real testing...');
_success := true;
@ -68,7 +70,40 @@ Begin
_success:=false;
if not _success then
r:=VALUE_LARGE;
if round(r)<>RESULT_LARGE then
_success:=false;
if round(VALUE_LARGE)<>RESULT_LARGE then
_success:=false;
r:=VALUE_LARGE;
if round(r)<>RESULT_CONST_LARGE then
_success := false;
r:=VALUE_LARGE;
i64:=round(r);
if i64<>RESULT_LARGE then
_success:=false;
i64:=round(VALUE_LARGE);
if i64<>RESULT_LARGE then
_success:=false;
r:=VALUE_HUGE;
if round(r)<>RESULT_HUGE then
_success:=false;
if round(VALUE_HUGE)<>RESULT_HUGE then
_success:=false;
r:=VALUE_HUGE;
if round(r)<>RESULT_CONST_HUGE then
_success := false;
r:=VALUE_HUGE;
i64:=round(r);
if i64<>RESULT_HUGE then
_success:=false;
i64:=round(VALUE_HUGE);
if i64<>RESULT_HUGE then
_success:=false;
if not _success then
fail;
WriteLn('Success!');
end;
@ -126,6 +161,7 @@ var
r: double;
_success : boolean;
l: longint;
i64: int64;
Begin
Write('Round() double testing...');
_success := true;
@ -163,6 +199,39 @@ Begin
_success:=false;
r:=VALUE_LARGE;
if round(r)<>RESULT_LARGE then
_success:=false;
if round(VALUE_LARGE)<>RESULT_LARGE then
_success:=false;
r:=VALUE_LARGE;
if round(r)<>RESULT_CONST_LARGE then
_success := false;
r:=VALUE_LARGE;
i64:=round(r);
if i64<>RESULT_LARGE then
_success:=false;
i64:=round(VALUE_LARGE);
if i64<>RESULT_LARGE then
_success:=false;
r:=VALUE_HUGE;
if round(r)<>RESULT_HUGE then
_success:=false;
if round(VALUE_HUGE)<>RESULT_HUGE then
_success:=false;
r:=VALUE_HUGE;
if round(r)<>RESULT_CONST_HUGE then
_success := false;
r:=VALUE_HUGE;
i64:=round(r);
if i64<>RESULT_HUGE then
_success:=false;
i64:=round(VALUE_HUGE);
if i64<>RESULT_HUGE then
_success:=false;
if not _success then
fail;
WriteLn('Success!');
@ -210,7 +279,6 @@ Begin
if l<>RESULT_TWO then
_success:=false;
if not _success then
fail;
WriteLn('Success!');
@ -218,8 +286,6 @@ end;
{$endif SKIP_CURRENCY_TEST}
Begin
test_round_real;
test_round_single;