2010-10-08 Thomas Quinot <quinot@adacore.com>

	* sem_ch4.adb: Minor reformatting.

2010-10-08  Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.adb: Flag 232 (formerly Implemented_By_Entry) is now unused.
	(Implemented_By_Entry): Removed.
	(Set_Implemented_By_Entry): Removed.
	(Write_Entity_Flags): Remove the output for Implemented_By_Entry.
	* einfo.ads: Remove flag Implemented_By_Entry and its usage in entities.
	(Implemented_By_Entry): Removed along with its associated pragma Inline.
	(Set_Implemented_By_Entry): Removed along with its associated pragma
	Inline.
	* exp_ch9.adb: Alphabetize with and use clauses of Exp_Ch9.
	(Build_Dispatching_Call_Equivalent): New routine.
	(Build_Dispatching_Requeue): New routine.
	(Build_Dispatching_Requeue_To_Any): New routine.
	(Build_Normal_Requeue): New routine.
	(Build_Skip_Statement): New routine.
	(Expand_N_Requeue_Statement): Rewritten. The logic has been split into
	several subroutines.
	* par-prag.adb: Replace Pragma_Implemented_By_Entry by
	Pragma_Implemented.
	* sem_ch3.adb (Check_Abstract_Overriding): Perform checks concerning
	pragma Implemented.
	(Check_Pragma_Implemented): New routines.
	(Inherit_Pragma_Implemented): New routine.
	* sem_ch9.adb (Analyze_Requeue): Update the predicate which detects a
	dispatching requeue.
	* sem_prag.adb: Update array Sig_Flags by removing Implemented_By_Entry
	and adding Implemented.
	(Ada_2012_Pragma): New routine.
	(Analyze_Pragma, case Implemented): Perform all necessary checks
	concerning pragma Implemented and register the pragma as a
	representation item with the procedure_LOCAL_NAME.
	(Analyze_Pragma, case Implemented_By_Entry): Removed.
	* sem_util.adb (Implementation_Kind): New routine.
	* sem_util.ads (Implementation_Kind): New routine.
	* snames.ads-tmpl: Remove Name_Implemented_By_Entry and add
	Name_Implemented. Remove pragma name Pragma_Implemented_By_Entry and
	add Pragma_Implemented. Add special names By_Any, By_Entry and
	By_Protected_Procedure.

2010-10-08  Javier Miranda  <miranda@adacore.com>

	* exp_ch3.adb (Expand_Freeeze_Record_Type): Code cleanup: remove local
	variable Has_Static_DT by invocation of function Building_Static_DT.

2010-10-08  Vincent Celier  <celier@adacore.com>

	* g-dirope.adb (Remove_Dir): Do not change the current directory when
	doing a recursive remove of a subdirectory.

2010-10-08  Javier Miranda  <miranda@adacore.com>

	* exp_ch6.ad (Freeze_Subprogram): Factorize code.
	* exp_disp.adb (Make_Secondary_DT): Factorize code.
	(Make_DT): Factorize code.



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

1 files changed, 458 insertions, 128 deletions

diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index a91ec6a4c22..90853ea46e4 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -29,8 +29,8 @@ with Einfo;    use Einfo;
 with Elists;   use Elists;
 with Errout;   use Errout;
 with Exp_Ch3;  use Exp_Ch3;
-with Exp_Ch11; use Exp_Ch11;
 with Exp_Ch6;  use Exp_Ch6;
+with Exp_Ch11; use Exp_Ch11;
 with Exp_Dbug; use Exp_Dbug;
 with Exp_Disp; use Exp_Disp;
 with Exp_Sel;  use Exp_Sel;
@@ -8310,8 +8310,10 @@ package body Exp_Ch9 is
    --     when all others =>
    --        Exceptional_Complete_Rendezvous (Get_GNAT_Exception);
 
