From d9ef7b974555fe62f3e93835720edde6ff889ac5 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Mon, 19 Aug 2019 08:35:40 +0000 Subject: [PATCH] [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 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 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/sem_ch3.adb | 25 ++++++++++++++++++++++++- gcc/testsuite/ChangeLog | 4 ++++ gcc/testsuite/gnat.dg/rep_clause9.adb | 23 +++++++++++++++++++++++ 4 files changed, 57 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gnat.dg/rep_clause9.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9222a98150d..78e17437b9a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-08-19 Ed Schonberg + + * 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 * 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 218aa0c9e07..1b4c42d33a3 100644 --- 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 b68ff86979d..e3b30d27525 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2019-08-19 Ed Schonberg + + * gnat.dg/rep_clause9.adb: New testcase. + 2019-08-19 Olivier Hainque * 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 index 00000000000..e7a350e76e4 --- /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;