2011-08-29 Pascal Obry <obry@adacore.com>

	* exp_disp.adb: Minor comment fix.
	(Make_Disp_Asynchronous_Select_Body): Properly initialize out parameters
	to avoid warnings when compiling with -Wall.
	(Make_Disp_Conditional_Select_Body): Likewise.
	(Make_Disp_Timed_Select_Body): Likewise.

2011-08-29  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Analyze_Formal_Subprogram_Declaration): If default is
	an entity name, generate reference for it.

2011-08-29  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch5.adb (Expand_Iterator_Loop): Uniform handling of "X of S"
	iterator form.
	* sem_util.adb (Is_Iterator, Is_Reversible_Iterator): Yield True for
	the class-wide type.
	* sem_ch5.adb: Move some rewriting to the expander, where it belongs.

2011-08-29  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb (Check_Constrained_Object): Do not create an actual
	subtype for an object whose type is an unconstrained union.

2011-08-29  Ed Schonberg  <schonberg@adacore.com>

	* par-ch3.adb (P_Array_Type_Definiation, P_Component_Items): "aliased"
	is allowed in a component definition, by AI95-406.

2011-08-29  Matthew Heaney  <heaney@adacore.com>

	* a-chtgbo.adb (Generic_Iteration): Use correct overloading of Next.

2011-08-29  Hristian Kirtchev  <kirtchev@adacore.com>

	* a-except-2005.adb: Alphabetize all routines.
	(Triggered_By_Abort): New routine.
	* a-except-2005.ads (Triggered_By_Abort): New routine.
	* a-except.adb Alphabetize all routines.
	(Triggered_By_Abort): New routine.
	* a-except.ads (Triggered_By_Abort): New routine.
	* exp_ch7.adb: Update all comments involving the detection of aborts in
	finalization code.
	(Build_Object_Declarations): Do not generate code to detect the
	presence of an abort at the start of finalization code, use a runtime
	routine istead.
	* rtsfind.ads: Add RE_Triggered_By_Abort to tables RE_Id and
	RE_Unit_Table.
	* sem_res.adb (Resolve_Allocator): Emit a warning when attempting to
	allocate a task on a subpool.
	* s-stposu.adb: Add library-level flag Finalize_Address_Table_In_Use.
	The flag disables all actions related to the maintenance of
	Finalize_Address_Table when subpools are not in use.
	(Allocate_Any_Controlled): Signal the machinery that subpools are in
	use.
	(Deallocate_Any_Controlled): Do not call Delete_Finalize_Address which
	performs costly task locking when subpools are not in use.



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

1 files changed, 54 insertions, 42 deletions

diff --git a/gcc/ada/a-except-2005.adb b/gcc/ada/a-except-2005.adb
index cc2409f76ef..0196f921877 100644
--- a/gcc/ada/a-except-2005.adb
+++ b/gcc/ada/a-except-2005.adb
@@ -762,6 +762,20 @@ package body Ada.Exceptions is
    --  in case we do not want any exception tracing support. This is
    --  why this package is separated.
 
+   -----------
+   -- Image --
+   -----------
+
+   function Image (Index : Integer) return String is
+      Result : constant String := Integer'Image (Index);
+   begin
+      if Result (1) = ' ' then
+         return Result (2 .. Result'Last);
+      else
+         return Result;
+      end if;
+   end Image;
+
    -----------------------
    -- Stream Attributes --
    -----------------------
@@ -848,6 +862,22 @@ package body Ada.Exceptions is
       Raise_Current_Excep (E);
    end Raise_Exception_Always;
 
+   ------------------------------
+   -- Raise_Exception_No_Defer --
+   ------------------------------
+
+   procedure Raise_Exception_No_Defer
+     (E       : Exception_Id;
+      Message : String := "")
+   is
+   begin
+      Exception_Data.Set_Exception_Msg (E, Message);
+
+      --  Do not call Abort_Defer.all, as specified by the spec
+
+      Raise_Current_Excep (E);
+   end Raise_Exception_No_Defer;
+
    -------------------------------------
    -- Raise_From_Controlled_Operation --
    -------------------------------------
@@ -1007,20 +1037,6 @@ package body Ada.Exceptions is
       Raise_Current_Excep (E);
    end Raise_With_Msg;
 
-   -----------
-   -- Image --
-   -----------
-
-   function Image (Index : Integer) return String is
-      Result : constant String := Integer'Image (Index);
-   begin
-      if Result (1) = ' ' then
-         return Result (2 .. Result'Last);
-      else
-         return Result;
-      end if;
-   end Image;
-
    --------------------------------------
    -- Calls to Run-Time Check Routines --
    --------------------------------------
@@ -1319,18 +1335,6 @@ package body Ada.Exceptions is
       return Target;
    end Save_Occurrence;
 
-   -------------------------
-   -- Transfer_Occurrence --
-   -------------------------
-
-   procedure Transfer_Occurrence
-     (Target : Exception_Occurrence_Access;
-      Source : Exception_Occurrence)
-   is
-   begin
-      Save_Occurrence (Target.all, Source);
-   end Transfer_Occurrence;
-
    -------------------
    -- String_To_EId --
    -------------------
@@ -1345,22 +1349,6 @@ package body Ada.Exceptions is
    function String_To_EO (S : String) return Exception_Occurrence
      renames Stream_Attributes.String_To_EO;
 
-   ------------------------------
-   -- Raise_Exception_No_Defer --
-   ------------------------------
-
-   procedure Raise_Exception_No_Defer
-     (E       : Exception_Id;
-      Message : String := "")
-   is
-   begin
-      Exception_Data.Set_Exception_Msg (E, Message);
-
-      --  Do not call Abort_Defer.all, as specified by the spec
-
-      Raise_Current_Excep (E);
-   end Raise_Exception_No_Defer;
-
    ---------------
    -- To_Stderr --
    ---------------
@@ -1385,6 +1373,30 @@ package body Ada.Exceptions is
    end To_Stderr;
 
    -------------------------
+   -- Transfer_Occurrence --
+   -------------------------
+
+   procedure Transfer_Occurrence
+     (Target : Exception_Occurrence_Access;
+      Source : Exception_Occurrence)
+   is
+   begin
+      Save_Occurrence (Target.all, Source);
+   end Transfer_Occurrence;
+
+   ------------------------
+   -- Triggered_By_Abort --
+   ------------------------
+
+   function Triggered_By_Abort return Boolean is
+      Ex : constant Exception_Occurrence_Access := Get_Current_Excep.all;
+
+   begin
+      return Ex /= null
+        and then Exception_Identity (Ex.all) = Standard'Abort_Signal'Identity;
+   end Triggered_By_Abort;
+
+   -------------------------
    -- Wide_Exception_Name --
    -------------------------