-   --  Ada 2005 (AI05-0030): Dispatching requeue from protected to interface
-   --  class-wide type:
+   --  Ada 2012 (AI05-0030): Dispatching requeue to an interface primitive
+   --  marked by pragma Implemented (XXX, By_Entry).
+
+   --  The requeue is inside a protected entry:
 
    --  procedure entE
    --    (O : System.Address;
@@ -8347,10 +8349,9 @@ package body Exp_Ch9 is
    --     end;
    --  end entE;
 
-   --  Ada 2005 (AI05-0030): Dispatching requeue from task to interface
-   --  class-wide type:
+   --  The requeue is inside a task entry:
 
-   --  Accept_Call (E, Ann);
+   --    Accept_Call (E, Ann);
    --     <start of statement sequence for accept statement>
    --     _Disp_Requeue
    --       (<interface class-wide object>,
@@ -8370,63 +8371,159 @@ package body Exp_Ch9 is
    --     when all others =>
    --        Exceptional_Complete_Rendezvous (Get_GNAT_Exception);
 
-   --  Further details on these expansions can be found in Expand_N_Protected_
-   --  Body and Expand_N_Accept_Statement.
+   --  Ada 2012 (AI05-0030): Dispatching requeue to an interface primitive
+   --  marked by pragma Implemented (XXX, By_Protected_Procedure). The requeue
+   --  statement is replaced by a dispatching call with actual parameters taken
+   --  from the inner-most accept statement or entry body.
+
+   --    Target.Primitive (Param1, ..., ParamN);
+
+   --  Ada 2012 (AI05-0030): Dispatching requeue to an interface primitive
+   --  marked by pragma Implemented (XXX, By_Any) or not marked at all.
+
+   --    declare
+   --       S : constant Offset_Index :=
+   --             Get_Offset_Index (Tag (Concval), DT_Position (Ename));
+   --       C : constant Prim_Op_Kind := Get_Prim_Op_Kind (Tag (Concval), S);
+
+   --    begin
+   --       if C = POK_Protected_Entry
+   --         or else C = POK_Task_Entry
+   --       then
+   --          <statements for dispatching requeue>
+
+   --       elsif C = POK_Protected_Procedure then
+   --          <dispatching call equivalent>
+
+   --       else
+   --          raise Program_Error;
+   --       end if;
+   --    end;
 
    procedure Expand_N_Requeue_Statement (N : Node_Id) is
-      Loc        : constant Source_Ptr := Sloc (N);
-      Abortable  : Node_Id;
-      Acc_Stat   : Node_Id;
-      Conc_Typ   : Entity_Id;
-      Concval    : Node_Id;
-      Ename      : Node_Id;
-      Index      : Node_Id;
-      Lab_Node   : Node_Id;
-      New_Param  : Node_Id;
-      Old_Typ    : Entity_Id;
-      Params     : List_Id;
-      Rcall      : Node_Id;
-      RTS_Call   : Entity_Id;
-      Self_Param : Node_Id;
-      Skip_Stat  : Node_Id;
+      Loc      : constant Source_Ptr := Sloc (N);
+      Conc_Typ : Entity_Id;
+      Concval  : Node_Id;
+      Ename    : Node_Id;
+      Index    : Node_Id;
+      Old_Typ  : Entity_Id;
+
+      function Build_Dispatching_Call_Equivalent return Node_Id;
+      --  Ada 2012 (AI05-0030): N denotes a dispatching requeue statement of
+      --  the form Concval.Ename. It is statically known that Ename is allowed
+      --  to be implemented by a protected procedure. Create a dispatching call
+      --  equivalent of Concval.Ename taking the actual parameters from the
+      --  inner-most accept statement or entry body.
+
+      function Build_Dispatching_Requeue return Node_Id;
+      --  Ada 2012 (AI05-0030): N denotes a dispatching requeue statement of
+      --  the form Concval.Ename. It is statically known that Ename is allowed
+      --  to be implemented by a protected or a task entry. Create a call to
+      --  primitive _Disp_Requeue which handles the low-level actions.
+
+      function Build_Dispatching_Requeue_To_Any return Node_Id;
+      --  Ada 2012 (AI05-0030): N denotes a dispatching requeue statement of
+      --  the form Concval.Ename. Ename is either marked by pragma Implemented
+      --  (XXX, By_Any) or not marked at all. Create a block which determines
+      --  at runtime whether Ename denotes an entry or a procedure and perform
+      --  the appropriate kind of dispatching select.
+
+      function Build_Normal_Requeue return Node_Id;
+      --  N denotes a non-dispatching requeue statement to either a task or a
+      --  protected entry. Build the appropriate runtime call to perform the
+      --  action.
+
+      function Build_Skip_Statement (Search : Node_Id) return Node_Id;
+      --  For a protected entry, create a return statement to skip the rest of
+      --  the entry body. Otherwise, create a goto statement to skip the rest
+      --  of a task accept statement. The lookup for the enclosing entry body
+      --  or accept statement starts from Search.
 
-   begin
-      Abortable :=
-        New_Occurrence_Of (Boolean_Literals (Abort_Present (N)), Loc);
+      ---------------------------------------
+      -- Build_Dispatching_Call_Equivalent --
+      ---------------------------------------
 
-      --  Extract the components of the entry call
+      function Build_Dispatching_Call_Equivalent return Node_Id is
+         Call_Ent : constant Entity_Id := Entity (Ename);
+         Obj      : constant Node_Id   := Original_Node (Concval);
+         Acc_Ent  : Node_Id;
+         Actuals  : List_Id;
+         Formal   : Node_Id;
+         Formals  : List_Id;
 
-      Extract_Entry (N, Concval, Ename, Index);
-      Conc_Typ := Etype (Concval);
+      begin
+         --  Climb the parent chain looking for the inner-most entry body or
+         --  accept statement.
 
-      --  Examine the scope stack in order to find nearest enclosing protected
-      --  or task type. This will constitute our invocation source.
+         Acc_Ent := N;
+         while Present (Acc_Ent)
+           and then not Nkind_In (Acc_Ent, N_Accept_Statement,
+                                           N_Entry_Body)
+         loop
+            Acc_Ent := Parent (Acc_Ent);
+         end loop;
 
-      Old_Typ := Current_Scope;
-      while Present (Old_Typ)
-        and then not Is_Protected_Type (Old_Typ)
-        and then not Is_Task_Type (Old_Typ)
-      loop
-         Old_Typ := Scope (Old_Typ);
-      end loop;
+         --  A requeue statement should be housed inside an entry body or an
+         --  accept statement at some level. If this is not the case, then the
+         --  tree is malformed.
 
-      --  Generate the parameter list for all cases. The abortable flag is
-      --  common among dispatching and regular requeue.
+         pragma Assert (Present (Acc_Ent));
 
-      Params := New_List (Abortable);
+         --  Recover the list of formal parameters
 
-      --  Ada 2005 (AI05-0030): We have a dispatching requeue of the form
-      --  Concval.Ename where the type of Concval is class-wide concurrent
-      --  interface.
+         if Nkind (Acc_Ent) = N_Entry_Body then
+            Acc_Ent := Entry_Body_Formal_Part (Acc_Ent);
+         end if;
 
-      if Ada_Version >= Ada_05
-        and then Present (Concval)
-        and then Is_Class_Wide_Type (Conc_Typ)
-        and then Is_Concurrent_Interface (Conc_Typ)
-      then
-         RTS_Call := Make_Identifier (Loc, Name_uDisp_Requeue);
+         Formals := Parameter_Specifications (Acc_Ent);
+
+         --  Create the actual parameters for the dispatching call. These are
+         --  simply copies of the entry body or accept statement formals in the
+         --  same order as they appear.
+
+         Actuals := No_List;
+
+         if Present (Formals) then
+            Actuals := New_List;
+            Formal  := First (Formals);
+            while Present (Formal) loop
+               Append_To (Actuals,
+                 Make_Identifier (Loc, Chars (Defining_Identifier (Formal))));
+               Next (Formal);
+            end loop;
+         end if;
 
          --  Generate:
+         --    Obj.Call_Ent (Actuals);
+
+         return
+           Make_Procedure_Call_Statement (Loc,
+             Name =>
+               Make_Selected_Component (Loc,
+                 Prefix =>
+                   Make_Identifier (Loc, Chars (Obj)),
+                 Selector_Name =>
+                   Make_Identifier (Loc, Chars (Call_Ent))),
+
+             Parameter_Associations => Actuals);
+      end Build_Dispatching_Call_Equivalent;
+
+      -------------------------------
+      -- Build_Dispatching_Requeue --
+      -------------------------------
+
+      function Build_Dispatching_Requeue return Node_Id is
+         Params : constant List_Id := New_List;
+
+      begin
+         --  Process the "with abort" parameter
+
+         Prepend_To (Params,
+           New_Reference_To (Boolean_Literals (Abort_Present (N)), Loc));
+
+         --  Process the entry wrapper's position in the primary dispatch
+         --  table parameter. Generate:
+
          --    Ada.Tags.Get_Offset_Index
          --      (Ada.Tags.Tag (Concval),
          --       <interface dispatch table position of Ename>)
@@ -8435,156 +8532,389 @@ package body Exp_Ch9 is
            Make_Function_Call (Loc,
              Name =>
                New_Reference_To (RTE (RE_Get_Offset_Index), Loc),
-             Parameter_Associations =>
-               New_List (
-                 Unchecked_Convert_To (RTE (RE_Tag), Concval),
-                 Make_Integer_Literal (Loc, DT_Position (Entity (Ename))))));
 
-         --  Specific actuals for protected to interface class-wide type
-         --  requeue.
+             Parameter_Associations => New_List (
+               Unchecked_Convert_To (RTE (RE_Tag), Concval),
+               Make_Integer_Literal (Loc, DT_Position (Entity (Ename))))));
+
+         --  Specific actuals for protected to XXX requeue
 
          if Is_Protected_Type (Old_Typ) then
             Prepend_To (Params,
               Make_Attribute_Reference (Loc,        --  _object'Address
                 Prefix =>
                   Concurrent_Ref (New_Occurrence_Of (Old_Typ, Loc)),
-                Attribute_Name =>
-                  Name_Address));
+                Attribute_Name => Name_Address));
+
             Prepend_To (Params,                     --  True
               New_Reference_To (Standard_True, Loc));
 
