[multiple changes]

2014-07-30  Ed Schonberg  <schonberg@adacore.com>

	* a-chtgop.ads, a-chtgop.adb (Delete_Node_At_Index): New
	subprogram, used by all versions of hashed sets, to delete a node
	whose element has been improperly updated through a Reference_
	Preserving key.
	* a-cohase.adb: Remove Delete_Node, use new common procedure
	Delete_Node_At_Index.
	* a-cihase.ads: Add Reference_Control_Type to package Generic_Keys.
	* a-cihase.adb: Add Adjust and Finalize routines for
	Reference_Control_Type.
	(Reference_Preserving_Key): Build aggregate for
	Reference_Control_Type

2014-07-30  Yannick Moy  <moy@adacore.com>

	* checks.adb, checks.ads (Determine_Range_R): New procedure to
	determine the possible range of a floating-point expression.

2014-07-30  Ed Schonberg  <schonberg@adacore.com>

	* a-cborse.ads: Add Reference_Control_Type to package Generic_Keys.
	* a-cborse.adb: Add Adjust and Finalize routines for
	Reference_Control_Type.
	(Reference_Preserving_Key): Build aggregate for
	Reference_Control_Type.
	(Delete): Check for tampering, and raise Program_Error (not
	Constraint_Error) when attempting to delete an element not in
	the set.
	(Insert): Ditto.

2014-07-30  Bob Duff  <duff@adacore.com>

	* a-elchha.adb, a-except-2005.adb, a-except.adb, a-exexda.adb,
	* a-exextr.adb, a-exstat.adb, exp_intr.ads, s-tassta.adb:
	Exception_Information is used to produce useful debugging
	information for the programmer. However, it was also used to
	implement the stream attributes for type Exception_Occurrence. The
	latter requires a stable and portable interface, which meant
	that we couldn't include a symbolic traceback. A separate set of
	routines was used to provide symbolic tracebacks under program
	control (i.e. not automatically). The goal of this ticket is
	to provide such automatic tracebacks, so the change here is to
	split the two functionalities: Exception_Information gives the
	maximally useful information for debugging (i.e. it now includes
	a symbolic traceback when a decorator is set, and it can be
	improved freely in the future without disturbing streaming).
	Untailored_Exception_Information always uses hexadecimal addresses
	in the traceback, has a stable and portable output, and is now
	used for streaming.

2014-07-30  Eric Botcazou  <ebotcazou@adacore.com>

	* exp_aggr.adb (Expand_Array_Aggregate): Add missing test
	on the target of the assignment to find out whether it
	can be directly done by the back-end.
	* exp_util.adb (Is_Possibly_Unaligned_Slice): Remove obscure test.

From-SVN: r213279

gcc/ada/ChangeLog

+2014-07-30  Ed Schonberg  <schonberg@adacore.com>
+
+	* a-chtgop.ads, a-chtgop.adb (Delete_Node_At_Index): New
+	subprogram, used by all versions of hashed sets, to delete a node
+	whose element has been improperly updated through a Reference_
+	Preserving key.
+	* a-cohase.adb: Remove Delete_Node, use new common procedure
+	Delete_Node_At_Index.
+	* a-cihase.ads: Add Reference_Control_Type to package Generic_Keys.
+	* a-cihase.adb: Add Adjust and Finalize routines for
+	Reference_Control_Type.
+	(Reference_Preserving_Key): Build aggregate for
+	Reference_Control_Type
+
+2014-07-30  Yannick Moy  <moy@adacore.com>
+
+	* checks.adb, checks.ads (Determine_Range_R): New procedure to
+	determine the possible range of a floating-point expression.
+
+2014-07-30  Ed Schonberg  <schonberg@adacore.com>
+
+	* a-cborse.ads: Add Reference_Control_Type to package Generic_Keys.
+	* a-cborse.adb: Add Adjust and Finalize routines for
+	Reference_Control_Type.
+	(Reference_Preserving_Key): Build aggregate for
+	Reference_Control_Type.
+	(Delete): Check for tampering, and raise Program_Error (not
+	Constraint_Error) when attempting to delete an element not in
+	the set.
+	(Insert): Ditto.
+
+2014-07-30  Bob Duff  <duff@adacore.com>
+
+	* a-elchha.adb, a-except-2005.adb, a-except.adb, a-exexda.adb,
+	* a-exextr.adb, a-exstat.adb, exp_intr.ads, s-tassta.adb:
+	Exception_Information is used to produce useful debugging
+	information for the programmer. However, it was also used to
+	implement the stream attributes for type Exception_Occurrence. The
+	latter requires a stable and portable interface, which meant
+	that we couldn't include a symbolic traceback. A separate set of
+	routines was used to provide symbolic tracebacks under program
+	control (i.e. not automatically). The goal of this ticket is
+	to provide such automatic tracebacks, so the change here is to
+	split the two functionalities: Exception_Information gives the
+	maximally useful information for debugging (i.e. it now includes
+	a symbolic traceback when a decorator is set, and it can be
+	improved freely in the future without disturbing streaming).
+	Untailored_Exception_Information always uses hexadecimal addresses
+	in the traceback, has a stable and portable output, and is now
+	used for streaming.
+
+2014-07-30  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* exp_aggr.adb (Expand_Array_Aggregate): Add missing test
+	on the target of the assignment to find out whether it
+	can be directly done by the back-end.
+	* exp_util.adb (Is_Possibly_Unaligned_Slice): Remove obscure test.
+
 2014-07-30  Robert Dewar  <dewar@adacore.com>
 
 	* inline.adb, a-coorse.adb, a-coorse.ads, a-cohase.adb, a-cohase.ads,

