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

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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 21e3e269a40bd9f3aec31b85a96126fcf8f77594..2161e87cde3a1772455ef263f846c953c58753ab 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,11 @@
+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>
 

diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index c7182dbe04f24bff1f2ecbd4c2824d366f89b950..a70587471495fc1bb069112bbaacac95202f7e3b 100644 (file)
--- a/gcc/ada/einfo.ads
+++ b/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)

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index bc3b954fb6c3b6a9a227ab9664b59680ddffea2c..8a59879b0e073ae292c9801d5e5b19240d03bc1f 100644 (file)
--- a/gcc/ada/exp_aggr.adb
+++ b/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

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 4c3f3da63f946509f51e8919daf5b1a601c412ef..faefb52c6f4697c392fcf04d63a92874056ddbbb 100644 (file)
--- a/gcc/ada/exp_ch6.adb
+++ b/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.
 

diff --git a/gcc/ada/exp_ch9.ads b/gcc/ada/exp_ch9.ads
index 1cfa74d3635e06c6f4c3263fa7489c172f620aba..3ec61125a3fc737b27e69ef3ff8d40d7cf148c17 100644 (file)
--- a/gcc/ada/exp_ch9.ads
+++ b/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

diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index d16b7d6b8c46f74fbc3bc5423f00d6573bfedc50..13ab96c6c638346f722102bf3e2bcfb4b3e05747 100644 (file)
--- a/gcc/ada/sem_aggr.adb
+++ b/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

diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb
index 3ca2e5354780d067f6d2ee19e275fdea57638d9a..b8dca3bf9ff199b36e826bd5aa29049a4c4d06aa 100644 (file)
--- a/gcc/ada/sem_type.adb
+++ b/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