[multiple changes]

2011-12-22  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch7.adb (Build_Adjust_Or_Finalize_Statements): Create the objects
	associated with exception handling unconditionally.
	(Build_Adjust_Statements): Create the objects associated with
	exception handling unconditionally.
	(Build_Components): Create the objects associated with exception
	handling unconditionally.
	(Build_Finalize_Statements): Create the objects associated with
	exception handling unconditionally.
	(Build_Initialize_Statements): Create the objects associated with
	exception handling unconditionally.
	(Build_Object_Declarations): Set the proper location of the data
	record when exception propagation is forbidden.

2011-12-22  Gary Dismukes  <dismukes@adacore.com>

	* a-tienio.adb (Put): Test validity of Item parameters before
	applying Image, and raise Constraint_Error for invalid values.

2011-12-22  Bob Duff  <duff@adacore.com>

	* a-stwima.ads (Initialize,Adjust,Finalize): Add overriding indicators.
	* a-ststio.ads (AFCB_Allocate,AFCB_Close,AFCB_Free,Read,Write): Add
	overriding indicators.

From-SVN: r182619

5 files changed, 88 insertions, 44 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 87898a0..0137afe 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,29 @@
+2011-12-22  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch7.adb (Build_Adjust_Or_Finalize_Statements): Create the objects
+	associated with exception handling unconditionally.
+	(Build_Adjust_Statements): Create the objects associated with
+	exception handling unconditionally.
+	(Build_Components): Create the objects associated with exception
+	handling unconditionally.
+	(Build_Finalize_Statements): Create the objects associated with
+	exception handling unconditionally.
+	(Build_Initialize_Statements): Create the objects associated with
+	exception handling unconditionally.
+	(Build_Object_Declarations): Set the proper location of the data
+	record when exception propagation is forbidden.
+
+2011-12-22  Gary Dismukes  <dismukes@adacore.com>
+
+	* a-tienio.adb (Put): Test validity of Item parameters before
+	applying Image, and raise Constraint_Error for invalid values.
+
+2011-12-22  Bob Duff  <duff@adacore.com>
+
+	* a-stwima.ads (Initialize,Adjust,Finalize): Add overriding indicators.
+	* a-ststio.ads (AFCB_Allocate,AFCB_Close,AFCB_Free,Read,Write): Add
+	overriding indicators.
+
 2011-12-22  Arnaud Charlet  <charlet@adacore.com>
 
 	* s-osinte-hpux-dce.ads: Update header to GPLv3
diff --git a/gcc/ada/a-ststio.ads b/gcc/ada/a-ststio.ads
index 63a5e80..d14dd3e 100644
--- a/gcc/ada/a-ststio.ads
+++ b/gcc/ada/a-ststio.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-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 --
@@ -202,18 +202,19 @@ private
 
    type File_Type is access all Stream_AFCB;
 
-   function AFCB_Allocate (Control_Block : Stream_AFCB) return FCB.AFCB_Ptr;
+   overriding function AFCB_Allocate
+     (Control_Block : Stream_AFCB) return FCB.AFCB_Ptr;
 
-   procedure AFCB_Close (File : not null access Stream_AFCB);
-   procedure AFCB_Free  (File : not null access Stream_AFCB);
+   overriding procedure AFCB_Close (File : not null access Stream_AFCB);
+   overriding procedure AFCB_Free  (File : not null access Stream_AFCB);
 
-   procedure Read
+   overriding procedure Read
      (File : in out Stream_AFCB;
       Item : out Ada.Streams.Stream_Element_Array;
       Last : out Ada.Streams.Stream_Element_Offset);
    --  Read operation used when Stream_IO file is treated directly as Stream
 
-   procedure Write
+   overriding procedure Write
      (File : in out Stream_AFCB;
       Item : Ada.Streams.Stream_Element_Array);
    --  Write operation used when Stream_IO file is treated directly as Stream
diff --git a/gcc/ada/a-stwima.ads b/gcc/ada/a-stwima.ads
index b22a593..8863a44 100644
--- a/gcc/ada/a-stwima.ads
+++ b/gcc/ada/a-stwima.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-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 --
@@ -177,9 +177,9 @@ private
    --  incorrect attempts to finalize constants that are statically
    --  declared here and in Ada.Strings.Wide_Maps, which is incorrect.
 
-   procedure Initialize (Object : in out Wide_Character_Set);
-   procedure Adjust     (Object : in out Wide_Character_Set);
-   procedure Finalize   (Object : in out Wide_Character_Set);
+   overriding procedure Initialize (Object : in out Wide_Character_Set);
+   overriding procedure Adjust     (Object : in out Wide_Character_Set);
+   overriding procedure Finalize   (Object : in out Wide_Character_Set);
 
    Null_Range : aliased constant Wide_Character_Ranges :=
                   (1 .. 0 => (Low => ' ', High => ' '));
@@ -224,9 +224,9 @@ private
    --  incorrect attempts to finalize constants that are statically
    --  declared here and in Ada.Strings.Wide_Maps, which is incorrect.
 
