[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:
Ed Schonberg 2018-05-29 09:42:05 +00:00 committed by Pierre-Marie de Rodat
parent 54e33e5f6a
commit ef22a3b269
4 changed files with 47 additions and 16 deletions

View File

@ -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:

View File

@ -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

View File

@ -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.

View 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;