[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
This commit is contained in:
parent
7197e2db28
commit
d4ba72cbad
|
@ -1,3 +1,8 @@
|
|||
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
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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;
|
Loading…
Reference in New Issue