paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 14:29:14 +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 } if j0>=63 then { Overflow, let trunc() raise an exception }
exit(trunc(d)) { and/or return +/-MaxInt64 if it's masked } exit(trunc(d)) { and/or return +/-MaxInt64 if it's masked }
else 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 end
else else
begin begin

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

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