2013-10-10 Robert Dewar <dewar@adacore.com>

	* sem_aggr.adb (Resolve_Array_Aggregate): Redo duplicate/missing
	choice circuit. Was not quite right in some cases, which showed
	up in ACATS test B43201C.
	* sem_attr.adb (Address_Checks): Make sure name is set right
	for some messages issued.
	* mlib-prj.adb: Minor code reorganization.
	* gnat_ugn.texi: Remove special VMS doc for tagging of warning msgs.
	* exp_ch9.adb: Minor reformatting.

2013-10-10  Tristan Gingold  <gingold@adacore.com>

	* lib-writ.adb (Write_Unit_Information): Adjust previous patch.

2013-10-10  Robert Dewar  <dewar@adacore.com>

	* sem_ch5.adb (Analyze_If_Statement): Warn on redundant if
	statement.
	* sem_util.ads, sem_util.adb (Has_No_Obvious_Side_Effects): New
	function.

2013-10-10  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch9.adb (Expand_N_Timed_Entry_Call): Simplify expansion
	for the case of a dispatching trigger: there is no need to
	duplicate the code or create a subprogram to encapsulate the
	triggering statements. This allows exit statements in the
	triggering statements, that refer to enclosing loops.



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

1 files changed, 38 insertions, 90 deletions

diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 738564c0e4a..8db80bde74b 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -11948,7 +11948,10 @@ package body Exp_Ch9 is
    --       end if;
    --    end;
 
-   --  3) Ada 2005 (AI-345): When T.E is a dispatching procedure call;
+   --  3) Ada 2005 (AI-345): When T.E is a dispatching procedure call, there
+   --     is no delay and the triggering statements are executed. We first
+   --     determine the kind of of the triggering call and then execute a
+   --     synchronized operation or a direct call.
 
    --    declare
    --       B  : Boolean := False;
@@ -11965,7 +11968,7 @@ package body Exp_Ch9 is
    --         or else K = Ada.Tags.TK_Tagged
    --       then
    --          <dispatching-call>;
-   --          <triggering-statements>
+   --          B := True;
 
    --       else
    --          S :=
@@ -11989,20 +11992,19 @@ package body Exp_Ch9 is
    --             then
    --                <dispatching-call>;
    --             end if;
-
-   --             <triggering-statements>
-   --          else
-   --             <timed-statements>
-   --          end if;
+   --         end if;
    --       end if;
+
+   --      if B then
+   --          <triggering-statements>
+   --      else
+   --          <timed-statements>
+   --      end if;
    --    end;
 
    --  The triggering statement and the sequence of timed statements have not
    --  been analyzed yet (see Analyzed_Timed_Entry_Call), but they may contain
-   --  global references if within an instantiation. To prevent duplication
-   --  between various uses of those statements, they are encapsulated into a
-   --  local procedure which is invoked multiple time when the trigger is a
-   --  dispatching call.
+   --  global references if within an instantiation.
 
    procedure Expand_N_Timed_Entry_Call (N : Node_Id) is
       Loc : constant Source_Ptr := Sloc (N);
@@ -12045,63 +12047,6 @@ package body Exp_Ch9 is
       P : Entity_Id;  --  Parameter block
       S : Entity_Id;  --  Primitive operation slot
 
