[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
This commit is contained in:
Ed Schonberg 2019-08-19 08:35:40 +00:00 committed by Pierre-Marie de Rodat
parent c811dd91e1
commit d9ef7b9745
4 changed files with 57 additions and 1 deletions

View File

@ -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

View File

@ -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);

View File

@ -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.

View File

@ -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;