[Ada] Type inconsistency in floating_point type declarations

This patch fixes an inconsistency in the typing of the bounds of a
floting point type declaration, when some bound is given by a dtatic
constant of an explicit type, instead of a real literal, Previous to
this patch the bound of the type retained the given type, leading to
spurious errors in Codepeer.

2019-07-22  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sem_ch3.adb (Convert_Bound): Subsidiary of
	Floating_Point_Type_Declaration, to handle properly range
	specifications with bounds that may include static constants of
	a given type rather than real literals.

From-SVN: r273680

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 202dfc7cacf10d724d9bd67e6a318d5d54f5e260..2d0beb3841a64c5fcd91526ae3f374df719f57bb 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2019-07-22  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch3.adb (Convert_Bound): Subsidiary of
+       Floating_Point_Type_Declaration, to handle properly range
+       specifications with bounds that may include static constants of
+       a given type rather than real literals.
+
 2019-07-22  Eric Botcazou  <ebotcazou@adacore.com>
 
        * sem_aggr.adb (Rewrite_Bound): Be prepared for discriminals

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index ae0a7bfde7f27d3549b0b7e8aa3253bc5da92de1..5bee503e885ba103cf8462a01959a7f126536875 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -17827,12 +17827,16 @@ package body Sem_Ch3 is
       Digs_Val      : Uint;
       Base_Typ      : Entity_Id;
       Implicit_Base : Entity_Id;
-      Bound         : Node_Id;
 
       function Can_Derive_From (E : Entity_Id) return Boolean;
       --  Find if given digits value, and possibly a specified range, allows
       --  derivation from specified type
 
+      procedure Convert_Bound (B : Node_Id);
+      --  If specified, the bounds must be static but may be of different
+      --  types. They must be converted into machine numbers of the base type,
+      --  in accordance with RM 4.9(38).
+
       function Find_Base_Type return Entity_Id;
       --  Find a predefined base type that Def can derive from, or generate
       --  an error and substitute Long_Long_Float if none exists.
@@ -17870,6 +17874,28 @@ package body Sem_Ch3 is
          return True;
       end Can_Derive_From;
 
+      -------------------
+      -- Convert_Bound --
+      --------------------
+
+      procedure Convert_Bound (B : Node_Id) is
+      begin
+         --  If the bound is not a literal it can only be static if it is
+         --  a static constant, possibly of a specified type.
+
+         if Is_Entity_Name (B)
+           and then Ekind (Entity (B)) = E_Constant
+         then
+            Rewrite (B, Constant_Value (Entity (B)));
+         end if;
+
+         if Nkind (B) = N_Real_Literal then
+            Set_Realval (B, Machine (Base_Typ, Realval (B), Round, B));
+            Set_Is_Machine_Number (B);
+            Set_Etype (B, Base_Typ);
+         end if;
+      end Convert_Bound;
+
       --------------------
       -- Find_Base_Type --
       --------------------
@@ -17967,24 +17993,8 @@ package body Sem_Ch3 is
          Set_Scalar_Range (T, Real_Range_Specification (Def));
          Set_Is_Constrained (T);
 
-         --  The bounds of this range must be converted to machine numbers
-         --  in accordance with RM 4.9(38).
-
-         Bound := Type_Low_Bound (T);
-
-         if Nkind (Bound) = N_Real_Literal then
-            Set_Realval
-              (Bound, Machine (Base_Typ, Realval (Bound), Round, Bound));
-            Set_Is_Machine_Number (Bound);
-         end if;
-
-         Bound := Type_High_Bound (T);
-
-         if Nkind (Bound) = N_Real_Literal then
-            Set_Realval
-              (Bound, Machine (Base_Typ, Realval (Bound), Round, Bound));
-            Set_Is_Machine_Number (Bound);
-         end if;
+         Convert_Bound (Type_Low_Bound (T));
+         Convert_Bound (Type_High_Bound (T));
 
       else
          Set_Scalar_Range (T, Scalar_Range (Base_Typ));