diff options
| author | Yannick Moy <moy@adacore.com> | 2019-09-17 08:02:30 +0000 |
|---|---|---|
| committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2019-09-17 08:02:30 +0000 |
| commit | d4ba72cbad263d9b4fd211534c117343ed5333a1 (patch) | |
| tree | 7a0e5a8389c0d2c6332239dfe378189aa472a311 | |
| parent | 7197e2db28f10dec509967bb1cbd2d74cb03ee7e (diff) | |
| download | gcc-d4ba72cbad263d9b4fd211534c117343ed5333a1.zip gcc-d4ba72cbad263d9b4fd211534c117343ed5333a1.tar.gz gcc-d4ba72cbad263d9b4fd211534c117343ed5333a1.tar.bz2 | |
[Ada] Raise Constraint_Error in overflow case involving rounding
Function Scaled_Divide in s-arith runtime unit computes the combined
multiplication and division of its arguments ((X*Y) / Z). In a very
special case where the quotient computed before rounding is 2**64-1,
then rounding may lead to undesirable wrap-around, leading to a computed
quotient of 0 instead of raising Constraint_Error as expected.
This function is only called in the runtime for arithmetic operations
involving fixed-point types. Rounding is performed only when the target
type is of a decimal fixed-point type, and the attribute 'Round of the
type is used to round the result of the arithmetic operation.
This fix correctly raises Constraint_Error in this special case.
2019-09-17 Yannick Moy <moy@adacore.com>
gcc/ada/
* libgnat/s-arit64.adb (Scaled_Divide): Add protection against
undesirable wrap-around.
gcc/testsuite/
* gnat.dg/multfixed.adb: New testcase.
From-SVN: r275791
| -rw-r--r-- | gcc/ada/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-arit64.adb | 8 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 4 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/multfixed.adb | 24 |
4 files changed, 41 insertions, 0 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 913b30f..9a07751 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,10 @@ 2019-09-17 Yannick Moy <moy@adacore.com> + * libgnat/s-arit64.adb (Scaled_Divide): Add protection against + undesirable wrap-around. + +2019-09-17 Yannick Moy <moy@adacore.com> + * libgnat/s-arit64.adb (Double_Divide): Fix two possible overflows. diff --git a/gcc/ada/libgnat/s-arit64.adb b/gcc/ada/libgnat/s-arit64.adb index a35a40d..6773dd8 100644 --- a/gcc/ada/libgnat/s-arit64.adb +++ b/gcc/ada/libgnat/s-arit64.adb @@ -511,6 +511,14 @@ package body System.Arith_64 is -- Deal with rounding case if Round and then Ru > (Zu - Uns64'(1)) / Uns64'(2) then + + -- Protect against wrapping around when rounding, by signaling + -- an overflow when the quotient is too large. + + if Qu = Uns64'Last then + Raise_Error; + end if; + Qu := Qu + Uns64 (1); end if; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index caed11b..28d5f26 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2019-09-17 Yannick Moy <moy@adacore.com> + + * gnat.dg/multfixed.adb: New testcase. + 2019-09-17 Vadim Godunko <godunko@adacore.com> * gnat.dg/expect3.adb: New testcase. diff --git a/gcc/testsuite/gnat.dg/multfixed.adb b/gcc/testsuite/gnat.dg/multfixed.adb new file mode 100644 index 0000000..2eca3cd --- /dev/null +++ b/gcc/testsuite/gnat.dg/multfixed.adb @@ -0,0 +1,24 @@ +-- { dg-do run } + +with Ada.Exceptions; use Ada.Exceptions; + +procedure Multfixed is + Z : constant := 4387648782261400837.0; + type F1 is delta 1.0 / Z range 0.0 .. (2.0**63-1.0) / Z + with Small => 1.0 / Z; + type F2 is delta 1.0 range 0.0 .. (2.0**63-1.0) + with Small => 1.0; + type D is delta 1.0 digits 18; + + X : F1 := 8914588002054909637.0 / Z; + Y : F2 := 9079256848778919936.0; + U : D; +begin + U := D'Round(X * Y); + raise Program_Error; +exception + when Exc : Constraint_Error => + if Exception_Message (Exc) /= "System.Arith_64.Raise_Error: 64-bit arithmetic overflow" then + raise Program_Error; + end if; +end Multfixed;
\ No newline at end of file |