-         --  Specific actuals for task to interface class-wide type requeue
+         --  Specific actuals for task to XXX requeue
 
          else
             pragma Assert (Is_Task_Type (Old_Typ));
 
             Prepend_To (Params,                     --  null
               New_Reference_To (RTE (RE_Null_Address), Loc));
+
             Prepend_To (Params,                     --  False
               New_Reference_To (Standard_False, Loc));
          end if;
 
-         --  Finally, add the common object parameter
+         --  Add the object parameter
 
          Prepend_To (Params, New_Copy_Tree (Concval));
 
-      --  Regular requeue processing
+         --  Generate:
+         --    _Disp_Requeue (<Params>);
 
-      else
-         New_Param := Concurrent_Ref (Concval);
+         return
+           Make_Procedure_Call_Statement (Loc,
+             Name =>
+               Make_Identifier (Loc, Name_uDisp_Requeue),
+             Parameter_Associations => Params);
+      end Build_Dispatching_Requeue;
+
+      --------------------------------------
+      -- Build_Dispatching_Requeue_To_Any --
+      --------------------------------------
+
+      function Build_Dispatching_Requeue_To_Any return Node_Id is
+         Call_Ent : constant Entity_Id := Entity (Ename);
+         Obj      : constant Node_Id   := Original_Node (Concval);
+         Skip     : constant Node_Id   := Build_Skip_Statement (N);
+         C        : Entity_Id;
+         Decls    : List_Id;
+         S        : Entity_Id;
+         Stmts    : List_Id;
+
+      begin
+         Decls := New_List;
+         Stmts := New_List;
 
