[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:
parent
c811dd91e1
commit
d9ef7b9745
4 changed files with 57 additions and 1 deletions
|
@ -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
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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.
|
||||
|
|
23
gcc/testsuite/gnat.dg/rep_clause9.adb
Normal file
23
gcc/testsuite/gnat.dg/rep_clause9.adb
Normal 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;
|
Loading…
Add table
Reference in a new issue