2011-08-29 Robert Dewar <dewar@adacore.com>

	* a-cdlili.ads, a-coinve.ads, a-coorma.adb, a-coorma.ads, s-tassta.adb,
	a-cborma.adb, a-cborma.ads, a-cohama.ads, a-coorse.ads, a-cbhama.ads,
	a-cborse.ads, a-cobove.adb, a-cobove.ads, a-cbhase.ads: Minor
	reformatting.

2011-08-29  Tristan Gingold  <gingold@adacore.com>

	* exp_ch7.adb, exp_ch7.ads (Build_Exception_Handler): Move its spec to
	package spec.
	* exp_intr.adb (Expand_Unc_Deallocation): Use Build_Exception_Handler.
	* a-except.adb, a-except-2005.adb (Rcheck_22): Do not defer aborts
	while raising PE.



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

20 files changed, 238 insertions, 192 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 508eb877461..a9ae7fc44f3 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,20 @@
 2011-08-29  Robert Dewar  <dewar@adacore.com>
 
+	* a-cdlili.ads, a-coinve.ads, a-coorma.adb, a-coorma.ads, s-tassta.adb,
+	a-cborma.adb, a-cborma.ads, a-cohama.ads, a-coorse.ads, a-cbhama.ads,
+	a-cborse.ads, a-cobove.adb, a-cobove.ads, a-cbhase.ads: Minor
+	reformatting.
+
+2011-08-29  Tristan Gingold  <gingold@adacore.com>
+
+	* exp_ch7.adb, exp_ch7.ads (Build_Exception_Handler): Move its spec to
+	package spec.
+	* exp_intr.adb (Expand_Unc_Deallocation): Use Build_Exception_Handler.
+	* a-except.adb, a-except-2005.adb (Rcheck_22): Do not defer aborts
+	while raising PE.
+
+2011-08-29  Robert Dewar  <dewar@adacore.com>
+
 	* a-cbhama.adb, a-cbhama.ads: Minor reformatting.
 
 2011-08-29  Javier Miranda  <miranda@adacore.com>
diff --git a/gcc/ada/a-cbhama.ads b/gcc/ada/a-cbhama.ads
index 003a919a6e3..4d7cfa2225b 100644
--- a/gcc/ada/a-cbhama.ads
+++ b/gcc/ada/a-cbhama.ads
@@ -33,7 +33,7 @@
 
 private with Ada.Containers.Hash_Tables;
 
-with Ada.Streams;             use Ada.Streams;
+with Ada.Streams; use Ada.Streams;
 with Ada.Iterator_Interfaces;
 
 generic
@@ -321,11 +321,11 @@ package Ada.Containers.Bounded_Hashed_Maps is
    for Reference_Type'Read use Read;
 
    function Constant_Reference
-     (Container : Map; Key : Key_Type)    --  SHOULD BE ALIASED
-   return Constant_Reference_Type;
+     (Container : Map;
+      Key       : Key_Type)    --  SHOULD BE ALIASED???
+      return Constant_Reference_Type;
 
-   function Reference (Container : Map; Key : Key_Type)
-   return Reference_Type;
+   function Reference (Container : Map; Key : Key_Type) return Reference_Type;
 
 private
    pragma Inline (Length);
@@ -369,6 +369,12 @@ private
    type Map_Access is access all Map;
    for Map_Access'Storage_Size use 0;
 
+   --  Note: If a Cursor object has no explicit initialization expression,
+   --  it must default initialize to the same value as constant No_Element.
+   --  The Node component of type Cursor has scalar type Count_Type, so it
+   --  requires an explicit initialization expression of its own declaration,
+   --  in order for objects of record type Cursor to properly initialize.
+
    type Cursor is record
       Container : Map_Access;
       Node      : Count_Type := 0;
diff --git a/gcc/ada/a-cbhase.ads b/gcc/ada/a-cbhase.ads
index 4f3ea3107f9..711c0116963 100644
--- a/gcc/ada/a-cbhase.ads
+++ b/gcc/ada/a-cbhase.ads
@@ -429,6 +429,12 @@ private
    type Set_Access is access all Set;
    for Set_Access'Storage_Size use 0;
 
+   --  Note: If a Cursor object has no explicit initialization expression,
+   --  it must default initialize to the same value as constant No_Element.
+   --  The Node component of type Cursor has scalar type Count_Type, so it
+   --  requires an explicit initialization expression of its own declaration,
+   --  in order for objects of record type Cursor to properly initialize.
+
    type Cursor is record
       Container : Set_Access;
       Node      : Count_Type := 0;
diff --git a/gcc/ada/a-cborma.adb b/gcc/ada/a-cborma.adb
index c9a476508af..89ec1310405 100644
--- a/gcc/ada/a-cborma.adb
+++ b/gcc/ada/a-cborma.adb
@@ -46,7 +46,8 @@ package body Ada.Containers.Bounded_Ordered_Maps is
      end record;
 
    overriding function First (Object : Iterator) return Cursor;