-      procedure Rewrite_Triggering_Statements;
-      --  If the trigger is a dispatching call, the expansion inserts multiple
-      --  copies of the abortable part. This is both inefficient, and may lead
-      --  to duplicate definitions that the back-end will reject, when the
-      --  abortable part includes loops. This procedure rewrites the abortable
-      --  part into a call to a generated procedure.
-
-      -----------------------------------
-      -- Rewrite_Triggering_Statements --
-      -----------------------------------
-
-      procedure Rewrite_Triggering_Statements is
-         Proc : constant Entity_Id := Make_Defining_Identifier (Loc, Name_uA);
-         Decl : Node_Id;
-         Stat : Node_Id;
-
-      begin
-         Decl :=
-           Make_Subprogram_Body (Loc,
-             Specification              =>
-               Make_Procedure_Specification (Loc, Defining_Unit_Name => Proc),
-             Declarations               => New_List,
-             Handled_Statement_Sequence =>
-               Make_Handled_Sequence_Of_Statements (Loc, E_Stats));
-
-         Append_To (Decls, Decl);
-
-         --  Adjust the scope of blocks in the procedure. Needed because blocks
-         --  generate declarations that are processed before other analysis
-         --  takes place, and their scope is already set. The backend depends
-         --  on the scope chain to determine the legality of some anonymous
-         --  types, and thus we must indicate that the block is within the new
-         --  procedure.
-
-         Stat := First (E_Stats);
-         while Present (Stat) loop
-            if Nkind (Stat) = N_Block_Statement then
-               Insert_Before (Stat,
-                 Make_Implicit_Label_Declaration (Sloc (Stat),
-                   Defining_Identifier =>
-                     Make_Defining_Identifier (
-                       Sloc (Stat), Chars (Identifier (Stat)))));
-            end if;
-
-            Next (Stat);
-         end loop;
-
-         --  Analyze (Decl);
-
-         --  Rewrite abortable part into a call to this procedure.
-
-         E_Stats :=
-           New_List
-             (Make_Procedure_Call_Statement (Loc,
-                Name => New_Occurrence_Of (Proc, Loc)));
-      end Rewrite_Triggering_Statements;
-
    --  Start of processing for Expand_N_Timed_Entry_Call
 
    begin
@@ -12144,7 +12089,6 @@ package body Exp_Ch9 is
       if Is_Disp_Select then
          Extract_Dispatching_Call (E_Call, Call_Ent, Obj, Actuals, Formals);
          Decls := New_List;
-         Rewrite_Triggering_Statements;
 
          Stmts := New_List;
 
@@ -12349,20 +12293,10 @@ package body Exp_Ch9 is
          --       then
          --          <dispatching-call>
          --       end if;
-         --       <triggering-statements>
-         --    else
-         --       <timed-statements>
          --    end if;
 
-         --  Note: we used to do Copy_Separate_List here, but this was changed
-         --  to New_Copy_List_Tree with no explanation or RH note??? We should
-         --  explain the need for the change ???
-
-         N_Stats := New_Copy_List_Tree (E_Stats);
-
-         Prepend_To (N_Stats,
+         N_Stats := New_List (
            Make_Implicit_If_Statement (N,
-
              Condition =>
                Make_Or_Else (Loc,
                  Left_Opnd =>
@@ -12391,19 +12325,17 @@ package body Exp_Ch9 is
          Append_To (Conc_Typ_Stmts,
            Make_Implicit_If_Statement (N,
              Condition       => New_Reference_To (B, Loc),
-             Then_Statements => N_Stats,
-             Else_Statements => D_Stats));
+             Then_Statements => N_Stats));
 
          --  Generate:
          --    <dispatching-call>;
-         --    <triggering-statements>
-
-         --  Note: the following was Copy_Separate_List but it was changed to
-         --  New_Copy_List_Tree without comments or RH documentation ??? We
-         --  should explain the need for the change ???
+         --    B := True;
 
-         Lim_Typ_Stmts := New_Copy_List_Tree (E_Stats);
-         Prepend_To (Lim_Typ_Stmts, New_Copy_Tree (E_Call));
+         Lim_Typ_Stmts :=
+           New_List (New_Copy_Tree (E_Call),
+             Make_Assignment_Statement (Loc,
+               Name       => New_Occurrence_Of (B, Loc),
+               Expression => New_Occurrence_Of (Standard_True, Loc)));
 
          --  Generate:
          --    if K = Ada.Tags.TK_Limited_Tagged
@@ -12420,8 +12352,24 @@ package body Exp_Ch9 is
              Then_Statements => Lim_Typ_Stmts,
              Else_Statements => Conc_Typ_Stmts));
 
+         --    Generate:
+
+         --    if B then
+         --       <triggering-statements>
+         --    else
+         --       <timed-statements>
+         --    end if;
+
+         Append_To (Stmts,
+           Make_Implicit_If_Statement (N,
+             Condition       => New_Occurrence_Of (B, Loc),
+             Then_Statements => E_Stats,
+             Else_Statements => D_Stats));
+
       else
-         --  Skip assignments to temporaries created for in-out parameters.
+         --  Simple case of a non-dispatching trigger. Skip assignments to
+         --  temporaries created for in-out parameters.
+
          --  This makes unwarranted assumptions about the shape of the expanded
          --  tree for the call, and should be cleaned up ???