[Ada] Improper behavior of floating-point attributes

[Pierre-Marie de Rodat]

This patch fixes an error in the handling of attributes Pred and 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.

Tested on x86_64-pc-linux-gnu, committed on trunk

2018-05-29  Ed Schonberg  <schonb...@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.

--- gcc/ada/libgnat/s-fatgen.adb
+++ gcc/ada/libgnat/s-fatgen.adb
@@ -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

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/float_attributes_overflows.adb
@@ -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;