-   overriding function Last  (Object : Iterator) return Cursor;
+
+   overriding function Last (Object : Iterator) return Cursor;
 
    overriding function Next
      (Object   : Iterator;
@@ -255,7 +256,6 @@ package body Ada.Containers.Bounded_Ordered_Maps is
 
       declare
          LN : Node_Type renames Left.Container.Nodes (Left.Node);
-
       begin
          return Right < LN.Key;
       end;
@@ -514,13 +514,12 @@ package body Ada.Containers.Bounded_Ordered_Maps is
 
    function Element (Container : Map; Key : Key_Type) return Element_Type is
       Node : constant Count_Type := Key_Ops.Find (Container, Key);
-
    begin
       if Node = 0 then
          raise Constraint_Error with "key not in map";
+      else
+         return Container.Nodes (Node).Element;
       end if;
-
-      return Container.Nodes (Node).Element;
    end Element;
 
    ---------------------
@@ -558,13 +557,12 @@ package body Ada.Containers.Bounded_Ordered_Maps is
 
    function Find (Container : Map; Key : Key_Type) return Cursor is
       Node : constant Count_Type := Key_Ops.Find (Container, Key);
-
    begin
       if Node = 0 then
          return No_Element;
+      else
+         return Cursor'(Container'Unrestricted_Access, Node);
       end if;
-
-      return Cursor'(Container'Unrestricted_Access, Node);
    end Find;
 
    -----------
@@ -575,9 +573,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is
    begin
       if Container.First = 0 then
          return No_Element;
+      else
+         return Cursor'(Container'Unrestricted_Access, Container.First);
       end if;
-
-      return Cursor'(Container'Unrestricted_Access, Container.First);
    end First;
 
    function First (Object : Iterator) return Cursor is
@@ -585,10 +583,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is
    begin
       if F = 0 then
          return No_Element;
+      else
+         return Cursor'(Object.Container.all'Unchecked_Access, F);
       end if;
-
-      return
-        Cursor'(Object.Container.all'Unchecked_Access, F);
    end First;
 
    -------------------
@@ -599,9 +596,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is
    begin
       if Container.First = 0 then
          raise Constraint_Error with "map is empty";
+      else
+         return Container.Nodes (Container.First).Element;
       end if;
-
-      return Container.Nodes (Container.First).Element;
    end First_Element;
 
    ---------------
@@ -612,9 +609,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is
    begin
       if Container.First = 0 then
          raise Constraint_Error with "map is empty";
+      else
+         return Container.Nodes (Container.First).Key;
       end if;
-
-      return Container.Nodes (Container.First).Key;
    end First_Key;
 
    -----------
@@ -623,13 +620,12 @@ package body Ada.Containers.Bounded_Ordered_Maps is
 
    function Floor (Container : Map; Key : Key_Type) return Cursor is
       Node : constant Count_Type := Key_Ops.Floor (Container, Key);
-
    begin
       if Node = 0 then
          return No_Element;
+      else
+         return Cursor'(Container'Unrestricted_Access, Node);
       end if;
-
-      return Cursor'(Container'Unrestricted_Access, Node);
    end Floor;
 
    -----------------
@@ -664,7 +660,6 @@ package body Ada.Containers.Bounded_Ordered_Maps is
 
          declare
             N : Node_Type renames Container.Nodes (Position.Node);
-
          begin
             N.Key := Key;
             N.Element := New_Item;
@@ -714,7 +709,6 @@ package body Ada.Containers.Bounded_Ordered_Maps is
 
       function New_Node return Count_Type is
          Result : Count_Type;
-
       begin
          Allocate (Container, Result);
          return Result;
@@ -778,6 +772,8 @@ package body Ada.Containers.Bounded_Ordered_Maps is
       procedure Assign (Node : in out Node_Type) is
       begin
          Node.Key := Key;
+
+         --  Why is the following commented out ???
          --  Node.Element := New_Item;
       end Assign;
 
@@ -787,7 +783,6 @@ package body Ada.Containers.Bounded_Ordered_Maps is
 
       function New_Node return Count_Type is
          Result : Count_Type;
-
       begin
          Allocate (Container, Result);
          return Result;
@@ -823,7 +818,7 @@ package body Ada.Containers.Bounded_Ordered_Maps is
       Right : Node_Type) return Boolean
    is
    begin
-      --  k > node same as node < k
+      --  Left > Right same as Right < Left
 
       return Right.Key < Left;
    end Is_Greater_Key_Node;
@@ -885,12 +880,14 @@ package body Ada.Containers.Bounded_Ordered_Maps is
      (Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'class
    is
       It : constant Iterator :=
-                      (Container'Unrestricted_Access, Container.First);
+             (Container'Unrestricted_Access, Container.First);
    begin
       return It;
    end Iterate;
 
-   function Iterate (Container : Map; Start : Cursor)
+   function Iterate
+     (Container : Map;
+      Start     : Cursor)
       return Map_Iterator_Interfaces.Reversible_Iterator'class
    is
       It : constant Iterator := (Container'Unrestricted_Access, Start.Node);
@@ -923,9 +920,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is
    begin
       if Container.Last = 0 then
          return No_Element;
+      else
+         return Cursor'(Container'Unrestricted_Access, Container.Last);
       end if;
-
-      return Cursor'(Container'Unrestricted_Access, Container.Last);
    end Last;
 
    function Last (Object : Iterator) return Cursor is
@@ -933,10 +930,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is
    begin
       if F = 0 then
          return No_Element;
+      else
+         return Cursor'(Object.Container.all'Unchecked_Access, F);
       end if;
-
-      return
-        Cursor'(Object.Container.all'Unchecked_Access, F);
    end Last;
 
    ------------------
