[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 86d66804b21106b72d93c724d99dd3b43ecb71df..9c529da0d295b9eab9f206da0541220e6d6c0e87 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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:

diff --git a/gcc/ada/libgnat/s-fatgen.adb b/gcc/ada/libgnat/s-fatgen.adb
index 41e5fe7fcf2214aaae5c9efc013c029a07c5fb20..d74c3d8027404f5bc57edf2b4186914ba570c6bd 100644 (file)
--- a/gcc/ada/libgnat/s-fatgen.adb
+++ b/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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 947dfc28565927f60bd2056935f95ed705ea31c9..bce064a523d5b75cba7afb25a4c16c73d05ebac3 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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.

diff --git a/gcc/testsuite/gnat.dg/float_attributes_overflows.adb b/gcc/testsuite/gnat.dg/float_attributes_overflows.adb
new file mode 100644 (file)
index 0000000..becee15
--- /dev/null
+++ b/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;