-         --  The index expression is common among all four cases
+         --  Dispatch table slot processing, generate:
+         --    S : Integer;
+
+         S := Build_S (Loc, Decls);
+
+         --  Call kind processing, generate:
+         --    C : Ada.Tags.Prim_Op_Kind;
+
+         C := Build_C (Loc, Decls);
+
+         --  Generate:
+         --    S := Ada.Tags.Get_Offset_Index
+         --           (Ada.Tags.Tag (Obj), DT_Position (Call_Ent));
+
+         Append_To (Stmts, Build_S_Assignment (Loc, S, Obj, Call_Ent));
+
+         --  Generate:
+         --    _Disp_Get_Prim_Op_Kind (Obj, S, C);
+
+         Append_To (Stmts,
+           Make_Procedure_Call_Statement (Loc,
+             Name =>
+               New_Reference_To (
+                 Find_Prim_Op (Etype (Etype (Obj)),
+                   Name_uDisp_Get_Prim_Op_Kind),
+                 Loc),
+             Parameter_Associations => New_List (
+               New_Copy_Tree (Obj),
+               New_Reference_To (S, Loc),
+               New_Reference_To (C, Loc))));
+
+         Append_To (Stmts,
+
+            --  if C = POK_Protected_Entry
+            --    or else C = POK_Task_Entry
+            --  then
+
+           Make_If_Statement (Loc,
+             Condition =>
+               Make_Op_Or (Loc,
+                 Left_Opnd =>
+                   Make_Op_Eq (Loc,
+                     Left_Opnd =>
+                       New_Reference_To (C, Loc),
+                     Right_Opnd =>
+                       New_Reference_To (RTE (RE_POK_Protected_Entry), Loc)),
+
+                 Right_Opnd =>
+                   Make_Op_Eq (Loc,
+                     Left_Opnd =>
+                       New_Reference_To (C, Loc),
+                     Right_Opnd =>
+                       New_Reference_To (RTE (RE_POK_Task_Entry), Loc))),
+
+               --  Dispatching requeue equivalent
+
+             Then_Statements => New_List (
+               Build_Dispatching_Requeue,
+               Skip),
+
+               --  elsif C = POK_Protected_Procedure then
+
+             Elsif_Parts => New_List (
+               Make_Elsif_Part (Loc,
+                 Condition =>
+                   Make_Op_Eq (Loc,
+                     Left_Opnd =>
+                       New_Reference_To (C, Loc),
+                     Right_Opnd =>
+                       New_Reference_To (
+                         RTE (RE_POK_Protected_Procedure), Loc)),
+
+                  --  Dispatching call equivalent
+
+                 Then_Statements => New_List (
+                   Build_Dispatching_Call_Equivalent))),
+
+            --  else
+            --     raise Program_Error;
+            --  end if;
+
+             Else_Statements => New_List (
+               Make_Raise_Program_Error (Loc,
+                 Reason => PE_Explicit_Raise))));
+
+         --  Wrap everything into a block
+
+         return
+           Make_Block_Statement (Loc,
+             Declarations => Decls,
+             Handled_Statement_Sequence =>
+               Make_Handled_Sequence_Of_Statements (Loc,
+                 Statements => Stmts));
+      end Build_Dispatching_Requeue_To_Any;
+
+      --------------------------
+      -- Build_Normal_Requeue --
+      --------------------------
+
+      function Build_Normal_Requeue return Node_Id is
+         Params  : constant List_Id := New_List;
+         Param   : Node_Id;
+         RT_Call : Node_Id;
+
+      begin
+         --  Process the "with abort" parameter
 
          Prepend_To (Params,
-           Entry_Index_Expression (Loc, Entity (Ename), Index, Conc_Typ));
+           New_Reference_To (Boolean_Literals (Abort_Present (N)), Loc));
 