@@ -947,9 +943,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is
    begin
       if Container.Last = 0 then
          raise Constraint_Error with "map is empty";
+      else
+         return Container.Nodes (Container.Last).Element;
       end if;
-
-      return Container.Nodes (Container.Last).Element;
    end Last_Element;
 
    --------------
@@ -960,9 +956,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is
    begin
       if Container.Last = 0 then
          raise Constraint_Error with "map is empty";
+      else
+         return Container.Nodes (Container.Last).Key;
       end if;
-
-      return Container.Nodes (Container.Last).Key;
    end Last_Key;
 
    ----------
@@ -1199,15 +1195,17 @@ package body Ada.Containers.Bounded_Ordered_Maps is
    -- Reference --
    ---------------
 
-   function Constant_Reference (Container : Map; Key : Key_Type)
-     return Constant_Reference_Type
+   function Constant_Reference
+     (Container : Map;
+      Key       : Key_Type) return Constant_Reference_Type
    is
    begin
       return (Element => Container.Element (Key)'Unrestricted_Access);
    end Constant_Reference;
 
-   function Reference (Container : Map; Key : Key_Type)
-     return Reference_Type
+   function Reference
+     (Container : Map;
+      Key       : Key_Type) return Reference_Type
    is
    begin
       return (Element => Container.Element (Key)'Unrestricted_Access);
@@ -1299,7 +1297,7 @@ package body Ada.Containers.Bounded_Ordered_Maps is
 
       B : Natural renames Container'Unrestricted_Access.all.Busy;
 
-      --  Start of processing for Reverse_Iterate
+   --  Start of processing for Reverse_Iterate
 
    begin
       B := B + 1;
diff --git a/gcc/ada/a-cborma.ads b/gcc/ada/a-cborma.ads
index c0c160b72f4..e1f9f08f379 100644
--- a/gcc/ada/a-cborma.ads
+++ b/gcc/ada/a-cborma.ads
@@ -32,6 +32,7 @@
 ------------------------------------------------------------------------------
 
 private with Ada.Containers.Red_Black_Trees;
+
 with Ada.Streams; use Ada.Streams;
 with Ada.Iterator_Interfaces;
 
@@ -48,8 +49,7 @@ package Ada.Containers.Bounded_Ordered_Maps is
 
    function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
 
-   type Map (Capacity : Count_Type) is tagged private
-   with
+   type Map (Capacity : Count_Type) is tagged private with
       constant_Indexing => Constant_Reference,
       Variable_Indexing => Reference,
       Default_Iterator  => Iterate,
@@ -63,6 +63,7 @@ package Ada.Containers.Bounded_Ordered_Maps is
    Empty_Map : constant Map;
 
    No_Element : constant Cursor;
+
    function Has_Element (Position : Cursor) return Boolean;
 
    package Map_Iterator_Interfaces is new
@@ -94,7 +95,7 @@ package Ada.Containers.Bounded_Ordered_Maps is
      (Container : in out Map;
       Position  : Cursor;
       Process   : not null access
-                   procedure (Key : Key_Type; Element : in out Element_Type));
+                    procedure (Key : Key_Type; Element : in out Element_Type));
 
    procedure Assign (Target : in out Map; Source : Map);
 
@@ -216,20 +217,22 @@ package Ada.Containers.Bounded_Ordered_Maps is
    for Reference_Type'Write use Write;
 
    function Constant_Reference
-     (Container : Map; Key : Key_Type)    --  SHOULD BE ALIASED
-   return Constant_Reference_Type;
+     (Container : Map;
+      Key       : Key_Type)    --  SHOULD BE ALIASED ???
+      return Constant_Reference_Type;
 
-   function Reference (Container : Map; Key : Key_Type)
-   return Reference_Type;
+   function Reference (Container : Map; Key : Key_Type) return Reference_Type;
 
    procedure Iterate
      (Container : Map;
       Process   : not null access procedure (Position : Cursor));
 
-   function Iterate (Container : Map)
-      return Map_Iterator_Interfaces.Forward_Iterator'class;
+   function Iterate
+     (Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'class;
 
-   function Iterate (Container : Map; Start : Cursor)
+   function Iterate
+     (Container : Map;
+      Start     : Cursor)
       return Map_Iterator_Interfaces.Reversible_Iterator'class;
 
    procedure Reverse_Iterate
diff --git a/gcc/ada/a-cborse.ads b/gcc/ada/a-cborse.ads
index 24b8bdc6e93..e56b71b4c61 100644
--- a/gcc/ada/a-cborse.ads
+++ b/gcc/ada/a-cborse.ads
@@ -255,6 +255,12 @@ private
    type Set_Access is access all Set;
    for Set_Access'Storage_Size use 0;
 
+   --  Note: If a Cursor object has no explicit initialization expression,
+   --  it must default initialize to the same value as constant No_Element.
+   --  The Node component of type Cursor has scalar type Count_Type, so it
+   --  requires an explicit initialization expression of its own declaration,
+   --  in order for objects of record type Cursor to properly initialize.
+
    type Cursor is record
       Container : Set_Access;
       Node      : Count_Type := 0;
diff --git a/gcc/ada/a-cdlili.ads b/gcc/ada/a-cdlili.ads
index f7accff0a27..d38b0d08ba3 100644
--- a/gcc/ada/a-cdlili.ads
+++ b/gcc/ada/a-cdlili.ads
@@ -33,7 +33,7 @@
 
 private with Ada.Finalization;
 
-with Ada.Streams;              use Ada.Streams;
+with Ada.Streams; use Ada.Streams;
 with Ada.Iterator_Interfaces;
 
 generic
diff --git a/gcc/ada/a-cobove.adb b/gcc/ada/a-cobove.adb
index e4b46f26012..3d46ba7cf41 100644
--- a/gcc/ada/a-cobove.adb
+++ b/gcc/ada/a-cobove.adb
@@ -28,15 +28,16 @@
 ------------------------------------------------------------------------------
 
 with Ada.Containers.Generic_Array_Sort;
+
 with System; use type System.Address;
 
 package body Ada.Containers.Bounded_Vectors is
 
    type Iterator is new
      Vector_Iterator_Interfaces.Reversible_Iterator with record
-      Container : Vector_Access;
-      Index     : Index_Type;
-   end record;
+        Container : Vector_Access;
+        Index     : Index_Type;
+     end record;
 
    overriding function First (Object : Iterator) return Cursor;
    overriding function Last  (Object : Iterator) return Cursor;
@@ -643,18 +644,18 @@ package body Ada.Containers.Bounded_Vectors is
    begin
       if Index > Container.Last then
          raise Constraint_Error with "Index is out of range";
+      else
+         return Container.Elements (To_Array_Index (Index));
       end if;
-
-      return Container.Elements (To_Array_Index (Index));
    end Element;
 
    function Element (Position : Cursor) return Element_Type is
    begin
       if Position.Container = null then
          raise Constraint_Error with "Position cursor has no element";
+      else
+         return Position.Container.Element (Position.Index);
       end if;
-
-      return Position.Container.Element (Position.Index);
    end Element;
 
    ----------
@@ -713,18 +714,18 @@ package body Ada.Containers.Bounded_Vectors is
    begin
       if Is_Empty (Container) then
          return No_Element;
+      else
+         return (Container'Unrestricted_Access, Index_Type'First);
       end if;
-
-      return (Container'Unrestricted_Access, Index_Type'First);
    end First;
 
    function First (Object : Iterator) return Cursor is
    begin
       if Is_Empty (Object.Container.all) then
          return No_Element;
+      else
+         return  Cursor'(Object.Container, Index_Type'First);
       end if;
-
-      return  Cursor'(Object.Container, Index_Type'First);
    end First;
 
    -------------------
