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

  * extended test

git-svn-id: trunk@44235 -

rtl/inc/genmath.inc

@@ -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

tests/test/units/system/tround.pp

@@ -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;