From e34716b8dd8836a565b4cf0c26f7244161f194f1 Mon Sep 17 00:00:00 2001 From: Yannick Moy Date: Tue, 17 Sep 2019 08:02:56 +0000 Subject: [PATCH] [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 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 --- gcc/ada/ChangeLog | 5 ++++ gcc/ada/libgnat/s-arit64.adb | 43 +++++++++++++++++++++++------ gcc/testsuite/ChangeLog | 4 +++ gcc/testsuite/gnat.dg/fixedpnt7.adb | 20 ++++++++++++++ 4 files changed, 64 insertions(+), 8 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/fixedpnt7.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 36a7ddeaba9..6c4eaf762ef 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-09-17 Yannick Moy + + * libgnat/s-arit64.adb (Double_Divide): Correctly handle the + special case when rounding. + 2019-09-17 Javier Miranda * sem_ch3.adb (Complete_Private_Subtype): Propagate attributes diff --git a/gcc/ada/libgnat/s-arit64.adb b/gcc/ada/libgnat/s-arit64.adb index b5a5ac495b1..ede756292e6 100644 --- a/gcc/ada/libgnat/s-arit64.adb +++ b/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 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 28d5f264c23..56d58cc64a2 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2019-09-17 Yannick Moy + + * gnat.dg/fixedpnt7.adb: New testcase. + 2019-09-17 Yannick Moy * gnat.dg/multfixed.adb: New testcase. diff --git a/gcc/testsuite/gnat.dg/fixedpnt7.adb b/gcc/testsuite/gnat.dg/fixedpnt7.adb new file mode 100644 index 00000000000..635b9847db7 --- /dev/null +++ b/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 -- 2.30.2