-         if Is_Protected_Type (Old_Typ) then
-            Self_Param :=
-              Make_Attribute_Reference (Loc,
-                Prefix =>
-                  Concurrent_Ref (New_Occurrence_Of (Old_Typ, Loc)),
-                Attribute_Name =>
-                  Name_Unchecked_Access);
+         --  Add the index expression to the parameters. It is common among all
+         --  four cases.
 
-            --  Protected to protected requeue
+         Prepend_To (Params,
+           Entry_Index_Expression (Loc, Entity (Ename), Index, Conc_Typ));
 
-            if Is_Protected_Type (Conc_Typ) then
-               RTS_Call :=
-                 New_Reference_To (RTE (RE_Requeue_Protected_Entry), Loc);
+         if Is_Protected_Type (Old_Typ) then
+            declare
+               Self_Param : Node_Id;
 
-               New_Param :=
+            begin
+               Self_Param :=
                  Make_Attribute_Reference (Loc,
                    Prefix =>
-                     New_Param,
+                     Concurrent_Ref (New_Occurrence_Of (Old_Typ, Loc)),
                    Attribute_Name =>
                      Name_Unchecked_Access);
 
-            --  Protected to task requeue
+               --  Protected to protected requeue
 
-            else
-               pragma Assert (Is_Task_Type (Conc_Typ));
-               RTS_Call :=
-                 New_Reference_To (
-                   RTE (RE_Requeue_Protected_To_Task_Entry), Loc);
-            end if;
+               if Is_Protected_Type (Conc_Typ) then
+                  RT_Call :=
+                    New_Reference_To (
+                      RTE (RE_Requeue_Protected_Entry), Loc);
+
+                  Param :=
+                    Make_Attribute_Reference (Loc,
+                      Prefix =>
+                        Concurrent_Ref (Concval),
+                      Attribute_Name =>
+                        Name_Unchecked_Access);
 
