OSDN Git Service

2009-04-17 Ed Schonberg <schonberg@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 17 Apr 2009 13:40:20 +0000 (13:40 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 17 Apr 2009 13:40:20 +0000 (13:40 +0000)
* sem_ch3.adb (Build_Derived_Enumeration_Type): Diagnose properly
illegal constraints on type derived from formal discrete types.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@146268 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/ChangeLog
gcc/ada/sem_ch3.adb

index e948e79..f13a1f0 100644 (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
index e6be49e..7374b97 100644 (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);
+
+               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