[Ada] Fix rounding of fixed-point arithmetic operation
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. 2019-09-17 Yannick Moy <moy@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. From-SVN: r275796
This commit is contained in:
parent
0d4fcc9f62
commit
e34716b8dd
|
@ -1,3 +1,8 @@
|
|||
2019-09-17 Yannick Moy <moy@adacore.com>
|
||||
|
||||
* libgnat/s-arit64.adb (Double_Divide): Correctly handle the
|
||||
special case when rounding.
|
||||
|
||||
2019-09-17 Javier Miranda <miranda@adacore.com>
|
||||
|
||||
* sem_ch3.adb (Complete_Private_Subtype): Propagate attributes
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -1,3 +1,7 @@
|
|||
2019-09-17 Yannick Moy <moy@adacore.com>
|
||||
|
||||
* gnat.dg/fixedpnt7.adb: New testcase.
|
||||
|
||||
2019-09-17 Yannick Moy <moy@adacore.com>
|
||||
|
||||
* gnat.dg/multfixed.adb: New testcase.
|
||||
|
|
|
@ -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;
|
Loading…
Reference in New Issue