sem_ch3.adb (Build_Derived_Enumeration_Type): Diagnose properly illegal constraints...

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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index e948e79877e9101529df0630dca10ed905232d2a..f13a1f07300de4ea958afff1a5e3ec8f2e27d18c 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index e6be49e35688247abeb380783e7ab7e00b05cfb2..7374b9766cccbb0bc19fafb7fcbaacb966f5a0a7 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -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);
+
+               Set_Scalar_Range (Derived_Type,
+                  Make_Range (Loc,
+                    Low_Bound => Lo,
+                    High_Bound => Hi));
+            else
 
-            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));
+               --   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