-            Prepend (New_Param, Params);
-            Prepend (Self_Param, Params);
+               --  Protected to task requeue
 
-         else
-            pragma Assert (Is_Task_Type (Old_Typ));
+               else pragma Assert (Is_Task_Type (Conc_Typ));
+                  RT_Call :=
+                    New_Reference_To (
+                      RTE (RE_Requeue_Protected_To_Task_Entry), Loc);
+
+                  Param := Concurrent_Ref (Concval);
+               end if;
+
+               Prepend_To (Params, Param);
+               Prepend_To (Params, Self_Param);
+            end;
+
+         else pragma Assert (Is_Task_Type (Old_Typ));
 
             --  Task to protected requeue
 
             if Is_Protected_Type (Conc_Typ) then
-               RTS_Call :=
+               RT_Call :=
                  New_Reference_To (
                    RTE (RE_Requeue_Task_To_Protected_Entry), Loc);
 
-               New_Param :=
+               Param :=
                  Make_Attribute_Reference (Loc,
                    Prefix =>
-                     New_Param,
+                     Concurrent_Ref (Concval),
                    Attribute_Name =>
                      Name_Unchecked_Access);
 
             --  Task to task requeue
 
-            else
-               pragma Assert (Is_Task_Type (Conc_Typ));
-               RTS_Call :=
+            else pragma Assert (Is_Task_Type (Conc_Typ));
+               RT_Call :=
                  New_Reference_To (RTE (RE_Requeue_Task_Entry), Loc);
+
+               Param := Concurrent_Ref (Concval);
             end if;
 
-            Prepend (New_Param, Params);
+            Prepend_To (Params, Param);
          end if;
-      end if;
 
-      --  Create the GNARLI or predefined primitive call
-
-      Rcall :=
-        Make_Procedure_Call_Statement (Loc,
-          Name => RTS_Call,
-          Parameter_Associations => Params);
+         return
+            Make_Procedure_Call_Statement (Loc,
+              Name => RT_Call,
+              Parameter_Associations => Params);
+      end Build_Normal_Requeue;
 
-      Rewrite (N, Rcall);
-      Analyze (N);
+      --------------------------
+      -- Build_Skip_Statement --
+      --------------------------
 
-      if Is_Protected_Type (Old_Typ) then
+      function Build_Skip_Statement (Search : Node_Id) return Node_Id is
+         Skip_Stmt : Node_Id;
 
-         --  Build the return statement to skip the rest of the entry body
+      begin
+         --  Build a return statement to skip the rest of the entire body
 
-         Skip_Stat := Make_Simple_Return_Statement (Loc);
+         if Is_Protected_Type (Old_Typ) then
+            Skip_Stmt := Make_Simple_Return_Statement (Loc);
 
-      else
          --  If the requeue is within a task, find the end label of the
-         --  enclosing accept statement.
+         --  enclosing accept statement and create a goto statement to it.
 
-         Acc_Stat := Parent (N);
-         while Nkind (Acc_Stat) /= N_Accept_Statement loop
-            Acc_Stat := Parent (Acc_Stat);
-         end loop;
+         else
+            declare
+               Acc   : Node_Id;
+               Label : Node_Id;
 
-         --  The last statement is the second label, used for completing the
-         --  rendezvous the usual way. The label we are looking for is right
-         --  before it.
+            begin
+               --  Climb the parent chain looking for the enclosing accept
+               --  statement.
+
+               Acc := Parent (Search);
+               while Present (Acc)
+                 and then Nkind (Acc) /= N_Accept_Statement
+               loop
+                  Acc := Parent (Acc);
+               end loop;
 