-   procedure Initialize (Object : in out Wide_Character_Mapping);
-   procedure Adjust     (Object : in out Wide_Character_Mapping);
-   procedure Finalize   (Object : in out Wide_Character_Mapping);
+   overriding procedure Initialize (Object : in out Wide_Character_Mapping);
+   overriding procedure Adjust     (Object : in out Wide_Character_Mapping);
+   overriding procedure Finalize   (Object : in out Wide_Character_Mapping);
 
    Null_Map : aliased constant Wide_Character_Mapping_Values :=
                  (Length => 0,
diff --git a/gcc/ada/a-tienio.adb b/gcc/ada/a-tienio.adb
index 6e1868a..a643f87 100644
--- a/gcc/ada/a-tienio.adb
+++ b/gcc/ada/a-tienio.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-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- --
@@ -94,9 +94,21 @@ package body Ada.Text_IO.Enumeration_IO is
       Width : Field := Default_Width;
       Set   : Type_Set := Default_Setting)
    is
-      Image : constant String := Enum'Image (Item);
    begin
-      Aux.Put (File, Image, Width, Set);
+      --  Ensure that Item is valid before attempting to retrieve the Image, to
+      --  prevent the possibility of out-of-bounds addressing of index or image
+      --  tables. Units in  the run-time library are normally compiled with
+      --  checks suppressed, which includes instantiated generics.
+
+      if not Item'Valid then
+         raise Constraint_Error;
+      end if;
+
+      declare
+         Image : constant String := Enum'Image (Item);
+      begin
+         Aux.Put (File, Image, Width, Set);
+      end;
    end Put;
 
    procedure Put
@@ -113,9 +125,21 @@ package body Ada.Text_IO.Enumeration_IO is
       Item : Enum;
       Set  : Type_Set := Default_Setting)
    is
-      Image : constant String := Enum'Image (Item);
    begin
-      Aux.Puts (To, Image, Set);
+      --  Ensure that Item is valid before attempting to retrieve the Image, to
+      --  prevent the possibility of out-of-bounds addressing of index or image
+      --  tables. Units in the run-time library are normally compiled with
+      --  checks suppressed, which includes instantiated generics.
+
+      if not Item'Valid then
+         raise Constraint_Error;
+      end if;
+
+      declare
+         Image : constant String := Enum'Image (Item);
+      begin
+         Aux.Puts (To, Image, Set);
+      end;
    end Put;
 
 end Ada.Text_IO.Enumeration_IO;
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 27b1cd7..3ff4b9e 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -1210,10 +1210,8 @@ package body Exp_Ch7 is
 
             Finalizer_Decls := New_List;
 
-            if Exceptions_OK then
-               Build_Object_Declarations
-                 (Finalizer_Data, Finalizer_Decls, Loc, For_Package);
-            end if;
+            Build_Object_Declarations
+              (Finalizer_Data, Finalizer_Decls, Loc, For_Package);
 
             --  Since the total number of controlled objects is always known,
             --  build a subtype of Natural with precise bounds. This allows
@@ -2943,9 +2941,14 @@ package body Exp_Ch7 is
    begin
       pragma Assert (Decls /= No_List);
 
+      --  Always set the proper location as it may be needed even when
+      --  exception propagation is forbidden.
+
+      Data.Loc := Loc;
+
       if Restriction_Active (No_Exception_Propagation) then
-         Data.Abort_Id := Empty;
-         Data.E_Id := Empty;
+         Data.Abort_Id  := Empty;
+         Data.E_Id      := Empty;
          Data.Raised_Id := Empty;
          return;
       end if;
@@ -2953,7 +2956,6 @@ package body Exp_Ch7 is
       Data.Abort_Id  := Make_Temporary (Loc, 'A');
       Data.E_Id      := Make_Temporary (Loc, 'E');
       Data.Raised_Id := Make_Temporary (Loc, 'R');
-      Data.Loc       := Loc;
 
       --  In certain scenarios, finalization can be triggered by an abort. If
       --  the finalization itself fails and raises an exception, the resulting
@@ -4893,12 +4895,10 @@ package body Exp_Ch7 is
       --  Start of processing for Build_Adjust_Or_Finalize_Statements
 
       begin
-         Build_Indices;
+         Finalizer_Decls := New_List;
 
-         if Exceptions_OK then
-            Finalizer_Decls := New_List;
-            Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
-         end if;
+         Build_Indices;
+         Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
 
          Comp_Ref :=
            Make_Indexed_Component (Loc,
@@ -5168,14 +5168,11 @@ package body Exp_Ch7 is
       --  Start of processing for Build_Initialize_Statements
 
       begin
-         Build_Indices;
-
          Counter_Id := Make_Temporary (Loc, 'C');
+         Finalizer_Decls := New_List;
 
-         if Exceptions_OK then
-            Finalizer_Decls := New_List;
-            Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
-         end if;
+         Build_Indices;
+         Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
 
          --  Generate the block which houses the finalization call, the index
          --  guard and the handler which triggers Program_Error later on.
@@ -5881,10 +5878,8 @@ package body Exp_Ch7 is
       --  Start of processing for Build_Adjust_Statements
 
       begin
-         if Exceptions_OK then
-            Finalizer_Decls := New_List;
-            Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
-         end if;
+         Finalizer_Decls := New_List;
+         Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
 
          if Nkind (Typ_Def) = N_Derived_Type_Definition then
             Rec_Def := Record_Extension_Part (Typ_Def);
@@ -6458,10 +6453,8 @@ package body Exp_Ch7 is
       --  Start of processing for Build_Finalize_Statements
 
       begin
-         if Exceptions_OK then
-            Finalizer_Decls := New_List;
-            Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
-         end if;
+         Finalizer_Decls := New_List;
+         Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
 
          if Nkind (Typ_Def) = N_Derived_Type_Definition then
             Rec_Def := Record_Extension_Part (Typ_Def);