[multiple changes]

2010-09-09  Javier Miranda  <miranda@adacore.com>

	* sem_ch3.adb (Is_Progenitor): Relocated to sem_type.
	(Replace_Type): Code cleanup.
	* sem_type.ads, sem_type.adb (Is_Progenitor): Relocated from sem_ch3

2010-09-09  Thomas Quinot  <quinot@adacore.com>

	* exp_ch8.adb: Minor reformatting.

2010-09-09  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch9.adb, einfo.adb, einfo.ads: New attribute
	Corresponding_Protected_Entry.

From-SVN: r164065

8 files changed, 75 insertions, 43 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index fe15868..97aa882 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,18 @@
+2010-09-09  Javier Miranda  <miranda@adacore.com>
+
+	* sem_ch3.adb (Is_Progenitor): Relocated to sem_type.
+	(Replace_Type): Code cleanup.
+	* sem_type.ads, sem_type.adb (Is_Progenitor): Relocated from sem_ch3
+
+2010-09-09  Thomas Quinot  <quinot@adacore.com>
+
+	* exp_ch8.adb: Minor reformatting.
+
+2010-09-09  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch9.adb, einfo.adb, einfo.ads: New attribute
+	Corresponding_Protected_Entry.
+
 2010-09-09  Ed Schonberg  <schonberg@adacore.com>
 
 	* exp_ch3.adb (Build_Untagged_Equality): Do not set alias of implicit
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 15bf858..95dc331 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -149,6 +149,7 @@ package body Einfo is
 
    --    Alias                           Node18
    --    Corresponding_Concurrent_Type   Node18
+   --    Corresponding_Protected_Entry   Node18
    --    Corresponding_Record_Type       Node18
    --    Delta_Value                     Ureal18
    --    Enclosing_Scope                 Node18
@@ -723,6 +724,11 @@ package body Einfo is
       return Node13 (Id);
    end Corresponding_Equality;
 
+   function Corresponding_Protected_Entry (Id : E) return E is
+   begin
+      return Node18 (Id);
+   end Corresponding_Protected_Entry;
+
    function Corresponding_Record_Type (Id : E) return E is
    begin
       pragma Assert (Is_Concurrent_Type (Id));
@@ -3109,6 +3115,11 @@ package body Einfo is
       Set_Node13 (Id, V);
    end Set_Corresponding_Equality;
 
+   procedure Set_Corresponding_Protected_Entry (Id : E; V : E) is
+   begin
+      Set_Node18 (Id, V);
+   end Set_Corresponding_Protected_Entry;
+
    procedure Set_Corresponding_Record_Type (Id : E; V : E) is
    begin
       pragma Assert (Is_Concurrent_Type (Id));
@@ -7648,6 +7659,9 @@ package body Einfo is
          when E_Record_Type                                =>
             Write_Str ("Corresponding_Concurrent_Type");
 
+         when E_Subprogram_Body                            =>
+            Write_Str ("Corresponding_Protected_Entry");
+
          when E_Entry_Index_Parameter                      =>
             Write_Str ("Entry_Index_Constant");
 
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 3c12bba..db19b39 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -631,6 +631,10 @@ package Einfo is
 --       other function entities, only in implicit inequality routines,
 --       where Comes_From_Source is always False.
 
+--    Corresponding_Protected_Entry (Node18)
+--       Present in subrogram bodies that implement entries of protected
+--       types.
+
 --    Corresponding_Record_Type (Node18)
 --       Present in protected and task types and subtypes. References the
 --       entity for the corresponding record type constructed by the expander
@@ -5765,6 +5769,7 @@ package Einfo is
    function Corresponding_Concurrent_Type       (Id : E) return E;
    function Corresponding_Discriminant          (Id : E) return E;
    function Corresponding_Equality              (Id : E) return E;
+   function Corresponding_Protected_Entry       (Id : E) return E;
    function Corresponding_Record_Type           (Id : E) return E;
    function Corresponding_Remote_Type           (Id : E) return E;
    function Current_Use_Clause                  (Id : E) return E;
