2012-05-15 Hristian Kirtchev <kirtchev@adacore.com>

	* exp_ch9.adb (Expand_N_Asynchronous_Select): Extract the statements
	of the abortable part and triggering alternative after being processed
	for controlled objects.
	(Expand_N_Timed_Entry_Call): Code and comment reformatting.

2012-05-15  Robert Dewar  <dewar@adacore.com>

	* sem_util.adb: Minor code reorganization.



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

6 files changed, 64 insertions, 44 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index f18c54d3b4d..43cf64ed434 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,14 @@
+2012-05-15  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch9.adb (Expand_N_Asynchronous_Select): Extract the statements
+	of the abortable part and triggering alternative after being processed
+	for controlled objects.
+	(Expand_N_Timed_Entry_Call): Code and comment reformatting.
+
+2012-05-15  Robert Dewar  <dewar@adacore.com>
+
+	* sem_util.adb: Minor code reorganization.
+
 2012-05-15  Robert Dewar  <dewar@adacore.com>
 
 	* exp_ch7.adb, exp_ch11.adb, exp_ch11.ads: Minor reformatting.
diff --git a/gcc/ada/a-exextr.adb b/gcc/ada/a-exextr.adb
index 55ff74d4195..b6ba237840f 100644
--- a/gcc/ada/a-exextr.adb
+++ b/gcc/ada/a-exextr.adb
@@ -162,6 +162,9 @@ package body Exception_Traces is
    -----------------------------------
 
    procedure Unhandled_Exception_Terminate is
+
+      --  Comments needed on why we do things this way ??? (see RH)
+
       Excep : Exception_Occurrence;
       --  This occurrence will be used to display a message after finalization.
       --  It is necessary to save a copy here, or else the designated value
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 47eea187921..e0ea3219cff 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -6595,15 +6595,14 @@ package body Exp_Ch9 is
    --  see Expand_N_Entry_Call_Statement.
 
    procedure Expand_N_Asynchronous_Select (N : Node_Id) is
-      Loc    : constant Source_Ptr := Sloc (N);
-      Abrt   : constant Node_Id    := Abortable_Part (N);
-      Astats : constant List_Id    := Statements (Abrt);
-      Trig   : constant Node_Id    := Triggering_Alternative (N);
-      Tstats : constant List_Id    := Statements (Trig);
+      Loc  : constant Source_Ptr := Sloc (N);
+      Abrt : constant Node_Id    := Abortable_Part (N);
+      Trig : constant Node_Id    := Triggering_Alternative (N);
 
       Abort_Block_Ent   : Entity_Id;
       Abortable_Block   : Node_Id;
       Actuals           : List_Id;
+      Astats            : List_Id;
       Blk_Ent           : Entity_Id;
       Blk_Typ           : Entity_Id;
       Call              : Node_Id;
@@ -6635,6 +6634,7 @@ package body Exp_Ch9 is
       Stmt              : Node_Id;
       Stmts             : List_Id;
       TaskE_Stmts       : List_Id;
+      Tstats            : List_Id;
 
       B   : Entity_Id;  --  Call status flag
       Bnn : Entity_Id;  --  Communication block
@@ -6648,6 +6648,12 @@ package body Exp_Ch9 is
       Process_Statements_For_Controlled_Objects (Trig);
       Process_Statements_For_Controlled_Objects (Abrt);
 
+      --  Retrieve Astats and Tstats now because the finalization machinery may
+      --  wrap them in blocks.
+
+      Astats := Statements (Abrt);
+      Tstats := Statements (Trig);
+
       Blk_Ent := Make_Temporary (Loc, 'A');
       Ecall   := Triggering_Statement (Trig);
 
@@ -11881,13 +11887,6 @@ package body Exp_Ch9 is
    procedure Expand_N_Timed_Entry_Call (N : Node_Id) is
       Loc : constant Source_Ptr := Sloc (N);
 
-      E_Call  : Node_Id :=
-                  Entry_Call_Statement (Entry_Call_Alternative (N));
-      E_Stats : List_Id;  --  statements after entry call
-      D_Stat  : Node_Id :=
-                  Delay_Statement (Delay_Alternative (N));
-      D_Stats : List_Id;  --  statements after "delay ..."
-
       Actuals        : List_Id;
       Blk_Typ        : Entity_Id;
       Call           : Node_Id;
@@ -11896,9 +11895,13 @@ package body Exp_Ch9 is
       Concval        : Node_Id;
       D_Conv         : Node_Id;
       D_Disc         : Node_Id;
+      D_Stat         : Node_Id;
+      D_Stats        : List_Id;
       D_Type         : Entity_Id;
       Decls          : List_Id;
       Dummy          : Node_Id;