gcc/ada/a-cborse.adb

@@ -482,6 +482,11 @@ package body Ada.Containers.Bounded_Ordered_Sets is
          raise Program_Error with "Position cursor designates wrong set";
       end if;
 
+      if Container.Busy > 0 then
+         raise Program_Error with
+           "attempt to tamper with cursors (set is busy)";
+      end if;
+
       pragma Assert (Vet (Container, Position.Node),
                      "bad cursor in Delete");
 
@@ -496,7 +501,7 @@ package body Ada.Containers.Bounded_Ordered_Sets is
 
    begin
       if X = 0 then
-         raise Constraint_Error with "attempt to delete element not in set";
+         raise Program_Error with "attempt to delete element not in set";
       end if;
 
       Tree_Operations.Delete_Node_Sans_Free (Container, X);
@@ -734,6 +739,23 @@ package body Ada.Containers.Bounded_Ordered_Sets is
            Is_Less_Key_Node    => Is_Less_Key_Node,
            Is_Greater_Key_Node => Is_Greater_Key_Node);
 
+      ------------
+      -- Adjust --
+      ------------
+
+      procedure Adjust (Control : in out Reference_Control_Type) is
+      begin
+         if Control.Container /= null then
+            declare
+               B : Natural renames Control.Container.Busy;
+               L : Natural renames Control.Container.Lock;
+            begin
+               B := B + 1;
+               L := L + 1;
+            end;
+         end if;
+      end Adjust;
+
       -------------
       -- Ceiling --
       -------------
@@ -842,6 +864,30 @@ package body Ada.Containers.Bounded_Ordered_Sets is
          end if;
       end Exclude;
 
+      --------------
+      -- Finalize --
+      --------------
+
+      procedure Finalize (Control : in out Reference_Control_Type) is
+      begin
+         if Control.Container /= null then
+            declare
+               B : Natural renames Control.Container.Busy;
+               L : Natural renames Control.Container.Lock;
+            begin
+               B := B - 1;
+               L := L - 1;
+            end;
+
+            if not (Key (Control.Pos) = Control.Old_Key.all) then
+               Delete (Control.Container.all, Key (Control.Pos));
+               raise Program_Error;
+            end if;
+
+            Control.Container := null;
+         end if;
+      end Finalize;
+
       ----------
       -- Find --
       ----------
@@ -939,15 +985,24 @@ package body Ada.Containers.Bounded_Ordered_Sets is
            (Vet (Container, Position.Node),
             "bad cursor in function Reference_Preserving_Key");
 
-         --  Some form of finalization will be required in order to actually
-         --  check that the key-part of the element designated by Position has
-         --  not changed.  ???
-
          declare
             N : Node_Type renames Container.Nodes (Position.Node);
+            B : Natural renames Container.Busy;
+            L : Natural renames Container.Lock;
          begin