@@ -6326,6 +6331,7 @@ package Einfo is
    procedure Set_Corresponding_Concurrent_Type   (Id : E; V : E);
    procedure Set_Corresponding_Discriminant      (Id : E; V : E);
    procedure Set_Corresponding_Equality          (Id : E; V : E);
+   procedure Set_Corresponding_Protected_Entry   (Id : E; V : E);
    procedure Set_Corresponding_Record_Type       (Id : E; V : E);
    procedure Set_Corresponding_Remote_Type       (Id : E; V : E);
    procedure Set_Current_Use_Clause              (Id : E; V : E);
@@ -6982,6 +6988,7 @@ package Einfo is
    pragma Inline (Corresponding_Concurrent_Type);
    pragma Inline (Corresponding_Discriminant);
    pragma Inline (Corresponding_Equality);
+   pragma Inline (Corresponding_Protected_Entry);
    pragma Inline (Corresponding_Record_Type);
    pragma Inline (Corresponding_Remote_Type);
    pragma Inline (Current_Use_Clause);
@@ -7413,6 +7420,7 @@ package Einfo is
    pragma Inline (Set_Corresponding_Concurrent_Type);
    pragma Inline (Set_Corresponding_Discriminant);
    pragma Inline (Set_Corresponding_Equality);
+   pragma Inline (Set_Corresponding_Protected_Entry);
    pragma Inline (Set_Corresponding_Record_Type);
    pragma Inline (Set_Corresponding_Remote_Type);
    pragma Inline (Set_Current_Use_Clause);
diff --git a/gcc/ada/exp_ch8.adb b/gcc/ada/exp_ch8.adb
index b81fb42..39c0fc6 100644
--- a/gcc/ada/exp_ch8.adb
+++ b/gcc/ada/exp_ch8.adb
@@ -358,7 +358,7 @@ package body Exp_Ch8 is
       end if;
 
       --  Check whether this is a renaming of a predefined equality on an
-      --  untagged record type  (AI05-0123).
+      --  untagged record type (AI05-0123).
 
       if Is_Entity_Name (Nam)
         and then Chars (Entity (Nam)) = Name_Op_Eq
@@ -370,9 +370,9 @@ package body Exp_Ch8 is
             Id  : constant Entity_Id  := Defining_Entity (N);
             Typ : constant Entity_Id  := Etype (First_Formal (Id));
 
-            Decl : Node_Id;
-            Body_Id : constant Entity_Id
-              := Make_Defining_Identifier (Sloc (N), Chars (Id));
+            Decl    : Node_Id;
+            Body_Id : constant Entity_Id :=
+                        Make_Defining_Identifier (Sloc (N), Chars (Id));
 
          begin
             if Is_Record_Type (Typ)
