sem_aggr.adb (Resolve_Extension_Aggregate): Report an error when the ancestor…

sem_aggr.adb (Resolve_Extension_Aggregate): Report an error when the ancestor part is a call to a limited function with an...

2009-07-23  Gary Dismukes  <dismukes@adacore.com>

	* sem_aggr.adb (Resolve_Extension_Aggregate): Report an error when the
	ancestor part is a call to a limited function with an unconstrained
	result subtype unless the aggregate has a null extension type.
	* sem_ch3.adb (Is_Null_Extension): Use the base type when retrieving
	the parent type declaration to avoid blowups on subtype cases.

From-SVN: r150002

gcc/ada/sem_aggr.adb

@@ -2376,7 +2376,20 @@ package body Sem_Aggr is
             Check_Unset_Reference (A);
             Check_Non_Static_Context (A);
 
-            if Is_Class_Wide_Type (Etype (A))
+            --  The aggregate is illegal if the ancestor expression is a call
+            --  to a function with a limited unconstrained result, unless the
+            --  type of the aggregate is a null extension. This restriction
+            --  was added in AI05-67 to simplify implementation.
+
+            if Nkind (A) = N_Function_Call
+              and then Is_Limited_Type (A_Type)
+              and then not Is_Null_Extension (Typ)
+              and then not Is_Constrained (A_Type)
+            then
+               Error_Msg_N
+                 ("type of limited ancestor part must be constrained", A);
+
+            elsif Is_Class_Wide_Type (Etype (A))
               and then Nkind (Original_Node (A)) = N_Function_Call
             then
                --  If the ancestor part is a dispatching call, it appears

gcc/ada/sem_ch3.adb

@@ -14547,7 +14547,7 @@ package body Sem_Ch3 is
    -----------------------
 
    function Is_Null_Extension (T : Entity_Id) return Boolean is
-      Type_Decl : constant Node_Id := Parent (T);
+      Type_Decl : constant Node_Id := Parent (Base_Type (T));
       Comp_List : Node_Id;
       Comp      : Node_Id;