[Ada] Representation clause for derived enumeration type is mishandled

This patch fixes an old-standing problem with premature freezing. When a
derived type declaration includes a constraint, we generate a subtype
declaration of an anonymous base type, with the constraint given in the
original type declaration, Conceptually, the bounds are converted to the
new base type, and this conversion freezes (prematurely) that base type,
when the bounds are simply literals.  As a result, a representation
clause for the derived type is then rejected or ignared. This procedure
recognizes the simple case of literal bounds in derived enumeration type
declarations, which allows us to indicate that the conversions are not
freeze points, and the subsequent representation clause can be accepted.

2019-08-19  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sem_ch3.adb (Derived_Enumeration_Type): Do no freeze anonymous
	base type if the bounds in the derived type declaration are
	literals of the type.

gcc/testsuite/

	* gnat.dg/rep_clause9.adb: New testcase.

From-SVN: r274641

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 9222a98150d45b2a82f667d27a0c7b393542a5bf..78e17437b9a3784d4cffbc385716ef1fc917edcf 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+2019-08-19  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch3.adb (Derived_Enumeration_Type): Do no freeze anonymous
+       base type if the bounds in the derived type declaration are
+       literals of the type.
+
 2019-08-19  Yannick Moy  <moy@adacore.com>
 
        * sem_res.adb (Resolve_Call): Check non-aliasing rules before

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 218aa0c9e07f57343c864bceae7a04ca6ec75a14..1b4c42d33a321228f1f6b63ce74883f421ad13a6 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -7135,6 +7135,27 @@ package body Sem_Ch3 is
       Parent_Type  : Entity_Id;
       Derived_Type : Entity_Id)
    is
+      function Bound_Belongs_To_Type (B : Node_Id) return Boolean;
+      --  When the type declaration includes a constraint, we generate
+      --  a subtype declaration of an anonymous base type, with the constraint
+      --  given in the original type declaration. Conceptually, the bounds
+      --  are converted to the new base type, and this conversion freezes
+      --  (prematurely) that base type, when the bounds are simply literals.
+      --  As a result, a representation clause for the derived type is then
+      --  rejected or ignored. This procedure recognizes the simple case of
+      --  literal bounds, which allows us to indicate that the conversions
+      --  are not freeze points, and the subsequent representation clause
+      --  can be accepted.
+      --  A similar approach might be used to resolve the long-standing
+      --  problem of premature freezing of derived numeric types ???
+
+      function Bound_Belongs_To_Type (B : Node_Id) return Boolean is
+      begin
+         return Nkind (B) = N_Type_Conversion
+           and then Is_Entity_Name (Expression (B))
+           and then Ekind (Entity (Expression (B))) = E_Enumeration_Literal;
+      end Bound_Belongs_To_Type;
+
       Loc           : constant Source_Ptr := Sloc (N);
       Def           : constant Node_Id    := Type_Definition (N);
       Indic         : constant Node_Id    := Subtype_Indication (Def);
@@ -7350,7 +7371,9 @@ package body Sem_Ch3 is
          --  However, if the type inherits predicates the expressions will
          --  be elaborated earlier and must freeze.
 
-         if Nkind (Indic) /= N_Subtype_Indication
+         if (Nkind (Indic) /= N_Subtype_Indication
+           or else
+             (Bound_Belongs_To_Type (Lo) and then Bound_Belongs_To_Type (Hi)))
            and then not Has_Predicates (Derived_Type)
          then
             Set_Must_Not_Freeze (Lo);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index b68ff86979df8d3433c63b39c98b8c78be892dc5..e3b30d27525074647b3e24c5abbfad33c5c947aa 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2019-08-19  Ed Schonberg  <schonberg@adacore.com>
+
+       * gnat.dg/rep_clause9.adb: New testcase.
+
 2019-08-19  Olivier Hainque  <hainque@adacore.com>
 
        * gnat.dg/openacc1.adb: New testcase.

diff --git a/gcc/testsuite/gnat.dg/rep_clause9.adb b/gcc/testsuite/gnat.dg/rep_clause9.adb
new file mode 100644 (file)
index 0000000..e7a350e
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/rep_clause9.adb
@@ -0,0 +1,23 @@
+--  { dg-do run }
+
+procedure Rep_Clause9 is
+
+   type Day_Of_Week
+      is (Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday);
+
+   type New_Day_Of_Week is new Day_Of_Week  range Monday .. Friday;
+   for New_Day_Of_Week use
+      (Sunday => -4, Monday => -2, Tuesday => 1, Wednesday => 100,
+       Thursday => 1000, Friday => 10000, Saturday => 10001);
+
+   V1 : New_Day_Of_Week;
+
+begin
+   if Integer'Image(New_Day_Of_Week'Pos(Monday)) /= " 1" then
+      raise Program_Error;
+   end if;
+   V1 := Monday;
+   if Integer'Image(New_Day_Of_Week'Pos(V1)) /= " 1" then
+      raise Program_Error;
+   end if;
+end;