sem_aggr.adb, [...] (Valid_Ancestor): Resolve confusion between partial and full…

sem_aggr.adb, [...] (Valid_Ancestor): Resolve confusion between partial and full views of an ancestor of the context...

2008-08-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_aggr.adb, sem_type.adb, exp_ch9.ads, einfo.ads,
	exp_ch6.adb, exp_aggr.adb (Valid_Ancestor): Resolve
	confusion between partial and full views of an ancestor of the context
	type when the parent is a private extension declared in a parent unit,
	and full views are available for the context type.

From-SVN: r139269

gcc/ada/ChangeLog

+2008-08-20  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_aggr.adb, sem_type.adb, exp_ch9.ads, einfo.ads,
+	exp_ch6.adb, exp_aggr.adb (Valid_Ancestor): Resolve
+	confusion between partial and full views of an ancestor of the context
+	type when the parent is a private extension declared in a parent unit,
+	and full views are available for the context type.
+
 2008-08-18  Samuel Tardieu  <sam@rfc1149.net>
             Robert Dewar  <dewar@adacore.com>
 

gcc/ada/einfo.ads

@@ -5016,6 +5016,7 @@ package Einfo is
    --    Generic_Renamings                   (Elist23)  (for an instance)
    --    Inner_Instances                     (Elist23)  (generic function only)
    --    Protection_Object                   (Node23)   (for concurrent kind)
+   --    Spec_PPC_List                       (Node24)
    --    Interface_Alias                     (Node25)
    --    Overridden_Operation                (Node26)
    --    Wrapped_Entity                      (Node27)   (non-generic case only)

gcc/ada/exp_aggr.adb

@@ -2547,9 +2547,13 @@ package body Exp_Aggr is
             --  in the limited case, the ancestor part must be either a
             --  function call (possibly qualified, or wrapped in an unchecked
             --  conversion) or aggregate (definitely qualified).
+            --  The ancestor part can also be a function call (that may be
+            --  transformed into an explicit dereference) or a qualification
+            --  of one such.
 
             elsif Is_Limited_Type (Etype (A))
               and then Nkind (Unqualify (A)) /= N_Function_Call --  aggregate?
+              and then Nkind (Unqualify (A)) /= N_Explicit_Dereference
               and then
                 (Nkind (Unqualify (A)) /= N_Unchecked_Type_Conversion
                    or else

gcc/ada/exp_ch6.adb

@@ -4394,6 +4394,14 @@ package body Exp_Ch6 is
       Prot_Id   : Entity_Id;
 
    begin
+      --  If the subprogram is a function with an anonymous access
+      --  to protected subprogram, it must be expanded to create
+      --  its equivalent type.
+
+      --  if Ekind (Typ) = E_Anonymous_Access_Protected_Subprogram_Type then
+      --     Expand_Access_Protected_Subprogram_Type (N, Typ);
+      --  end if;
+
       --  Deal with case of protected subprogram. Do not generate protected
       --  operation if operation is flagged as eliminated.
 

gcc/ada/exp_ch9.ads

@@ -203,7 +203,9 @@ package Exp_Ch9 is
    --  routine to make sure Complete_Master is called on exit).
 
    procedure Expand_Access_Protected_Subprogram_Type (N : Node_Id);
-   --  Build Equivalent_Type for an Access_to_protected_Subprogram
+   --  Build Equivalent_Type for an Access_To_Protected_Subprogram.
+   --  Equivalent_Type is a record type with two components: a pointer
+   --  to the protected object, and a pointer to the operation itself.
 
    procedure Expand_Accept_Declarations (N : Node_Id; Ent : Entity_Id);
    --  Expand declarations required for accept statement. See bodies of

gcc/ada/sem_aggr.adb

@@ -2155,20 +2155,31 @@ package body Sem_Aggr is
 
       begin
          Imm_Type := Base_Type (Typ);
-         while Is_Derived_Type (Imm_Type)
-           and then Etype (Imm_Type) /= Base_Type (A_Type)
-         loop
-            Imm_Type := Etype (Base_Type (Imm_Type));
+         while Is_Derived_Type (Imm_Type) loop
+            if Etype (Imm_Type) = Base_Type (A_Type) then
+               return True;
+
+            --  The base type of the parent type may appear as  a private
+            --  extension if it is declared as such in a parent unit of
+            --  the current one. For consistency of the subsequent analysis
+            --  use the partial view for the ancestor part.
+
+            elsif Is_Private_Type (Etype (Imm_Type))
+              and then Present (Full_View (Etype (Imm_Type)))
+              and then Base_Type (A_Type) = Full_View (Etype (Imm_Type))
+            then
+               A_Type := Etype (Imm_Type);
+               return True;
+
+            else
+               Imm_Type := Etype (Base_Type (Imm_Type));
+            end if;
          end loop;
 
-         if not Is_Derived_Type (Base_Type (Typ))
-           or else Etype (Imm_Type) /= Base_Type (A_Type)
-         then
-            Error_Msg_NE ("expect ancestor type of &", A, Typ);
-            return False;
-         else
-            return True;
-         end if;
+         --  If previous loop did not find a proper ancestor, report error.
+
+         Error_Msg_NE ("expect ancestor type of &", A, Typ);
+         return False;
       end Valid_Ancestor_Type;
 
    --  Start of processing for Resolve_Extension_Aggregate

gcc/ada/sem_type.adb

@@ -884,8 +884,6 @@ package body Sem_Type is
       then
          return True;
 
-      --  An aggregate is compatible with an array or record type
-
       elsif T2 = Any_Composite
         and then Ekind (T1) in E_Array_Type .. E_Record_Subtype
       then