@@ -394,14 +394,15 @@ package body Exp_Ch8 is
                Set_Has_Delayed_Freeze (Id);
 
                Decl := Make_Subprogram_Body (Loc,
-                 Specification =>
-                   Make_Function_Specification (Loc,
-                     Defining_Unit_Name => Body_Id,
-                     Parameter_Specifications => Copy_Parameter_List (Id),
-                     Result_Definition =>
-                       New_Occurrence_Of (Standard_Boolean, Loc)),
-                 Declarations => Empty_List,
-                 Handled_Statement_Sequence => Empty);
+                         Specification              =>
+                           Make_Function_Specification (Loc,
+                             Defining_Unit_Name       => Body_Id,
+                             Parameter_Specifications =>
+                               Copy_Parameter_List (Id),
+                             Result_Definition        =>
+                               New_Occurrence_Of (Standard_Boolean, Loc)),
+                         Declarations               => Empty_List,
+                         Handled_Statement_Sequence => Empty);
 
                Set_Handled_Statement_Sequence (Decl,
                  Make_Handled_Sequence_Of_Statements (Loc,
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 1e9edfe..7d6b0f9 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -2720,6 +2720,10 @@ package body Exp_Ch9 is
                raise Program_Error;
          end case;
 
+         --  Establish link between subprogram body entity and source entry.
+
+         Set_Corresponding_Protected_Entry (Edef, Ent);
+
          --  Create body of entry procedure. The renaming declarations are
          --  placed ahead of the block that contains the actual entry body.
 
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 3e801ad..7708b8b 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -574,14 +574,6 @@ package body Sem_Ch3 is
    --  copying the record declaration for the derived base. In the tagged case
    --  the value returned is irrelevant.
 
-   function Is_Progenitor
-     (Iface : Entity_Id;
-      Typ   : Entity_Id) return Boolean;
-   --  Determine whether the interface Iface is implemented by Typ. It requires
-   --  traversing the list of abstract interfaces of the type, as well as that
-   --  of the ancestor types. The predicate is used to determine when a formal
-   --  in the signature of an inherited operation must carry the derived type.
-
    function Is_Valid_Constraint_Kind
      (T_Kind          : Type_Kind;
       Constraint_Kind : Node_Kind) return Boolean;
@@ -12263,15 +12255,6 @@ package body Sem_Ch3 is
                Set_Etype (New_Id, Base_Type (Derived_Type));
             end if;
 
-         --  Ada 2005 (AI-251): Handle derivations of abstract interface
-         --  primitives.
-
-         elsif Is_Interface (Etype (Id))
-           and then not Is_Class_Wide_Type (Etype (Id))
-           and then Is_Progenitor (Etype (Id), Derived_Type)
-         then
-            Set_Etype (New_Id, Derived_Type);
-
          else
             Set_Etype (New_Id, Etype (Id));
          end if;
@@ -14951,19 +14934,6 @@ package body Sem_Ch3 is
       end if;
    end Is_Null_Extension;
 
-   --------------------
-   --  Is_Progenitor --
-   --------------------
-
-   function Is_Progenitor
-     (Iface : Entity_Id;
-      Typ   : Entity_Id) return Boolean
-   is
-   begin
-      return Implements_Interface (Typ, Iface,
-               Exclude_Parents => True);
-   end Is_Progenitor;
-
    ------------------------------
    -- Is_Valid_Constraint_Kind --
    ------------------------------
diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb
index 0ae2825..3f253fa 100644
--- a/gcc/ada/sem_type.adb
+++ b/gcc/ada/sem_type.adb
@@ -2669,6 +2669,18 @@ package body Sem_Type is
       end if;
    end Is_Invisible_Operator;
 
+   --------------------
+   --  Is_Progenitor --
+   --------------------
+
+   function Is_Progenitor
+     (Iface : Entity_Id;
+      Typ   : Entity_Id) return Boolean
+   is
+   begin
+      return Implements_Interface (Typ, Iface, Exclude_Parents => True);
+   end Is_Progenitor;
+
    -------------------
    -- Is_Subtype_Of --
    -------------------
diff --git a/gcc/ada/sem_type.ads b/gcc/ada/sem_type.ads
index 307674f..83d4bb9 100644
--- a/gcc/ada/sem_type.ads
+++ b/gcc/ada/sem_type.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -221,6 +221,14 @@ package Sem_Type is
    --  T1 is a tagged type (not class-wide). Verify that it is one of the
    --  ancestors of type T2 (which may or not be class-wide).
 
+   function Is_Progenitor
+     (Iface : Entity_Id;
+      Typ   : Entity_Id) return Boolean;
+   --  Determine whether the interface Iface is implemented by Typ. It requires
+   --  traversing the list of abstract interfaces of the type, as well as that
+   --  of the ancestor types. The predicate is used to determine when a formal
+   --  in the signature of an inherited operation must carry the derived type.
+
    function Is_Subtype_Of (T1 : Entity_Id; T2 : Entity_Id) return Boolean;
    --  Checks whether T1 is any subtype of T2 directly or indirectly. Applies
    --  only to scalar subtypes???