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

git-svn-id: trunk@28311 -

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;
+  test32($7fffffff,res2_single);
+  writeln;
+  test32(longint($80000001),res3_single);
   writeln;
-  test($7fffffffffffffff,res2); 
+
+  writeln('Testing int64->double conversion');
+  testint64($4000000000000001,res1);
+  writeln;
+  testint64($7fffffffffffffff,res2);
   writeln;
-  test(int64($8000000000000001),res3);
+  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.