sem_ch3.adb (Build_Derived_Enumeration_Type): Diagnose properly illegal constraints on type derived from formal discrete types.

2009-04-17  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Build_Derived_Enumeration_Type): Diagnose properly
	illegal constraints on type derived from formal discrete types.

From-SVN: r146268
This commit is contained in:
Ed Schonberg 2009-04-17 13:40:20 +00:00 committed by Arnaud Charlet
parent aed6fda81b
commit 054275e427
2 changed files with 38 additions and 15 deletions

View File

@ -1,3 +1,8 @@
2009-04-17 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Build_Derived_Enumeration_Type): Diagnose properly
illegal constraints on type derived from formal discrete types.
2009-04-17 Thomas Quinot <quinot@adacore.com>
PR ada/35953

View File

@ -4033,8 +4033,12 @@ package body Sem_Ch3 is
-- pre-allocate a freeze node, and set the proper link to the first
-- subtype. Freeze_Entity will use this preallocated freeze node when
-- it freezes the entity.
-- This does not apply if the base type is a generic type, whose
-- declaration is independent of the current derived definition.
if B /= T then
if B /= T
and then not Is_Generic_Type (B)
then
Ensure_Freeze_Node (B);
Set_First_Subtype_Link (Freeze_Node (B), T);
end if;
@ -5055,22 +5059,36 @@ package body Sem_Ch3 is
Hi : Node_Id;
begin
Lo :=
Make_Attribute_Reference (Loc,
Attribute_Name => Name_First,
Prefix => New_Reference_To (Derived_Type, Loc));
Set_Etype (Lo, Derived_Type);
if Nkind (Indic) /= N_Subtype_Indication then
Lo :=
Make_Attribute_Reference (Loc,
Attribute_Name => Name_First,
Prefix => New_Reference_To (Derived_Type, Loc));
Set_Etype (Lo, Derived_Type);
Hi :=
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Last,
Prefix => New_Reference_To (Derived_Type, Loc));
Set_Etype (Hi, Derived_Type);
Hi :=
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Last,
Prefix => New_Reference_To (Derived_Type, Loc));
Set_Etype (Hi, Derived_Type);
Set_Scalar_Range (Derived_Type,
Make_Range (Loc,
Low_Bound => Lo,
High_Bound => Hi));
Set_Scalar_Range (Derived_Type,
Make_Range (Loc,
Low_Bound => Lo,
High_Bound => Hi));
else
-- Analyze subtype indication and verify compatibility
-- with parent type.
if
Base_Type
(Process_Subtype (Indic, N)) /= Base_Type (Parent_Type)
then
Error_Msg_N
("illegal constraint for formal discrete type", N);
end if;
end if;
end;
else