@@ -735,9 +736,9 @@ package body Ada.Containers.Bounded_Vectors is
    begin
       if Container.Last = No_Index then
          raise Constraint_Error with "Container is empty";
+      else
+         return Container.Elements (To_Array_Index (Index_Type'First));
       end if;
-
-      return Container.Elements (To_Array_Index (Index_Type'First));
    end First_Element;
 
    -----------------
@@ -1615,14 +1616,17 @@ package body Ada.Containers.Bounded_Vectors is
       B := B - 1;
    end Iterate;
 
-   function Iterate (Container : Vector)
+   function Iterate
+     (Container : Vector)
       return Vector_Iterator_Interfaces.Reversible_Iterator'Class
    is
    begin
       return Iterator'(Container'Unrestricted_Access, Index_Type'First);
    end Iterate;
 
-   function Iterate (Container : Vector; Start : Cursor)
+   function Iterate
+     (Container : Vector;
+      Start     : Cursor)
       return Vector_Iterator_Interfaces.Reversible_Iterator'class
    is
    begin
@@ -1637,18 +1641,18 @@ package body Ada.Containers.Bounded_Vectors is
    begin
       if Is_Empty (Container) then
          return No_Element;
+      else
+         return (Container'Unrestricted_Access, Container.Last);
       end if;
-
-      return (Container'Unrestricted_Access, Container.Last);
    end Last;
 
    function Last (Object : Iterator) return Cursor is
    begin
       if Is_Empty (Object.Container.all) then
          return No_Element;
+      else
+         return Cursor'(Object.Container, Object.Container.Last);
       end if;
-
-      return Cursor'(Object.Container, Object.Container.Last);
    end Last;
 
    ------------------
@@ -1659,9 +1663,9 @@ package body Ada.Containers.Bounded_Vectors is
    begin
       if Container.Last = No_Index then
          raise Constraint_Error with "Container is empty";
+      else
+         return Container.Elements (Container.Length);
       end if;
-
-      return Container.Elements (Container.Length);
    end Last_Element;
 
    ----------------
@@ -1972,7 +1976,7 @@ package body Ada.Containers.Bounded_Vectors is
       end if;
 
       return (Element =>
-        Container.Elements (To_Array_Index (Position))'Access);
+                Container.Elements (To_Array_Index (Position))'Access);
    end Constant_Reference;
 
    function Reference (Container : Vector; Position : Cursor)
@@ -1990,7 +1994,7 @@ package body Ada.Containers.Bounded_Vectors is
 
       return
         (Element =>
-            Position.Container.Elements
+           Position.Container.Elements
              (To_Array_Index (Position.Index))'Access);
    end Reference;
 
@@ -1999,10 +2003,10 @@ package body Ada.Containers.Bounded_Vectors is
    begin
       if Position > Container.Last then
          raise Constraint_Error with "Index is out of range";
+      else
+         return (Element =>
+           Container.Elements (To_Array_Index (Position))'Unrestricted_Access);
       end if;
-
-      return (Element =>
-        Container.Elements (To_Array_Index (Position))'Unrestricted_Access);
    end Reference;
 
    ---------------------
@@ -2274,7 +2278,7 @@ package body Ada.Containers.Bounded_Vectors is
       --    Index >= Index_Type'First
       --  hence we also know that
       --    Index - Index_Type'First >= 0
-      --
+
       --  The issue is that even though 0 is guaranteed to be a value
       --  in the type Index_Type'Base, there's no guarantee that the
       --  difference is a value in that type. To prevent overflow we
@@ -2377,6 +2381,7 @@ package body Ada.Containers.Bounded_Vectors is
          end if;
 
       elsif Index_Type'First <= 0 then
+
          --  Here we can compute Last directly, in the normal way. We know that
          --  No_Index is less than 0, so there is no danger of overflow when
          --  adding the (positive) value of Length.
@@ -2436,6 +2441,7 @@ package body Ada.Containers.Bounded_Vectors is
       --  create a Last index value greater than Index_Type'Last.
 
       if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
+
          --  We perform a two-part test. First we determine whether the
          --  computed Last value lies in the base range of the type, and then
          --  determine whether it lies in the range of the index (sub)type.
@@ -2464,6 +2470,7 @@ package body Ada.Containers.Bounded_Vectors is
          end if;
 
       elsif Index_Type'First <= 0 then
+
          --  Here we can compute Last directly, in the normal way. We know that
          --  No_Index is less than 0, so there is no danger of overflow when
          --  adding the (positive) value of Length.
diff --git a/gcc/ada/a-cobove.ads b/gcc/ada/a-cobove.ads
index 42c8d21ac79..7c009c0352c 100644
--- a/gcc/ada/a-cobove.ads
+++ b/gcc/ada/a-cobove.ads
@@ -50,8 +50,7 @@ package Ada.Containers.Bounded_Vectors is
 
    No_Index : constant Extended_Index := Extended_Index'First;
 
-   type Vector (Capacity : Count_Type) is tagged private
-   with
+   type Vector (Capacity : Count_Type) is tagged private with
       Constant_Indexing => Constant_Reference,
       Variable_Indexing => Reference,
       Default_Iterator  => Iterate,
@@ -300,10 +299,13 @@ package Ada.Containers.Bounded_Vectors is
      (Container : Vector;
       Process   : not null access procedure (Position : Cursor));
 
-   function Iterate (Container : Vector)
+   function Iterate
+     (Container : Vector)
       return Vector_Iterator_Interfaces.Reversible_Iterator'Class;
 
-   function Iterate (Container : Vector; Start : Cursor)
+   function Iterate
+     (Container : Vector;
+      Start     : Cursor)
       return Vector_Iterator_Interfaces.Reversible_Iterator'class;
 
    type Constant_Reference_Type
diff --git a/gcc/ada/a-cohama.ads b/gcc/ada/a-cohama.ads
index d0bd3fdbbf2..0d614bd4f8f 100644
--- a/gcc/ada/a-cohama.ads
+++ b/gcc/ada/a-cohama.ads
@@ -34,7 +34,7 @@
 private with Ada.Containers.Hash_Tables;
 private with Ada.Finalization;
 
-with Ada.Streams;             use Ada.Streams;
+with Ada.Streams; use Ada.Streams;
 with Ada.Iterator_Interfaces;
 
 generic
diff --git a/gcc/ada/a-coinve.ads b/gcc/ada/a-coinve.ads
index 2380b425309..a13003819b0 100644
--- a/gcc/ada/a-coinve.ads
+++ b/gcc/ada/a-coinve.ads
@@ -33,7 +33,7 @@
 
 private with Ada.Finalization;
 
-with Ada.Streams;             use Ada.Streams;
+with Ada.Streams; use Ada.Streams;
 with Ada.Iterator_Interfaces;
 
 generic
diff --git a/gcc/ada/a-coorma.adb b/gcc/ada/a-coorma.adb
index e5f46c97626..c1ae68297b3 100644
--- a/gcc/ada/a-coorma.adb
+++ b/gcc/ada/a-coorma.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, 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- --
@@ -44,7 +44,8 @@ package body Ada.Containers.Ordered_Maps is
      end record;
 
    overriding function First (Object : Iterator) return Cursor;
-   overriding function Last  (Object : Iterator) return Cursor;
+
+   overriding function Last (Object : Iterator) return Cursor;
 
    overriding function Next
      (Object   : Iterator;
@@ -266,8 +267,7 @@ package body Ada.Containers.Ordered_Maps is
    -- Clear --
    -----------
 
-   procedure Clear is
-      new Tree_Operations.Generic_Clear (Delete_Tree);
+   procedure Clear is new Tree_Operations.Generic_Clear (Delete_Tree);
 
    procedure Clear (Container : in out Map) is
    begin
@@ -283,6 +283,18 @@ package body Ada.Containers.Ordered_Maps is
       return Node.Color;
    end Color;
 
+   ------------------------
+   -- Constant_Reference --
+   ------------------------
+
+   function Constant_Reference
+     (Container : Map;
+      Key       : Key_Type) return Constant_Reference_Type
+   is
+   begin
+      return (Element => Container.Element (Key)'Unrestricted_Access);
+   end Constant_Reference;
+
    --------------
    -- Contains --
    --------------
@@ -453,25 +465,23 @@ package body Ada.Containers.Ordered_Maps is
 
    function First (Container : Map) return Cursor is
       T : Tree_Type renames Container.Tree;
-
    begin
       if T.First = null then
          return No_Element;
+      else
+         return Cursor'(Container'Unrestricted_Access, T.First);
       end if;
-
-      return Cursor'(Container'Unrestricted_Access, T.First);
    end First;
 
    function First (Object : Iterator) return Cursor is
       M : constant Map_Access  := Object.Container;
       N : constant Node_Access := M.Tree.First;
-
    begin
       if N = null then
          return No_Element;
+      else
+         return Cursor'(Object.Container.all'Unchecked_Access, N);
       end if;
-
-      return Cursor'(Object.Container.all'Unchecked_Access, N);
    end First;
 
    -------------------
@@ -484,9 +494,9 @@ package body Ada.Containers.Ordered_Maps is
    begin
       if T.First = null then
          raise Constraint_Error with "map is empty";
+      else
+         return T.First.Element;
       end if;
-
-      return T.First.Element;
    end First_Element;
 
    ---------------
@@ -495,13 +505,12 @@ package body Ada.Containers.Ordered_Maps is
 
    function First_Key (Container : Map) return Key_Type is
       T : Tree_Type renames Container.Tree;
-
    begin
       if T.First = null then
          raise Constraint_Error with "map is empty";
+      else
+         return T.First.Key;
       end if;
-
-      return T.First.Key;
    end First_Key;
 
    -----------
@@ -510,13 +519,12 @@ package body Ada.Containers.Ordered_Maps is
 
    function Floor (Container : Map; Key : Key_Type) return Cursor is
       Node : constant Node_Access := Key_Ops.Floor (Container.Tree, Key);
-
    begin
       if Node = null then
          return No_Element;
+      else
+         return Cursor'(Container'Unrestricted_Access, Node);
       end if;
-
-      return Cursor'(Container'Unrestricted_Access, Node);
    end Floor;
 
    ----------
@@ -693,7 +701,8 @@ package body Ada.Containers.Ordered_Maps is
    ------------------------
 
    function Is_Equal_Node_Node
-     (L, R : Node_Access) return Boolean is
+     (L, R : Node_Access) return Boolean
+   is
    begin
       if L.Key < R.Key then
          return False;
@@ -715,7 +724,7 @@ package body Ada.Containers.Ordered_Maps is
       Right : Node_Access) return Boolean
    is
    begin
-      --  k > node same as node < k
+      --  Left > Right same as Right < Left
 
       return Right.Key < Left;
    end Is_Greater_Key_Node;
@@ -814,25 +823,23 @@ package body Ada.Containers.Ordered_Maps is
 
    function Last (Container : Map) return Cursor is
       T : Tree_Type renames Container.Tree;
-
    begin
       if T.Last = null then
          return No_Element;
+      else
+         return Cursor'(Container'Unrestricted_Access, T.Last);
       end if;
-
-      return Cursor'(Container'Unrestricted_Access, T.Last);
    end Last;
 
    function Last (Object : Iterator) return Cursor is
       M : constant Map_Access  := Object.Container;
       N : constant Node_Access := M.Tree.Last;
-
    begin
       if N = null then
          return No_Element;
+      else
+         return Cursor'(Object.Container.all'Unchecked_Access, N);
       end if;
-
-      return Cursor'(Object.Container.all'Unchecked_Access, N);
    end Last;
 
    ------------------
@@ -841,13 +848,12 @@ package body Ada.Containers.Ordered_Maps is
 
    function Last_Element (Container : Map) return Element_Type is
       T : Tree_Type renames Container.Tree;
-
    begin
       if T.Last = null then
          raise Constraint_Error with "map is empty";
+      else
+         return T.Last.Element;
       end if;
-
-      return T.Last.Element;
    end Last_Element;
 
    --------------
@@ -856,13 +862,12 @@ package body Ada.Containers.Ordered_Maps is
 
    function Last_Key (Container : Map) return Key_Type is
       T : Tree_Type renames Container.Tree;
-
    begin
       if T.Last = null then
          raise Constraint_Error with "map is empty";
+      else
+         return T.Last.Key;
       end if;
-
-      return T.Last.Key;
    end Last_Key;
 
    ----------
@@ -1102,14 +1107,11 @@ package body Ada.Containers.Ordered_Maps is
    -- Reference --
    ---------------
 
-   function Constant_Reference (Container : Map; Key : Key_Type)
-   return Constant_Reference_Type is
-   begin
-      return (Element => Container.Element (Key)'Unrestricted_Access);
-   end Constant_Reference;
-
-   function Reference (Container : Map; Key : Key_Type)
-   return Reference_Type is
+   function Reference
+     (Container : Map;
+      Key       : Key_Type)
+      return Reference_Type
+   is
    begin
       return (Element => Container.Element (Key)'Unrestricted_Access);
    end Reference;
@@ -1195,7 +1197,7 @@ package body Ada.Containers.Ordered_Maps is
 
       B : Natural renames Container.Tree'Unrestricted_Access.all.Busy;
 
-      --  Start of processing for Reverse_Iterate
+   --  Start of processing for Reverse_Iterate
 
    begin
       B := B + 1;
diff --git a/gcc/ada/a-coorma.ads b/gcc/ada/a-coorma.ads
index 04fe1cf05c3..1beea7bbff5 100644
--- a/gcc/ada/a-coorma.ads
+++ b/gcc/ada/a-coorma.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -33,6 +33,7 @@
 
 private with Ada.Containers.Red_Black_Trees;
 private with Ada.Finalization;
+
 with Ada.Streams; use Ada.Streams;
 with Ada.Iterator_Interfaces;
 
@@ -49,8 +50,7 @@ package Ada.Containers.Ordered_Maps is
 
    function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
 
-   type Map is tagged private
-   with
+   type Map is tagged private with
       constant_Indexing => Constant_Reference,
       Variable_Indexing => Reference,
       Default_Iterator  => Iterate,
@@ -62,6 +62,7 @@ package Ada.Containers.Ordered_Maps is
    Empty_Map : constant Map;
 
    No_Element : constant Cursor;
+
    function Has_Element (Position : Cursor) return Boolean;
 
    package Map_Iterator_Interfaces is new
@@ -211,8 +212,9 @@ package Ada.Containers.Ordered_Maps is
    for Reference_Type'Write use Write;
 
    function Constant_Reference
-     (Container : Map; Key : Key_Type)    --  SHOULD BE ALIASED
-   return Constant_Reference_Type;
+     (Container : Map;
+      Key       : Key_Type)    --  SHOULD BE ALIASED???
+      return Constant_Reference_Type;
 
    function Reference (Container : Map; Key : Key_Type)
    return Reference_Type;
@@ -221,10 +223,13 @@ package Ada.Containers.Ordered_Maps is
      (Container : Map;
       Process   : not null access procedure (Position : Cursor));
 
-   function Iterate (Container : Map)
+   function Iterate
+     (Container : Map)
       return Map_Iterator_Interfaces.Forward_Iterator'class;
 
-   function Iterate (Container : Map; Start : Cursor)
+   function Iterate
+     (Container : Map;
+      Start     : Cursor)
       return Map_Iterator_Interfaces.Reversible_Iterator'class;
 
    procedure Reverse_Iterate
diff --git a/gcc/ada/a-coorse.ads b/gcc/ada/a-coorse.ads
index 8dc0eda123d..21eb7197779 100644
--- a/gcc/ada/a-coorse.ads
+++ b/gcc/ada/a-coorse.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -34,7 +34,7 @@
 private with Ada.Containers.Red_Black_Trees;
 private with Ada.Finalization;
 
-with Ada.Streams;             use Ada.Streams;
+with Ada.Streams; use Ada.Streams;
 with Ada.Iterator_Interfaces;
 
 generic
diff --git a/gcc/ada/a-except-2005.adb b/gcc/ada/a-except-2005.adb
index 0196f921877..8315a9d23f8 100644
--- a/gcc/ada/a-except-2005.adb
+++ b/gcc/ada/a-except-2005.adb
@@ -1152,8 +1152,16 @@ package body Ada.Exceptions is
    end Rcheck_21;
 
    procedure Rcheck_22 (File : System.Address; Line : Integer) is
+      E : constant Exception_Id := Program_Error_Def'Access;
    begin
-      Raise_Program_Error_Msg (File, Line, Rmsg_22'Address);
+      --  This is "finalize/adjust raised exception".
+      --  As this exception is only raised with aborts defered, it must
+      --  call Raise_Exception_No_Defer, contrary to all other Rcheck
+      --  subprograms (which defer aborts).
+      --  This is coherent with Raise_From_Controlled_Operation.
+
+      Exception_Data.Set_Exception_C_Msg (E, File, Line, 0, Rmsg_22'Address);
+      Raise_Current_Excep (E);
    end Rcheck_22;
 
    procedure Rcheck_23 (File : System.Address; Line : Integer) is
diff --git a/gcc/ada/a-except.adb b/gcc/ada/a-except.adb
index 333dca54a28..6805bf40169 100644
--- a/gcc/ada/a-except.adb
+++ b/gcc/ada/a-except.adb
@@ -1083,8 +1083,16 @@ package body Ada.Exceptions is
    end Rcheck_21;
 
    procedure Rcheck_22 (File : System.Address; Line : Integer) is
+      E : constant Exception_Id := Program_Error_Def'Access;
    begin
-      Raise_Program_Error_Msg (File, Line, Rmsg_22'Address);
+      --  This is "finalize/adjust raised exception".
+      --  As this exception is only raised with aborts defered, it must
+      --  call Raise_Exception_No_Defer, contrary to all other Rcheck
+      --  subprograms (which defer aborts).
+      --  This is coherent with Raise_From_Controlled_Operation.
+
+      Exception_Data.Set_Exception_C_Msg (E, File, Line, 0, Rmsg_22'Address);
+      Raise_Current_Excep (E);
    end Rcheck_22;
 
    procedure Rcheck_23 (File : System.Address; Line : Integer) is
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 24b3e16eb70..730ac6b86dc 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -301,33 +301,6 @@ package body Exp_Ch7 is
    --  context does not contain the above constructs, the routine returns an
    --  empty list.
 
-   function Build_Exception_Handler
-     (Loc         : Source_Ptr;
-      E_Id        : Entity_Id;
-      Raised_Id   : Entity_Id;
-      For_Library : Boolean := False) return Node_Id;
-   --  Subsidiary to Build_Finalizer, Make_Deep_Array_Body and Make_Deep_Record
-   --  _Body. Create an exception handler of the following form:
-   --
-   --    when others =>
-   --       if not Raised_Id then
-   --          Raised_Id := True;
-   --          Save_Occurrence (E_Id, Get_Current_Excep.all.all);
-   --       end if;
-   --
-   --  If flag For_Library is set (and not in restricted profile):
-   --
-   --    when others =>
-   --       if not Raised_Id then
-   --          Raised_Id := True;
-   --          Save_Library_Occurrence (Get_Current_Excep.all.all);
-   --       end if;
-   --
-   --  E_Id denotes the defining identifier of a local exception occurrence.
-   --  Raised_Id is the entity of a local boolean flag. Flag For_Library is
-   --  used when operating at the library level, when enabled the current
-   --  exception will be saved to a global location.
-
    procedure Build_Finalizer
      (N           : Node_Id;
       Clean_Stmts : List_Id;
diff --git a/gcc/ada/exp_ch7.ads b/gcc/ada/exp_ch7.ads
index 1774f69ed78..dbebd8ae52a 100644
--- a/gcc/ada/exp_ch7.ads
+++ b/gcc/ada/exp_ch7.ads
@@ -40,6 +40,33 @@ package Exp_Ch7 is
    --  Create the procedures Deep_Initialize, Deep_Adjust and Deep_Finalize
    --  that take care of finalization management at run-time.
 
+   function Build_Exception_Handler
+     (Loc         : Source_Ptr;
+      E_Id        : Entity_Id;
+      Raised_Id   : Entity_Id;
+      For_Library : Boolean := False) return Node_Id;
+   --  Subsidiary to Build_Finalizer, Make_Deep_Array_Body and Make_Deep_Record
+   --  _Body. Create an exception handler of the following form:
+   --
+   --    when others =>
+   --       if not Raised_Id then
+   --          Raised_Id := True;
+   --          Save_Occurrence (E_Id, Get_Current_Excep.all.all);
+   --       end if;
+   --
+   --  If flag For_Library is set (and not in restricted profile):
+   --
+   --    when others =>
+   --       if not Raised_Id then
+   --          Raised_Id := True;
+   --          Save_Library_Occurrence (Get_Current_Excep.all.all);
+   --       end if;
+   --
+   --  E_Id denotes the defining identifier of a local exception occurrence.
+   --  Raised_Id is the entity of a local boolean flag. Flag For_Library is
+   --  used when operating at the library level, when enabled the current
+   --  exception will be saved to a global location.
+
    procedure Build_Finalization_Master
      (Typ        : Entity_Id;
       Ins_Node   : Node_Id := Empty;
diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb
index 7ce12d61b8a..07035478bff 100644
--- a/gcc/ada/exp_intr.adb
+++ b/gcc/ada/exp_intr.adb
@@ -974,29 +974,7 @@ package body Exp_Intr is
                      Obj_Ref => Deref,
                      Typ     => Desig_T)),
                  Exception_Handlers => New_List (
-                   Make_Exception_Handler (Loc,
-                     Exception_Choices => New_List (
-                       Make_Others_Choice (Loc)),
-                     Statements => New_List (
-                       Make_Assignment_Statement (Loc,
-                         Name =>
-                           New_Reference_To (Raised_Id, Loc),
-                         Expression =>
-                           New_Reference_To (Standard_True, Loc)),
-                       Make_Procedure_Call_Statement (Loc,
-                         Name =>
-                           New_Reference_To (RTE (RE_Save_Occurrence), Loc),
-                         Parameter_Associations => New_List (
-                           New_Reference_To (E_Id, Loc),
-                           Make_Explicit_Dereference (Loc,
-                             Prefix =>
-                               Make_Function_Call (Loc,
-                                 Name =>
-                                   Make_Explicit_Dereference (Loc,
-                                     Prefix =>
-                                       New_Reference_To
-                                         (RTE (RE_Get_Current_Excep),
-                                          Loc))))))))))));
+                   Build_Exception_Handler (Loc, E_Id, Raised_Id)))));
 
          --  For .NET/JVM, detach the object from the containing finalization
          --  collection before finalizing it.
diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb
index 88b43ed35ac..61f0c16c63e 100644
--- a/gcc/ada/s-tassta.adb
+++ b/gcc/ada/s-tassta.adb
@@ -1328,8 +1328,10 @@ package body System.Tasking.Stages is
             TH.all (Cause, Self_ID, EO);
 
          exception
+
+            --  RM-C.7.3 requires all exceptions raised here to be ignored
+
             when others =>
-               --  RM-C.7.3 requires these exceptions to be ignored
                null;
          end;
       end if;