Fixed-point multiplication, division and conversion may lead to calling
the function Double_Divide in s-arit64 runtime unit. In the special case
where arguments have the special values X = -2**63 and the absolute
value of the product of its other arguments Y*Z = 2**64, the rounded
value should be either -1 or 1, but currently Double_Divide returns a
quotient of 0.
Rounding only applies when Round attribute is called on the arithmetic
operation for a decimal fixed-point result, or the result type is
integer.
This fixes correctly applies rounding away from 0 in that special case.
Tested on x86_64-pc-linux-gnu, committed on trunk
2019-09-17 Yannick Moy <m...@adacore.com>
gcc/ada/
* libgnat/s-arit64.adb (Double_Divide): Correctly handle the
special case when rounding.
gcc/testsuite/
* gnat.dg/fixedpnt7.adb: New testcase.--- gcc/ada/libgnat/s-arit64.adb
+++ gcc/ada/libgnat/s-arit64.adb
@@ -147,13 +147,31 @@ package body System.Arith_64 is
Raise_Error;
end if;
+ -- Set final signs (RM 4.5.5(27-30))
+
+ Den_Pos := (Y < 0) = (Z < 0);
+
-- Compute Y * Z. Note that if the result overflows 64 bits unsigned,
- -- then the rounded result is clearly zero (since the dividend is at
- -- most 2**63 - 1, the extra bit of precision is nice here).
+ -- then the rounded result is zero, except for the very special case
+ -- where X = -2**63 and abs(Y*Z) = 2**64, when Round is True.
if Yhi /= 0 then
if Zhi /= 0 then
- Q := 0;
+
+ -- Handle the special case when Round is True
+
+ if Yhi = 1
+ and then Zhi = 1
+ and then Ylo = 0
+ and then Zlo = 0
+ and then X = Int64'First
+ and then Round
+ then
+ Q := (if Den_Pos then -1 else 1);
+ else
+ Q := 0;
+ end if;
+
R := X;
return;
else
@@ -168,17 +186,26 @@ package body System.Arith_64 is
T2 := T2 + Hi (T1);
if Hi (T2) /= 0 then
- Q := 0;
+
+ -- Handle the special case when Round is True
+
+ if Hi (T2) = 1
+ and then Lo (T2) = 0
+ and then Lo (T1) = 0
+ and then X = Int64'First
+ and then Round
+ then
+ Q := (if Den_Pos then -1 else 1);
+ else
+ Q := 0;
+ end if;
+
R := X;
return;
end if;
Du := Lo (T2) & Lo (T1);
- -- Set final signs (RM 4.5.5(27-30))
-
- Den_Pos := (Y < 0) = (Z < 0);
-
-- Check overflow case of largest negative number divided by -1
if X = Int64'First and then Du = 1 and then not Den_Pos then
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/fixedpnt7.adb
@@ -0,0 +1,20 @@
+-- { dg-do run }
+
+procedure Fixedpnt7 is
+ type F1 is delta 1.0 range -2.0**63 .. 0.0
+ with Small => 1.0;
+ type F2 is delta 4.0 range 0.0 .. 2.0**64
+ with Small => 4.0;
+ type D is delta 1.0 digits 18;
+
+ XX : constant := -2.0**63;
+ YY : constant := 2.0**64;
+
+ X : F1 := XX;
+ Y : F2 := YY;
+ U : D := D'Round(X / Y);
+begin
+ if U /= -1.0 then
+ raise Program_Error;
+ end if;
+end Fixedpnt7;
\ No newline at end of file