-         Lab_Node :=
-           Prev (Last (Statements (Handled_Statement_Sequence (Acc_Stat))));
+               --  The last statement is the second label used for completing
+               --  the rendezvous the usual way. The label we are looking for
+               --  is right before it.
 
-         pragma Assert (Nkind (Lab_Node) = N_Label);
+               Label :=
+                 Prev (Last (Statements (Handled_Statement_Sequence (Acc))));
 
-         --  Build the goto statement to skip the rest of the accept
-         --  statement.
+               pragma Assert (Nkind (Label) = N_Label);
 
-         Skip_Stat :=
-           Make_Goto_Statement (Loc,
-             Name => New_Occurrence_Of (Entity (Identifier (Lab_Node)), Loc));
-      end if;
+               --  Generate a goto statement to skip the rest of the accept
+
+               Skip_Stmt :=
+                 Make_Goto_Statement (Loc,
+                   Name =>
+                     New_Occurrence_Of (Entity (Identifier (Label)), Loc));
+            end;
+         end if;
+
+         Set_Analyzed (Skip_Stmt);
+
+         return Skip_Stmt;
+      end Build_Skip_Statement;
+
+   --  Start of processing for Expand_N_Requeue_Statement
 
-      Set_Analyzed (Skip_Stat);
+   begin
+      --  Extract the components of the entry call
+
+      Extract_Entry (N, Concval, Ename, Index);
+      Conc_Typ := Etype (Concval);
+
+      --  Examine the scope stack in order to find nearest enclosing protected
+      --  or task type. This will constitute our invocation source.
+
+      Old_Typ := Current_Scope;
+      while Present (Old_Typ)
+        and then not Is_Protected_Type (Old_Typ)
+        and then not Is_Task_Type (Old_Typ)
+      loop
+         Old_Typ := Scope (Old_Typ);
+      end loop;
 
-      Insert_After (N, Skip_Stat);
+      --  Ada 2012 (AI05-0030): We have a dispatching requeue of the form
+      --  Concval.Ename where the type of Concval is class-wide concurrent
+      --  interface.
+
+      if Ada_Version >= Ada_2012
+        and then Present (Concval)
+        and then Is_Class_Wide_Type (Conc_Typ)
+        and then Is_Concurrent_Interface (Conc_Typ)
+      then
+         declare
+            Has_Impl  : Boolean := False;
+            Impl_Kind : Name_Id := No_Name;
+
+         begin
+            --  Check whether the Ename is flagged by pragma Implemented
+
+            if Has_Rep_Pragma (Entity (Ename), Name_Implemented) then
+               Has_Impl  := True;
+               Impl_Kind := Implementation_Kind (Entity (Ename));
+            end if;
+
+            --  The procedure_or_entry_NAME is guaranteed to be overridden by
+            --  an entry. Create a call to predefined primitive _Disp_Requeue.
+
+            if Has_Impl
+              and then Impl_Kind = Name_By_Entry
+            then
+               Rewrite (N, Build_Dispatching_Requeue);
+               Analyze (N);
+               Insert_After (N, Build_Skip_Statement (N));
+
+            --  The procedure_or_entry_NAME is guaranteed to be overridden by
+            --  a protected procedure. In this case the requeue is transformed
+            --  into a dispatching call.
+
+            elsif Has_Impl
+              and then Impl_Kind = Name_By_Protected_Procedure
+            then
+               Rewrite (N, Build_Dispatching_Call_Equivalent);
+               Analyze (N);
+
+            --  The procedure_or_entry_NAME's implementation kind is either
+            --  By_Any or pragma Implemented was not applied at all. In this
+            --  case a runtime test determines whether Ename denotes an entry
+            --  or a protected procedure and performs the appropriate call.
+
+            else
+               Rewrite (N, Build_Dispatching_Requeue_To_Any);
+               Analyze (N);
+            end if;
+         end;
+
+      --  Processing for regular (non-dispatching) requeues
+
+      else
+         Rewrite (N, Build_Normal_Requeue);
+         Analyze (N);
+         Insert_After (N, Build_Skip_Statement (N));
+      end if;
    end Expand_N_Requeue_Statement;
 
    -------------------------------