-            return (Element => N.Element'Access);
+            return R : constant Reference_Type :=
+                (Element  => N.Element'Access,
+                 Control =>
+                    (Controlled with
+                      Container => Container'Access,
+                      Pos       => Position,
+                      Old_Key   => new Key_Type'(Key (Position))))
+            do
+               B := B + 1;
+               L := L + 1;
+            end return;
          end;
+
       end Reference_Preserving_Key;
 
       function Reference_Preserving_Key
@@ -963,8 +1018,21 @@ package body Ada.Containers.Bounded_Ordered_Sets is
 
          declare
             N : Node_Type renames Container.Nodes (Node);
+            B : Natural renames Container.Busy;
+            L : Natural renames Container.Lock;
          begin
-            return (Element => N.Element'Access);
+            return R : constant Reference_Type :=
+                (Element  => N.Element'Access,
+                 Control =>
+                    (Controlled with
+                      Container => Container'Access,
+                       Pos      => Find (Container, Key),
+                       Old_Key  => new Key_Type'(Key)))
+            do
+               B := B + 1;
+               L := L + 1;
+            end return;
+
          end;
       end Reference_Preserving_Key;
 
@@ -1181,6 +1249,11 @@ package body Ada.Containers.Bounded_Ordered_Sets is
    --  Start of processing for Insert_Sans_Hint
 
    begin
+      if Container.Busy > 0 then
+         raise Program_Error with
+           "attemot to tamper with cursors (set is busy)";
+      end if;
+
       Conditional_Insert_Sans_Hint
         (Container,
          New_Item,

gcc/ada/a-cborse.ads

@@ -277,11 +277,33 @@ package Ada.Containers.Bounded_Ordered_Sets is
          Key       : Key_Type) return Reference_Type;
 
    private
-      type Reference_Type (Element : not null access Element_Type) is
-        null record;
+      type Set_Access is access all Set;
+      for Set_Access'Storage_Size use 0;
+
+      type Key_Access is access all Key_Type;
 
       use Ada.Streams;
 
+      type Reference_Control_Type is
+        new Ada.Finalization.Controlled with
+      record
+         Container : Set_Access;
+         Pos       : Cursor;
+         Old_Key   : Key_Access;
+      end record;
+
+      overriding procedure
+         Adjust (Control : in out Reference_Control_Type);
+      pragma Inline (Adjust);
+
+      overriding procedure
+         Finalize (Control : in out Reference_Control_Type);
+      pragma Inline (Finalize);
+
+      type Reference_Type (Element : not null access Element_Type) is record
+         Control  : Reference_Control_Type;
+      end record;
+
       procedure Read
         (Stream : not null access Root_Stream_Type'Class;
          Item   : out Reference_Type);

gcc/ada/a-chtgop.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2014, 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- --
@@ -195,6 +195,51 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
       end loop;
    end Clear;
 
+   --------------------------
+   -- Delete_Node_At_Index --
+   --------------------------
+
+   procedure Delete_Node_At_Index
+     (HT   : in out Hash_Table_Type;
+      Indx : Hash_Type;
+      X    : in out Node_Access)
+   is
+      Prev : Node_Access;
+      Curr : Node_Access;
+
+   begin
+      Prev := HT.Buckets (Indx);
+      if Prev = X then
+         HT.Buckets (Indx) := Next (Prev);
+         HT.Length := HT.Length - 1;
+         Free (X);
+         return;
+      end if;
+
+      if HT.Length = 1 then
+         raise Program_Error with
+           "attempt to delete node not in its proper hash bucket";
+      end if;
+
+      loop
+         Curr := Next (Prev);
+
+         if Curr = null then
+            raise Program_Error with
+              "attempt to delete node not in its proper hash bucket";
+         end if;
+
+         if Curr = X then
+            Set_Next (Node => Prev, Next => Next (Curr));
+            HT.Length := HT.Length - 1;
+            Free (X);
+            return;
+         end if;
+         Prev := Curr;
+      end loop;
+
+   end Delete_Node_At_Index
+;
    ---------------------------
    -- Delete_Node_Sans_Free --
    ---------------------------

gcc/ada/a-chtgop.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2014, 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- --
@@ -128,6 +128,16 @@ package Ada.Containers.Hash_Tables.Generic_Operations is
    --  rehashed onto the new buckets array, and the old buckets array is
    --  deallocated. Program_Error is raised if the hash table is busy.
 
+   procedure Delete_Node_At_Index
+     (HT    : in out Hash_Table_Type;
+      Indx  : Hash_Type;
+      X     : in out Node_Access);
+
+   --  Delete a node whose bucket position is known. Used to remove a node
+   --  whose element has been modified through a key_preserving reference.
+   --  We cannot use the value of the element precisely because the current
+   --  value does not correspond to the hash code that determines the bucket.
+
    procedure Delete_Node_Sans_Free
      (HT : in out Hash_Table_Type;
       X  : Node_Access);

gcc/ada/a-cihase.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2014, 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- --
@@ -2139,6 +2139,24 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
            Hash      => Hash,
            Equivalent_Keys => Equivalent_Key_Node);
 
+      ------------
+      -- Adjust --
+      ------------
+
+      procedure Adjust (Control : in out Reference_Control_Type) is
+      begin
+         if Control.Container /= null then
+            declare
+               HT : Hash_Table_Type renames Control.Container.HT;
+               B : Natural renames HT.Busy;
+               L : Natural renames HT.Lock;
+            begin
+               B := B + 1;
+               L := L + 1;
+            end;
+         end if;
+      end Adjust;
+
       ------------------------
       -- Constant_Reference --
       ------------------------
@@ -2249,6 +2267,32 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
          Free (X);
       end Exclude;
 
+      --------------
+      -- Finalize --
+      --------------
+
+      procedure Finalize (Control : in out Reference_Control_Type) is
+      begin
+         if Control.Container /= null then
+            declare
+               HT   : Hash_Table_Type renames Control.Container.HT;
+               B : Natural renames HT.Busy;
+               L : Natural renames HT.Lock;
+            begin
+               B := B - 1;
+               L := L - 1;
+            end;
+
+            if Hash (Key (Control.Old_Pos)) /= Control.Old_Hash then
+               HT_Ops.Delete_Node_At_Index
+                 (Control.Container.HT, Control.Index,  Control.Old_Pos.Node);
+               raise Program_Error;
+            end if;
+
+            Control.Container := null;
+         end if;
+      end Finalize;
+
       ----------
       -- Find --
       ----------
@@ -2322,11 +2366,25 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
            (Vet (Position),
             "bad cursor in function Reference_Preserving_Key");
 
-         --  Some form of finalization will be required in order to actually
-         --  check that the key-part of the element designated by Position has
-         --  not changed.  ???
+         declare
+            HT : Hash_Table_Type renames Container.HT;
+            B : Natural renames HT.Busy;
+            L : Natural renames HT.Lock;
 
-         return (Element => Position.Node.Element.all'Access);
+         begin
+            return R : constant Reference_Type :=
+              (Element  => Position.Node.Element.all'Access,
+                 Control =>
+                   (Controlled with
+                     Container => Container'Access,
+                     Index     => HT_Ops.Index (HT, Position.Node),
+                     Old_Pos   => Position,
+                     Old_Hash  => Hash (Key (Position))))
+            do
+               B := B + 1;
+               L := L + 1;
+            end return;
+         end;
       end Reference_Preserving_Key;
 
       function Reference_Preserving_Key
@@ -2345,11 +2403,26 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
             raise Program_Error with "Node has no element";
          end if;
 
-         --  Some form of finalization will be required in order to actually
-         --  check that the key-part of the element designated by Key has not
-         --  changed.  ???
+         declare
+            HT : Hash_Table_Type renames Container.HT;
+            B : Natural renames HT.Busy;
+            L : Natural renames HT.Lock;
+            P : constant Cursor := Find (Container, Key);
 
-         return (Element => Node.Element.all'Access);
+         begin
+            return R : constant Reference_Type :=
+              (Element  => Node.Element.all'Access,
+                 Control =>
+                   (Controlled with
+                     Container => Container'Access,
+                     Index  => HT_Ops.Index (HT, P.Node),
+                     Old_Pos => P,
+                     Old_Hash => Hash (Key)))
+            do
+               B := B + 1;
+               L := L + 1;
+            end return;
+         end;
       end Reference_Preserving_Key;
 
       -------------

gcc/ada/a-cihase.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2014, 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 --
@@ -430,8 +430,29 @@ package Ada.Containers.Indefinite_Hashed_Sets is
          Key       : Key_Type) return Reference_Type;
 
    private
-      type Reference_Type (Element : not null access Element_Type)
-         is null record;
+      type Set_Access is access all Set;
+      for Set_Access'Storage_Size use 0;
+
+      type Reference_Control_Type is
+        new Ada.Finalization.Controlled with
+      record
+         Container : Set_Access;
+         Index     : Hash_Type;
+         Old_Pos   : Cursor;
+         Old_Hash  : Hash_Type;
+      end record;
+
+      overriding procedure
+         Adjust (Control : in out Reference_Control_Type);
+      pragma Inline (Adjust);
+
+      overriding procedure
+         Finalize (Control : in out Reference_Control_Type);
+      pragma Inline (Finalize);
+
+      type Reference_Type (Element : not null access Element_Type) is record
+         Control  : Reference_Control_Type;
+      end record;
 
       use Ada.Streams;
 

gcc/ada/a-cohase.adb

@@ -132,15 +132,6 @@ package body Ada.Containers.Hashed_Sets is
    procedure Write_Nodes is
       new HT_Ops.Generic_Write (Write_Node);
 
-   procedure Delete_Node
-     (C    : in out Set;
-      Indx : Hash_Type;
-      X    : in out Node_Access);
-   --  Delete a node whose bucket position is known. Used to remove a node
-   --  whose element has been modified through a key_preserving reference.
-   --  We cannot use the value of the element precisely because the current
-   --  value does not correspond to the hash code that determines the bucket.
-
    ---------
    -- "=" --
    ---------
@@ -337,48 +328,6 @@ package body Ada.Containers.Hashed_Sets is
       Position.Container := null;
    end Delete;
 
-   procedure Delete_Node
-     (C    : in out Set;
-      Indx : Hash_Type;
-      X    : in out Node_Access)
-   is
-      HT   : Hash_Table_Type renames C.HT;
-      Prev : Node_Access;
-      Curr : Node_Access;
-
-   begin
-      Prev := HT.Buckets (Indx);
-      if Prev = X then
-         HT.Buckets (Indx) := Next (Prev);
-         HT.Length := HT.Length - 1;
-         Free (X);
-         return;
-      end if;
-
-      if HT.Length = 1 then
-         raise Program_Error with
-           "attempt to delete node not in its proper hash bucket";
-      end if;
-
-      loop
-         Curr := Next (Prev);
-
-         if Curr = null then
-            raise Program_Error with
-              "attempt to delete node not in its proper hash bucket";
-         end if;
-
-         if Curr = X then
-            Set_Next (Node => Prev, Next => Next (Curr));
-            HT.Length := HT.Length - 1;
-            Free (X);
-            return;
-         end if;
-         Prev := Curr;
-      end loop;
-
-   end Delete_Node;
-
    ----------------
    -- Difference --
    ----------------
@@ -2138,8 +2087,8 @@ package body Ada.Containers.Hashed_Sets is
 
             if Hash (Key (Element (Control.Old_Pos))) /= Control.Old_Hash
             then
-               Delete_Node
-                 (Control.Container.all, Control.Index,  Control.Old_Pos.Node);
+               HT_Ops.Delete_Node_At_Index
+                (Control.Container.HT, Control.Index,  Control.Old_Pos.Node);
                raise Program_Error with "key not preserved in reference";
             end if;
 

gcc/ada/a-elchha.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2003-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 2003-2014, 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- --
@@ -53,10 +53,11 @@ is
    pragma Import
      (Ada, Append_Info_Exception_Message, "__gnat_append_info_e_msg");
 
-   procedure Append_Info_Exception_Information
+   procedure Append_Info_Untailored_Exception_Information
      (X : Exception_Occurrence; Info : in out String; Ptr : in out Natural);
    pragma Import
-     (Ada, Append_Info_Exception_Information, "__gnat_append_info_e_info");
+     (Ada, Append_Info_Untailored_Exception_Information,
+      "__gnat_append_info_u_e_info");
 
    procedure To_Stderr (S : String);
    pragma Import (Ada, To_Stderr, "__gnat_to_stderr");
@@ -129,7 +130,7 @@ begin
       To_Stderr ("Execution terminated by unhandled exception");
       To_Stderr (Nline);
 
-      Append_Info_Exception_Information (Except, Nobuf, Ptr);
+      Append_Info_Untailored_Exception_Information (Except, Nobuf, Ptr);
    end if;
 
    Unhandled_Terminate;

gcc/ada/a-except-2005.adb

@@ -138,12 +138,17 @@ package body Ada.Exceptions is
       --  to contain the indicated Id value and message. Message is a string
       --  which is generated as the exception message.
 
-      --------------------------------------
-      -- Exception information subprogram --
-      --------------------------------------
+      ---------------------------------------
+      -- Exception information subprograms --
+      ---------------------------------------
 
-      function Exception_Information (X : Exception_Occurrence) return String;
-      --  The format of the exception information is as follows:
+      function Untailored_Exception_Information
+        (X : Exception_Occurrence) return String;
+      --  This is used by Stream_Attributes.EO_To_String to convert an
+      --  Exception_Occurrence to a String for the stream attributes.
+      --  String_To_EO understands the format, as documented here.
+      --
+      --  The format of the string is as follows:
       --
       --    Exception_Name: <exception name> (as in Exception_Name)
       --    Message: <message> (only if Exception_Message is empty)
@@ -164,10 +169,6 @@ package body Ada.Exceptions is
       --  that an equivalent modification to the routine String_To_EO must be
       --  made to preserve proper functioning of the stream attributes.
 
-      ---------------------------------------
-      -- Exception backtracing subprograms --
-      ---------------------------------------
-
       --  What is automatically output when exception tracing is on is the
       --  usual exception information with the call chain backtrace possibly
       --  tailored by a backtrace decorator. Modifying Exception_Information
@@ -177,28 +178,23 @@ package body Ada.Exceptions is
       --  the possibly tailored output, which is equivalent if no decorator is
       --  currently set:
 
-      function Tailored_Exception_Information
-        (X : Exception_Occurrence) return String;
-      --  Exception information to be output in the case of automatic tracing
-      --  requested through GNAT.Exception_Traces.
+      function Exception_Information (X : Exception_Occurrence) return String;
+      --  This is the implementation of Ada.Exceptions.Exception_Information,
+      --  as defined in the Ada RM.
       --
-      --  This is the same as Exception_Information if no backtrace decorator
-      --  is currently in place. Otherwise, this is Exception_Information with
-      --  the call chain raw addresses replaced by the result of a call to the
-      --  current decorator provided with the call chain addresses.
-
-      pragma Export
-        (Ada, Tailored_Exception_Information,
-           "__gnat_tailored_exception_information");
-      --  This is currently used by System.Tasking.Stages
+      --  If no traceback decorator (see GNAT.Exception_Traces) is currently
+      --  in place, this is the same as Untailored_Exception_Information.
+      --  Otherwise, the decorator is used to produce a symbolic traceback
+      --  instead of hexadecimal addresses.
+      --
+      --  Note that unlike Untailored_Exception_Information, there is no need
+      --  to keep the output of Exception_Information stable for streaming
+      --  purposes, and in fact the output differs across platforms.
 
    end Exception_Data;
 
    package Exception_Traces is
 
-      use Exception_Data;
-      --  Imports Tailored_Exception_Information
-
       ----------------------------------------------
       -- Run-Time Exception Notification Routines --
       ----------------------------------------------
@@ -737,8 +733,8 @@ package body Ada.Exceptions is
    -- EO_To_String --
    ------------------
 
-   --  We use the null string to represent the null occurrence, otherwise
-   --  we output the Exception_Information string for the occurrence.
+   --  We use the null string to represent the null occurrence, otherwise we
+   --  output the Untailored_Exception_Information string for the occurrence.
 
    function EO_To_String (X : Exception_Occurrence) return String
      renames Stream_Attributes.EO_To_String;

gcc/ada/a-except.adb

@@ -116,12 +116,17 @@ package body Ada.Exceptions is
       --  message. Message is a string which is generated as the exception
       --  message.
 
-      --------------------------------------
-      -- Exception information subprogram --
-      --------------------------------------
+      ---------------------------------------
+      -- Exception information subprograms --
+      ---------------------------------------
 
-      function Exception_Information (X : Exception_Occurrence) return String;
-      --  The format of the exception information is as follows:
+      function Untailored_Exception_Information
+        (X : Exception_Occurrence) return String;
+      --  This is used by Stream_Attributes.EO_To_String to convert an
+      --  Exception_Occurrence to a String for the stream attributes.
+      --  String_To_EO understands the format, as documented here.
+      --
+      --  The format of the string is as follows:
       --
       --    Exception_Name: <exception name> (as in Exception_Name)
       --    Message: <message> (only if Exception_Message is empty)
@@ -129,25 +134,19 @@ package body Ada.Exceptions is
       --    Call stack traceback locations:  (only if at least one location)
       --    <0xyyyyyyyy 0xyyyyyyyy ...>      (is recorded)
       --
-      --  The lines are separated by a ASCII.LF character
-      --
-      --  The nnnn is the partition Id given as decimal digits
-      --
+      --  The lines are separated by a ASCII.LF character.
+      --  The nnnn is the partition Id given as decimal digits.
       --  The 0x... line represents traceback program counter locations, in
       --  execution order with the first one being the exception location. It
       --  is present only
       --
-      --  The Exception_Name and Message lines are omitted in the abort signal
-      --  case, since this is not really an exception.
+      --  The Exception_Name and Message lines are omitted in the abort
+      --  signal case, since this is not really an exception.
 
       --  Note: If the format of the generated string is changed, please note
       --  that an equivalent modification to the routine String_To_EO must be
       --  made to preserve proper functioning of the stream attributes.
 
-      ---------------------------------------
-      -- Exception backtracing subprograms --
-      ---------------------------------------
-
       --  What is automatically output when exception tracing is on is the
       --  usual exception information with the call chain backtrace possibly
       --  tailored by a backtrace decorator. Modifying Exception_Information
@@ -157,28 +156,23 @@ package body Ada.Exceptions is
       --  the possibly tailored output, which is equivalent if no decorator is
       --  currently set:
 
-      function Tailored_Exception_Information
-        (X : Exception_Occurrence) return String;
-      --  Exception information to be output in the case of automatic tracing
-      --  requested through GNAT.Exception_Traces.
+      function Exception_Information (X : Exception_Occurrence) return String;
+      --  This is the implementation of Ada.Exceptions.Exception_Information,
+      --  as defined in the Ada RM.
       --
-      --  This is the same as Exception_Information if no backtrace decorator
-      --  is currently in place. Otherwise, this is Exception_Information with
-      --  the call chain raw addresses replaced by the result of a call to the
-      --  current decorator provided with the call chain addresses.
-
-      pragma Export
-        (Ada, Tailored_Exception_Information,
-           "__gnat_tailored_exception_information");
-      --  This is currently used by System.Tasking.Stages
+      --  If no traceback decorator (see GNAT.Exception_Traces) is currently
+      --  in place, this is the same as Untailored_Exception_Information.
+      --  Otherwise, the decorator is used to produce a symbolic traceback
+      --  instead of hexadecimal addresses.
+      --
+      --  Note that unlike Untailored_Exception_Information, there is no need
+      --  to keep the output of Exception_Information stable for streaming
+      --  purposes, and in fact the output differs across platforms.
 
    end Exception_Data;
 
    package Exception_Traces is
 
-      use Exception_Data;
-      --  Imports Tailored_Exception_Information
-
       ----------------------------------------------
       -- Run-Time Exception Notification Routines --
       ----------------------------------------------
@@ -774,7 +768,7 @@ package body Ada.Exceptions is
    ------------------
 
    --  We use the null string to represent the null occurrence, otherwise we
-   --  output the Exception_Information string for the occurrence.
+   --  output the Untailored_Exception_Information string for the occurrence.
 
    function EO_To_String (X : Exception_Occurrence) return String
      renames Stream_Attributes.EO_To_String;
@@ -806,9 +800,9 @@ package body Ada.Exceptions is
    begin
       if X.Id = Null_Id then
          raise Constraint_Error;
-      end if;
-
+      else
          return Exception_Data.Exception_Information (X);
+      end if;
    end Exception_Information;
 
    -----------------------

gcc/ada/a-exextr.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -99,7 +99,7 @@ package body Exception_Traces is
 
          To_Stderr ("Exception raised");
          To_Stderr (Nline);
-         To_Stderr (Tailored_Exception_Information (Excep.all));
+         To_Stderr (Exception_Information (Excep.all));
          Unlock_Task.all;
       end if;
 

gcc/ada/a-exstat.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -59,15 +59,15 @@ package body Stream_Attributes is
    -- EO_To_String --
    ------------------
 
-   --  We use the null string to represent the null occurrence, otherwise
-   --  we output the Exception_Information string for the occurrence.
+   --  We use the null string to represent the null occurrence, otherwise we
+   --  output the Untailored_Exception_Information string for the occurrence.
 
    function EO_To_String (X : Exception_Occurrence) return String is
    begin
       if X.Id = Null_Id then
          return "";
       else
-         return Exception_Information (X);
+         return Exception_Data.Untailored_Exception_Information (X);
       end if;
    end EO_To_String;
 

gcc/ada/checks.ads

@@ -40,6 +40,7 @@ with Namet;  use Namet;
 with Table;
 with Types;  use Types;
 with Uintp;  use Uintp;
+with Urealp; use Urealp;
 
 package Checks is
 
@@ -302,6 +303,18 @@ package Checks is
    --  then this assumption is valid, if False, then processing is done using
    --  base types to allow invalid values.
 
+   procedure Determine_Range_R
+     (N            : Node_Id;
+      OK           : out Boolean;
+      Lo           : out Ureal;
+      Hi           : out Ureal;
+      Assume_Valid : Boolean := False);
+   --  Similar to Determine_Range, but for a node N of floating-point type. OK
+   --  is True on return only for IEEE floating-point types and only if we do
+   --  not have to worry about extended precision (i.e. on the x86, we must be
+   --  using -msse2 -mfpmath=sse. At the current time, this is used only in
+   --  GNATprove, though we could consider using it more generally in future.
+
    procedure Install_Null_Excluding_Check (N : Node_Id);
    --  Determines whether an access node requires a runtime access check and
    --  if so inserts the appropriate run-time check.

gcc/ada/exp_aggr.adb

@@ -5345,10 +5345,11 @@ package body Exp_Aggr is
          --  then we could go into an infinite recursion.
 
          if (In_Place_Assign_OK_For_Declaration or else Maybe_In_Place_OK)
-           and then not AAMP_On_Target
            and then VM_Target = No_VM
+           and then not AAMP_On_Target
            and then not Generate_SCIL
            and then not Possible_Bit_Aligned_Component (Target)
+           and then not Is_Possibly_Unaligned_Slice (Target)
            and then Aggr_Assignment_OK_For_Backend (N)
          then
             if Maybe_In_Place_OK then

gcc/ada/exp_util.adb

@@ -5041,18 +5041,6 @@ package body Exp_Util is
          return False;
       end if;
 
-      --  Always assume the worst for a nested record component with a
-      --  component clause, which gigi/gcc does not appear to handle well.
-      --  It is not clear why this special test is needed at all ???
-
-      if Nkind (Prefix (N)) = N_Selected_Component
-        and then Nkind (Prefix (Prefix (N))) = N_Selected_Component
-        and then
-          Present (Component_Clause (Entity (Selector_Name (Prefix (N)))))
-      then
-         return True;
-      end if;
-
       --  We only need to worry if the target has strict alignment
 
       if not Target_Strict_Alignment then

gcc/ada/s-tassta.adb

@@ -1524,12 +1524,6 @@ package body System.Tasking.Stages is
         Ada.Unchecked_Conversion
          (Task_Id, System.Task_Primitives.Task_Address);
 
-      function Tailored_Exception_Information
-        (E : Exception_Occurrence) return String;
-      pragma Import
-        (Ada, Tailored_Exception_Information,
-         "__gnat_tailored_exception_information");
-
       Excep : constant Exception_Occurrence_Access :=
                 SSL.Get_Current_Excep.all;
 
@@ -1553,7 +1547,7 @@ package body System.Tasking.Stages is
       To_Stderr (System.Address_Image (To_Address (Self_Id)));
       To_Stderr (" terminated by unhandled exception");
       To_Stderr ((1 => ASCII.LF));
-      To_Stderr (Tailored_Exception_Information (Excep.all));
+      To_Stderr (Exception_Information (Excep.all));
       Initialization.Task_Unlock (Self_Id);
    end Trace_Unhandled_Exception_In_Task;