[Ada] Improper behavior of floating-point attributes
This patch fixes an error in the handling of attributes Pred qnd Succ when applied to the limit values of a floating-point type. The RM mandates that such operations must raise constraint_error, but GNAT generated in most cases an infinite value, regardless of whether overflow checks were enabled. 2018-05-29 Ed Schonberg <schonberg@adacore.com> gcc/ada/ * libgnat/s-fatgen.adb (Succ, Pred): Raise Constraint_Error unconditionally when applied to the largest positive (resp. largest negative) value of a floating-point type. gcc/testsuite/ * gnat.dg/float_attributes_overflows.adb: New testcase. From-SVN: r260882
This commit is contained in:
parent
54e33e5f6a
commit
ef22a3b269
@ -1,3 +1,9 @@
|
||||
2018-05-29 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* libgnat/s-fatgen.adb (Succ, Pred): Raise Constraint_Error
|
||||
unconditionally when applied to the largest positive (resp. largest
|
||||
negative) value of a floating-point type.
|
||||
|
||||
2018-05-29 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* einfo.ads, einfo.adb: Clarify use of Activation_Record_Component:
|
||||
|
@ -415,16 +415,7 @@ package body System.Fat_Gen is
|
||||
|
||||
elsif X = T'First then
|
||||
|
||||
-- If not generating infinities, we raise a constraint error
|
||||
|
||||
if T'Machine_Overflows then
|
||||
raise Constraint_Error with "Pred of largest negative number";
|
||||
|
||||
-- Otherwise generate a negative infinity
|
||||
|
||||
else
|
||||
return X / (X - X);
|
||||
end if;
|
||||
raise Constraint_Error with "Pred of largest negative number";
|
||||
|
||||
-- For infinities, return unchanged
|
||||
|
||||
@ -671,15 +662,10 @@ package body System.Fat_Gen is
|
||||
|
||||
-- If not generating infinities, we raise a constraint error
|
||||
|
||||
if T'Machine_Overflows then
|
||||
raise Constraint_Error with "Succ of largest negative number";
|
||||
raise Constraint_Error with "Succ of largest positive number";
|
||||
|
||||
-- Otherwise generate a positive infinity
|
||||
|
||||
else
|
||||
return X / (X - X);
|
||||
end if;
|
||||
|
||||
-- For infinities, return unchanged
|
||||
|
||||
elsif X < T'First or else X > T'Last then
|
||||
|
@ -1,3 +1,7 @@
|
||||
2018-05-29 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* gnat.dg/float_attributes_overflows.adb: New testcase.
|
||||
|
||||
2018-05-29 Pascal Obry <obry@adacore.com>
|
||||
|
||||
* gnat.dg/normalize_pathname.adb: New testcase.
|
||||
|
35
gcc/testsuite/gnat.dg/float_attributes_overflows.adb
Normal file
35
gcc/testsuite/gnat.dg/float_attributes_overflows.adb
Normal file
@ -0,0 +1,35 @@
|
||||
-- { dg-do run }
|
||||
|
||||
procedure Float_Attributes_Overflows is
|
||||
|
||||
generic
|
||||
type Float_Type is digits <>;
|
||||
procedure Test_Float_Type;
|
||||
|
||||
procedure Test_Float_Type is
|
||||
Biggest_Positive_float : Float_Type := Float_Type'Last;
|
||||
Biggest_Negative_Float : Float_Type := Float_Type'First;
|
||||
Float_Var : Float_Type;
|
||||
|
||||
begin
|
||||
begin
|
||||
Float_Var := Float_Type'succ (Biggest_Positive_Float);
|
||||
raise Program_Error;
|
||||
exception
|
||||
when Constraint_Error => null;
|
||||
end;
|
||||
|
||||
begin
|
||||
Float_Var := Float_Type'pred (Biggest_Negative_Float);
|
||||
raise Program_Error;
|
||||
exception
|
||||
when Constraint_Error => null;
|
||||
end;
|
||||
end Test_Float_Type;
|
||||
|
||||
procedure Test_Float is new Test_Float_Type (Float);
|
||||
procedure Test_Long_Float is new Test_Float_Type (Long_Float);
|
||||
begin
|
||||
Test_Float;
|
||||
Test_Long_Float;
|
||||
end Float_Attributes_Overflows;
|
Loading…
Reference in New Issue
Block a user