+      E_Call         : Node_Id;
+      E_Stats        : List_Id;
       Ename          : Node_Id;
       Formals        : List_Id;
       Index          : Node_Id;
@@ -11928,11 +11931,14 @@ package body Exp_Ch9 is
          return;
       end if;
 
+      E_Call := Entry_Call_Statement (Entry_Call_Alternative (N));
+      D_Stat := Delay_Statement (Delay_Alternative (N));
+
       Process_Statements_For_Controlled_Objects (Entry_Call_Alternative (N));
       Process_Statements_For_Controlled_Objects (Delay_Alternative (N));
 
-      --  Must fetch E_Stats/D_Stats after above "Process_...", because it
-      --  might modify them.
+      --  Retrieve E_Stats and D_Stats now because the finalization machinery
+      --  may wrap them in blocks.
 
       E_Stats := Statements (Entry_Call_Alternative (N));
       D_Stats := Statements (Delay_Alternative (N));
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index d079f47fad6..747636d69c1 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -2509,9 +2509,9 @@ package body Sem_Ch6 is
       --  Previously we scanned the body to look for nested subprograms, and
       --  rejected an inline directive if nested subprograms were present,
       --  because the back-end would generate conflicting symbols for the
-      --  nested bodies.  This is now unecessary.
+      --  nested bodies. This is now unnecessary.
 
-      --  Look ahead to recognize a pragma inline that appears after the body
+      --  Look ahead to recognize a pragma Inline that appears after the body
 
       Check_Inline_Pragma (Spec_Id);
 
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 18c57312b2c..21e16ac1245 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -3039,11 +3039,33 @@ package body Sem_Util is
         and then Is_Entity_Name (Renamed_Object (Id))
       then
          return Effective_Extra_Accessibility (Entity (Renamed_Object (Id)));
+      else
+         return Extra_Accessibility (Id);
       end if;
-
-      return Extra_Accessibility (Id);
    end Effective_Extra_Accessibility;
 
+   ------------------------------
+   -- Enclosing_Comp_Unit_Node --
+   ------------------------------
+
+   function Enclosing_Comp_Unit_Node (N : Node_Id) return Node_Id is
+      Current_Node : Node_Id;
+
+   begin
+      Current_Node := N;
+      while Present (Current_Node)
+        and then Nkind (Current_Node) /= N_Compilation_Unit
+      loop
+         Current_Node := Parent (Current_Node);
+      end loop;
+
+      if Nkind (Current_Node) /= N_Compilation_Unit then
+         return Empty;
+      else
+         return Current_Node;
+      end if;
+   end Enclosing_Comp_Unit_Node;
+
    --------------------------
    -- Enclosing_CPP_Parent --
    --------------------------
@@ -3165,28 +3187,6 @@ package body Sem_Util is
       return Unit_Entity;
    end Enclosing_Lib_Unit_Entity;
 
-   ------------------------------
-   -- Enclosing_Comp_Unit_Node --
-   ------------------------------
-
-   function Enclosing_Comp_Unit_Node (N : Node_Id) return Node_Id is
-      Current_Node : Node_Id;
-
-   begin
-      Current_Node := N;
-      while Present (Current_Node)
-        and then Nkind (Current_Node) /= N_Compilation_Unit
-      loop
-         Current_Node := Parent (Current_Node);
-      end loop;
-
-      if Nkind (Current_Node) /= N_Compilation_Unit then
-         return Empty;
-      end if;
-
-      return Current_Node;
-   end Enclosing_Comp_Unit_Node;
-
    -----------------------
    -- Enclosing_Package --
    -----------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 0c4643d1e4b..73998a952ec 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -368,6 +368,10 @@ package Sem_Util is
    --  Same as Einfo.Extra_Accessibility except thtat object renames
    --  are looked through.
 
+   function Enclosing_Comp_Unit_Node (N : Node_Id) return Node_Id;
+   --  Returns the enclosing N_Compilation_Unit Node that is the root of a
+   --  subtree containing N.
+
    function Enclosing_CPP_Parent (Typ : Entity_Id) return Entity_Id;
    --  Returns the closest ancestor of Typ that is a CPP type.
 
@@ -386,10 +390,6 @@ package Sem_Util is
    --  root of the current scope (which must not be Standard_Standard, and the
    --  caller is responsible for ensuring this condition).
 
-   function Enclosing_Comp_Unit_Node (N : Node_Id) return Node_Id;
-   --  Returns the enclosing N_Compilation_Unit Node that is the root of a
-   --  subtree containing N.
-
    function Enclosing_Package (E : Entity_Id) return Entity_Id;
    --  Utility function to return the Ada entity of the package enclosing
    --  the entity E, if any. Returns Empty if no enclosing package.