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

	* exp_ch7.ads, exp_ch7.adb (Finalization_Exception_Data): New type to
	hold variables between these following subprograms.
	(Build_Exception_Handler, Build_Object_Declarations,
	Build_Raise_Statement): Use the above type as parameter.
	Make the above adjustments.
	* exp_intr.adb (Expand_Unc_Deallocation): Adjust.

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

	* projects.texi: Minor reformatting.

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

	* s-ransee.ads, s-ransee.adb: Add system.random_seed unit.
	* s-rannum.adb (Reset): Use Get_Seed from s-ransee.

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

	* exp_ch5.adb: Minor code cleanup.
	* sem_ch5.adb (Analyze_Iteration_Scheme): Set ekind of loop variable to
	prevent cascaded errors.
	(Analyze_Loop_Statement): In semantics-only mode, introduce loop
	variable of an iterator specification in current scope.
	* sem_ch6.adb (Analyze_Return_Statement, Find_what_It_Apples_To): Skip
	postconditions on the stack, as they contain no return statements.

2011-08-31  Yannick Moy  <moy@adacore.com>

	* exp_alfa.adb (Expand_Alfa_N_Package_Declaration,
	Expand_Alfa_N_Subprogram_Body): Remove useless procedures which simply
	call Qualify_Entity_Names.
	(Expand_Alfa): call Qualify_Entity_Names in more cases
	* lib-xref-alfa.adb: Take into account system package.
	* sem_prag.adb Take into account restrictions in Alfa mode, contrary to
	CodePeer mode in which we are interested in finding bugs even if
	compiler cannot compile source.
	* sem_util.adb, sem_util.ads (Unique_Entity): Take into account case of
	deferred constant.

2011-08-31  Gary Dismukes  <dismukes@adacore.com>

	* sem_ch3.adb (Constrain_Concurrent): Retrieve Base_Type of the subtype
	denoted by the subtype mark to ensure getting the concurrent type in
	the case where the subtype mark denotes a private subtype of a
	concurrent type (needed when using -gnatc).
	(Process_Subtype): For the processing specific to type kinds, case on
	the Base_Type kind of the Subtype_Mark_Id, to handle cases where the
	subtype denotes a private subtype whose base type is nonprivate (needed
	for subtypes of private fulfilled by task types when compiling with
	-gnatc).

2011-08-31  Gary Dismukes  <dismukes@adacore.com>

	* sem_disp.adb (Check_Dispatching_Operation): Bypass registration of
	late primitives that override interface operations when the full
	expander is not active, to avoid blowups in Register_Primitive when
	types don't have associated secondary dispatch tables.

2011-08-31  Yannick Moy  <moy@adacore.com>

	* alfa_test.adb: Code clean up.

2011-08-31  Marc Sango  <sango@adacore.com>

	* restrict.adb (Check_SPARK_Restriction): Change Comes_From_Source (N)
	by Comes_From_Source (Original_Node (N)) in order to treat also the
	nodes which have been rewritten.
	* sem_ch4.adb (Analyze_Explicit_Dereference, Analyze_Slice): Guard the
	explicit dereference and slice violation in spark mode on the nodes 
	coming only from the source code.



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

22 files changed, 473 insertions, 339 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a48149e19b6..8595b8b05ae 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,76 @@
+2011-08-31  Tristan Gingold  <gingold@adacore.com>
+
+	* exp_ch7.ads, exp_ch7.adb (Finalization_Exception_Data): New type to
+	hold variables between these following subprograms.
+	(Build_Exception_Handler, Build_Object_Declarations,
+	Build_Raise_Statement): Use the above type as parameter.
+	Make the above adjustments.
+	* exp_intr.adb (Expand_Unc_Deallocation): Adjust.
+
+2011-08-31  Pascal Obry  <obry@adacore.com>
+
+	* projects.texi: Minor reformatting.
+
+2011-08-31  Tristan Gingold  <gingold@adacore.com>
+
+	* s-ransee.ads, s-ransee.adb: Add system.random_seed unit.
+	* s-rannum.adb (Reset): Use Get_Seed from s-ransee.
+
+2011-08-31  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch5.adb: Minor code cleanup.
+	* sem_ch5.adb (Analyze_Iteration_Scheme): Set ekind of loop variable to
+	prevent cascaded errors.
+	(Analyze_Loop_Statement): In semantics-only mode, introduce loop
+	variable of an iterator specification in current scope.
+	* sem_ch6.adb (Analyze_Return_Statement, Find_what_It_Apples_To): Skip
+	postconditions on the stack, as they contain no return statements.
+
+2011-08-31  Yannick Moy  <moy@adacore.com>
+
+	* exp_alfa.adb (Expand_Alfa_N_Package_Declaration,
+	Expand_Alfa_N_Subprogram_Body): Remove useless procedures which simply
+	call Qualify_Entity_Names.
+	(Expand_Alfa): call Qualify_Entity_Names in more cases
+	* lib-xref-alfa.adb: Take into account system package.
+	* sem_prag.adb Take into account restrictions in Alfa mode, contrary to
+	CodePeer mode in which we are interested in finding bugs even if
+	compiler cannot compile source.
+	* sem_util.adb, sem_util.ads (Unique_Entity): Take into account case of
+	deferred constant.
+
+2011-08-31  Gary Dismukes  <dismukes@adacore.com>
+
+	* sem_ch3.adb (Constrain_Concurrent): Retrieve Base_Type of the subtype
+	denoted by the subtype mark to ensure getting the concurrent type in
+	the case where the subtype mark denotes a private subtype of a
+	concurrent type (needed when using -gnatc).
+	(Process_Subtype): For the processing specific to type kinds, case on
+	the Base_Type kind of the Subtype_Mark_Id, to handle cases where the
+	subtype denotes a private subtype whose base type is nonprivate (needed
+	for subtypes of private fulfilled by task types when compiling with
+	-gnatc).
+
+2011-08-31  Gary Dismukes  <dismukes@adacore.com>
+
+	* sem_disp.adb (Check_Dispatching_Operation): Bypass registration of
+	late primitives that override interface operations when the full
+	expander is not active, to avoid blowups in Register_Primitive when
+	types don't have associated secondary dispatch tables.
+
+2011-08-31  Yannick Moy  <moy@adacore.com>
+
+	* alfa_test.adb: Code clean up.
+
+2011-08-31  Marc Sango  <sango@adacore.com>
+
+	* restrict.adb (Check_SPARK_Restriction): Change Comes_From_Source (N)
+	by Comes_From_Source (Original_Node (N)) in order to treat also the
+	nodes which have been rewritten.
+	* sem_ch4.adb (Analyze_Explicit_Dereference, Analyze_Slice): Guard the
+	explicit dereference and slice violation in spark mode on the nodes 
+	coming only from the source code.
+
 2011-08-31  Robert Dewar  <dewar@adacore.com>
 
 	* exp_ch5.adb, exp_alfa.ads, prj.ads, sem_attr.adb,
diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl
index adeb6faf260..762ca78da28 100644
--- a/gcc/ada/Makefile.rtl
+++ b/gcc/ada/Makefile.rtl
@@ -603,6 +603,7 @@ GNATRTL_NONTASKING_OBJS= \
   s-powtab$(objext) \
   s-purexc$(objext) \
   s-rannum$(objext) \
+  s-ransee$(objext) \
   s-regexp$(objext) \
   s-regpat$(objext) \
   s-restri$(objext) \
diff --git a/gcc/ada/alfa_test.adb b/gcc/ada/alfa_test.adb
index c0cf37e8dc3..1e83477506a 100644
--- a/gcc/ada/alfa_test.adb
+++ b/gcc/ada/alfa_test.adb
@@ -39,23 +39,30 @@
 with Get_Alfa;
 with Put_Alfa;
 
-with Alfa;  use Alfa;
-with Types; use Types;
+with Alfa;                  use Alfa;
+with Types;                 use Types;
 
 with Ada.Command_Line;      use Ada.Command_Line;
 with Ada.Streams;           use Ada.Streams;
 with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
 with Ada.Text_IO;
 
+with GNAT.OS_Lib;           use GNAT.OS_Lib;
+
 procedure Alfa_Test is
    Infile    : File_Type;
+   Name1     : String_Access;
    Outfile_1 : File_Type;
+   Name2     : String_Access;
    Outfile_2 : File_Type;
    C         : Character;
 
    Stop : exception;
    --  Terminate execution
 
+   Diff_Exec   : constant String_Access := Locate_Exec_On_Path ("diff");
+   Diff_Result : Integer;
+
    use ASCII;
 
 begin
@@ -64,9 +71,12 @@ begin
       raise Stop;
    end if;
 
-   Create (Outfile_1, Out_File, "log1");
-   Create (Outfile_2, Out_File, "log2");
+   Name1 := new String'(Argument (1) & ".1");
+   Name2 := new String'(Argument (1) & ".2");
+
    Open   (Infile,    In_File,  Argument (1));
+   Create (Outfile_1, Out_File, Name1.all);
+   Create (Outfile_2, Out_File, Name2.all);
 
    --  Read input file till we get to first 'F' line
 
@@ -281,49 +291,24 @@ begin
 
       Write_Info_Terminate;
 
-      --  Now Outfile_1 and Outfile_2 should be identical
-
-      Compare_Files : declare
-         Line : Natural;
-         Col  : Natural;
-         C1   : Character;
-         C2   : Character;
-
-      begin
-         Reset (Outfile_1, In_File);
-         Reset (Outfile_2, In_File);
+      --  Flush to disk
 
-         --  Loop to compare the two files
+      Close (Outfile_1);
+      Close (Outfile_2);
 
-         Line := 1;
-         Col  := 1;
-         loop
-            C1 := Get_Char (Outfile_1);
-            C2 := Get_Char (Outfile_2);
-            exit when C1 = EOF or else C1 /= C2;
-
-            if C1 = LF then
-               Line := Line + 1;
-               Col  := 1;
-            else
-               Col := Col + 1;
-            end if;
-         end loop;
+      --  Now Outfile_1 and Outfile_2 should be identical
 
-         --  If we reached the end of file, then the files were identical,
-         --  otherwise, we have a failure in the comparison.
+      Diff_Result :=
+        Spawn (Diff_Exec.all,
+               Argument_String_To_List
+                 ("-u " & Name1.all & " " & Name2.all).all);
 
-         if C1 = EOF then
-            --  Success: exit silently
+      if Diff_Result /= 0 then
+         Ada.Text_IO.Put_Line ("diff(1) exit status" & Diff_Result'Img);
+      end if;
 
-            null;
+      OS_Exit (Diff_Result);
 
-         else
-            Ada.Text_IO.Put_Line
-              (Argument (1) & ": failure, files log1 and log2 differ at line"
-               & Line'Img & " column" & Col'Img);
-         end if;
-      end Compare_Files;
    end Process;
 
 exception
diff --git a/gcc/ada/exp_alfa.adb b/gcc/ada/exp_alfa.adb
index 56092c1da84..04c8484cb0c 100644
--- a/gcc/ada/exp_alfa.adb
+++ b/gcc/ada/exp_alfa.adb
@@ -51,15 +51,9 @@ package body Exp_Alfa is
    procedure Expand_Alfa_N_Attribute_Reference (N : Node_Id);
    --  Expand attributes 'Old and 'Result only
 
-   procedure Expand_Alfa_N_Package_Declaration (N : Node_Id);
-   --  Fully qualify names of enclosed entities
-
    procedure Expand_Alfa_N_Simple_Return_Statement (N : Node_Id);
    --  Insert conversion on function return if necessary
 
-   procedure Expand_Alfa_N_Subprogram_Body (N : Node_Id);
-   --  Fully qualify names of enclosed entities
-
    procedure Expand_Alfa_Simple_Function_Return (N : Node_Id);
    --  Expand simple return from function
 
@@ -71,15 +65,15 @@ package body Exp_Alfa is
    begin
       case Nkind (N) is
 
-         when N_Package_Declaration =>
-            Expand_Alfa_N_Package_Declaration (N);
+         when N_Package_Body        |
+              N_Package_Declaration |
+              N_Subprogram_Body     |
+              N_Block_Statement     =>
+            Qualify_Entity_Names (N);
 
          when N_Simple_Return_Statement =>
             Expand_Alfa_N_Simple_Return_Statement (N);
 
-         when N_Subprogram_Body =>
-            Expand_Alfa_N_Subprogram_Body (N);
-
          when N_Function_Call            |
               N_Procedure_Call_Statement =>
             Expand_Alfa_Call (N);
@@ -173,15 +167,6 @@ package body Exp_Alfa is
       end case;
    end Expand_Alfa_N_Attribute_Reference;
 
-   ---------------------------------------
-   -- Expand_Alfa_N_Package_Declaration --
-   ---------------------------------------
-
-   procedure Expand_Alfa_N_Package_Declaration (N : Node_Id) is
-   begin
-      Qualify_Entity_Names (N);
-   end Expand_Alfa_N_Package_Declaration;
-
    -------------------------------------------
    -- Expand_Alfa_N_Simple_Return_Statement --
    -------------------------------------------
@@ -222,15 +207,6 @@ package body Exp_Alfa is
          return;
    end Expand_Alfa_N_Simple_Return_Statement;
 
-   -----------------------------------
-   -- Expand_Alfa_N_Subprogram_Body --
-   -----------------------------------
-
-   procedure Expand_Alfa_N_Subprogram_Body (N : Node_Id) is
-   begin
-      Qualify_Entity_Names (N);
-   end Expand_Alfa_N_Subprogram_Body;
-
    ----------------------------------------
    -- Expand_Alfa_Simple_Function_Return --
    ----------------------------------------
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 54dea9ad5e0..5203885712d 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -2905,7 +2905,7 @@ package body Exp_Ch5 is
       Loc    : constant Source_Ptr := Sloc (N);
 
       Container     : constant Node_Id   := Name (I_Spec);
-      Container_Typ : constant Entity_Id := Etype (Container);
+      Container_Typ : constant Entity_Id := Base_Type (Etype (Container));
       Cursor        : Entity_Id;
       Iterator      : Entity_Id;
       New_Loop      : Node_Id;
@@ -2990,7 +2990,7 @@ package body Exp_Ch5 is
          --       declare
          --       --  the block is added when Element_Type is controlled
 
-         --          Obj : Pack.Element_Type := Element (Iterator);
+         --          Obj : Pack.Element_Type := Element (Cursor);
          --          --  for the "of" loop form
          --       begin
          --          <original loop statements>
@@ -3156,9 +3156,11 @@ package body Exp_Ch5 is
 
             --  X in Iterate (S) : type of iterator is type of explicitly
             --  given Iterate function, and the loop variable is the cursor.
+            --  It will be assigned in the loop and must be a variable.
 
             else
                Cursor := Id;
+               Set_Ekind (Cursor, E_Variable);
             end if;
 
             Iterator := Make_Temporary (Loc, 'I');
@@ -3247,6 +3249,8 @@ package body Exp_Ch5 is
                    Subtype_Mark  => New_Occurrence_Of (Iter_Type, Loc),
                    Name          => Relocate_Node (Name (I_Spec)));
 
+               --  Create declaration for cursor.
+
                Decl2 :=
                  Make_Object_Declaration (Loc,
                    Defining_Identifier => Cursor,
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 74de4b00ac5..09015394f1e 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -711,36 +711,35 @@ package body Exp_Ch7 is
    -----------------------------
 
    function Build_Exception_Handler
-     (Loc         : Source_Ptr;
-      E_Id        : Entity_Id;
-      Raised_Id   : Entity_Id;
+     (Data        : Finalization_Exception_Data;
       For_Library : Boolean := False) return Node_Id
    is
       Actuals      : List_Id;
       Proc_To_Call : Entity_Id;
 
    begin
-      pragma Assert (Present (E_Id));
-      pragma Assert (Present (Raised_Id));
+      pragma Assert (Present (Data.E_Id));
+      pragma Assert (Present (Data.Raised_Id));
 
       --  Generate:
       --    Get_Current_Excep.all.all
 
       Actuals := New_List (
-        Make_Explicit_Dereference (Loc,
+        Make_Explicit_Dereference (Data.Loc,
           Prefix =>
-            Make_Function_Call (Loc,
+            Make_Function_Call (Data.Loc,
               Name =>
-                Make_Explicit_Dereference (Loc,
+                Make_Explicit_Dereference (Data.Loc,
                   Prefix =>
-                    New_Reference_To (RTE (RE_Get_Current_Excep), Loc)))));
+                    New_Reference_To (RTE (RE_Get_Current_Excep),
+                                      Data.Loc)))));
 
       if For_Library and then not Restricted_Profile then
          Proc_To_Call := RTE (RE_Save_Library_Occurrence);
 
       else
          Proc_To_Call := RTE (RE_Save_Occurrence);
-         Prepend_To (Actuals, New_Reference_To (E_Id, Loc));
+         Prepend_To (Actuals, New_Reference_To (Data.E_Id, Data.Loc));
       end if;
 
       --  Generate:
@@ -754,23 +753,23 @@ package body Exp_Ch7 is
       --       end if;
 
       return
-        Make_Exception_Handler (Loc,
+        Make_Exception_Handler (Data.Loc,
           Exception_Choices =>
-            New_List (Make_Others_Choice (Loc)),
+            New_List (Make_Others_Choice (Data.Loc)),
           Statements => New_List (
-            Make_If_Statement (Loc,
+            Make_If_Statement (Data.Loc,
               Condition       =>
-                Make_Op_Not (Loc,
-                  Right_Opnd => New_Reference_To (Raised_Id, Loc)),
+                Make_Op_Not (Data.Loc,
+                  Right_Opnd => New_Reference_To (Data.Raised_Id, Data.Loc)),
 
               Then_Statements => New_List (
-                Make_Assignment_Statement (Loc,
-                  Name       => New_Reference_To (Raised_Id, Loc),
-                  Expression => New_Reference_To (Standard_True, Loc)),
+                Make_Assignment_Statement (Data.Loc,
+                  Name       => New_Reference_To (Data.Raised_Id, Data.Loc),
+                  Expression => New_Reference_To (Standard_True, Data.Loc)),
 
-                Make_Procedure_Call_Statement (Loc,
+                Make_Procedure_Call_Statement (Data.Loc,
                   Name                   =>
-                    New_Reference_To (Proc_To_Call, Loc),
+                    New_Reference_To (Proc_To_Call, Data.Loc),
                   Parameter_Associations => Actuals)))));
    end Build_Exception_Handler;
 
@@ -1052,21 +1051,14 @@ package body Exp_Ch7 is
       --  structures right from the start. Entities and lists are created once
       --  it has been established that N has at least one controlled object.
 
-      Abort_Id : Entity_Id := Empty;
-      --  Entity of local flag. The flag is set when finalization is triggered
-      --  by an abort.
-
       Components_Built : Boolean := False;
       --  A flag used to avoid double initialization of entities and lists. If
       --  the flag is set then the following variables have been initialized:
       --
-      --    Abort_Id
       --    Counter_Id
-      --    E_Id
       --    Finalizer_Decls
       --    Finalizer_Stmts
       --    Jump_Alts
-      --    Raised_Id
 
       Counter_Id  : Entity_Id := Empty;
       Counter_Val : Int       := 0;
@@ -1076,9 +1068,8 @@ package body Exp_Ch7 is
       --  Declarative region of N (if available). If N is a package declaration
       --  Decls denotes the visible declarations.
 
-      E_Id : Entity_Id := Empty;
-      --  Entity of the local exception occurence. The first exception which
-      --  occurred during finalization is stored in E_Id and later reraised.
+      Finalizer_Data : Finalization_Exception_Data;
+      --  Data for the exception
 
       Finalizer_Decls : List_Id := No_List;
       --  Local variable declarations. This list holds the label declarations
@@ -1140,10 +1131,6 @@ package body Exp_Ch7 is
       Priv_Decls : List_Id := No_List;
       --  The private declarations of N if N is a package declaration
 
-      Raised_Id : Entity_Id := Empty;
-      --  Entity for the raised flag. Along with E_Id, the flag is used in the
-      --  propagation of exceptions which occur during finalization.
-
       Spec_Id    : Entity_Id := Empty;
       Spec_Decls : List_Id   := Top_Decls;
       Stmts      : List_Id   := No_List;
@@ -1217,10 +1204,11 @@ package body Exp_Ch7 is
             Counter_Id  := Make_Temporary (Loc, 'C');
             Counter_Typ := Make_Temporary (Loc, 'T');
 
+            Finalizer_Decls := New_List;
+
             if Exceptions_OK then
-               Abort_Id  := Make_Temporary (Loc, 'A');
-               E_Id      := Make_Temporary (Loc, 'E');
-               Raised_Id := Make_Temporary (Loc, 'R');
+               Build_Object_Declarations
+                 (Finalizer_Data, Finalizer_Decls, Loc, For_Package);
             end if;
 
             --  Since the total number of controlled objects is always known,
@@ -1280,7 +1268,6 @@ package body Exp_Ch7 is
                Analyze (Counter_Decl);
             end if;
 
-            Finalizer_Decls := New_List;
             Jump_Alts := New_List;
          end if;
 
@@ -1442,7 +1429,7 @@ package body Exp_Ch7 is
               and then Exceptions_OK
             then
                Append_To (Finalizer_Stmts,
-                 Build_Raise_Statement (Loc, Abort_Id, E_Id, Raised_Id));
+                 Build_Raise_Statement (Finalizer_Data));
             end if;
 
             --  Create the jump block which controls the finalization flow
@@ -1533,14 +1520,6 @@ package body Exp_Ch7 is
          --       Abort_Undefer;             --  Added if abort is allowed
          --    end Fin_Id;
 
-         if Has_Ctrl_Objs
-           and then Exceptions_OK
-         then
-            Prepend_List_To (Finalizer_Decls,
-              Build_Object_Declarations
-                (Loc, Abort_Id, E_Id, Raised_Id, For_Package));
-         end if;
-
          --  Create the body of the finalizer
 
          Body_Id := Make_Defining_Identifier (Loc, Chars (Fin_Id));
@@ -2567,7 +2546,7 @@ package body Exp_Ch7 is
 
                     Exception_Handlers => New_List (
                       Build_Exception_Handler
-                        (Loc, E_Id, Raised_Id, For_Package)))));
+                        (Finalizer_Data, For_Package)))));
 
             --  When exception handlers are prohibited, the finalization call
             --  appears unprotected. Any exception raised during finalization
@@ -2940,27 +2919,29 @@ package body Exp_Ch7 is
    -- Build_Object_Declarations --
    -------------------------------
 
-   function Build_Object_Declarations
-     (Loc         : Source_Ptr;
-      Abort_Id    : Entity_Id;
-      E_Id        : Entity_Id;
-      Raised_Id   : Entity_Id;
-      For_Package : Boolean := False) return List_Id
+   procedure Build_Object_Declarations
+     (Data        : out Finalization_Exception_Data;
+      Decls       : List_Id;
+      Loc         : Source_Ptr;
+      For_Package : Boolean := False)
    is
       A_Expr : Node_Id;
       E_Decl : Node_Id;
-      Result : List_Id;
 
    begin
+      pragma Assert (Decls /= No_List);
+
       if Restriction_Active (No_Exception_Propagation) then
-         return Empty_List;
+         Data.Abort_Id := Empty;
+         Data.E_Id := Empty;
+         Data.Raised_Id := Empty;
+         return;
       end if;
 
-      pragma Assert (Present (Abort_Id));
-      pragma Assert (Present (E_Id));
-      pragma Assert (Present (Raised_Id));
-
-      Result := New_List;
+      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
@@ -2990,9 +2971,9 @@ package body Exp_Ch7 is
       --  Generate:
       --    Abort_Id : constant Boolean := <A_Expr>;
 
-      Append_To (Result,
+      Append_To (Decls,
         Make_Object_Declaration (Loc,
-          Defining_Identifier => Abort_Id,
+          Defining_Identifier => Data.Abort_Id,
           Constant_Present    => True,
           Object_Definition   => New_Reference_To (Standard_Boolean, Loc),
           Expression          => A_Expr));
@@ -3002,23 +2983,21 @@ package body Exp_Ch7 is
 
       E_Decl :=
         Make_Object_Declaration (Loc,
-          Defining_Identifier => E_Id,
+          Defining_Identifier => Data.E_Id,
           Object_Definition   =>
             New_Reference_To (RTE (RE_Exception_Occurrence), Loc));
       Set_No_Initialization (E_Decl);
 
-      Append_To (Result, E_Decl);
+      Append_To (Decls, E_Decl);
 
       --  Generate:
       --    Raised_Id : Boolean := False;
 
-      Append_To (Result,
+      Append_To (Decls,
         Make_Object_Declaration (Loc,
-          Defining_Identifier => Raised_Id,
+          Defining_Identifier => Data.Raised_Id,
           Object_Definition   => New_Reference_To (Standard_Boolean, Loc),
           Expression          => New_Reference_To (Standard_False, Loc)));
-
-      return Result;
    end Build_Object_Declarations;
 
    ---------------------------
@@ -3026,10 +3005,7 @@ package body Exp_Ch7 is
    ---------------------------
 
    function Build_Raise_Statement
-     (Loc       : Source_Ptr;
-      Abort_Id  : Entity_Id;
-      E_Id      : Entity_Id;
-      Raised_Id : Entity_Id) return Node_Id
+     (Data : Finalization_Exception_Data) return Node_Id
    is
       Stmt : Node_Id;
 
@@ -3039,12 +3015,12 @@ package body Exp_Ch7 is
 
       if RTE_Available (RE_Raise_From_Controlled_Operation) then
          Stmt :=
-           Make_Procedure_Call_Statement (Loc,
+           Make_Procedure_Call_Statement (Data.Loc,
               Name                   =>
                 New_Reference_To
-                  (RTE (RE_Raise_From_Controlled_Operation), Loc),
+                  (RTE (RE_Raise_From_Controlled_Operation), Data.Loc),
               Parameter_Associations =>
-                New_List (New_Reference_To (E_Id, Loc)));
+                New_List (New_Reference_To (Data.E_Id, Data.Loc)));
 
       --  Restricted runtime: exception messages are not supported and hence
       --  Raise_From_Controlled_Operation is not supported. Raise Program_Error
@@ -3052,7 +3028,7 @@ package body Exp_Ch7 is
 
       else
          Stmt :=
-           Make_Raise_Program_Error (Loc,
+           Make_Raise_Program_Error (Data.Loc,
              Reason => PE_Finalize_Raised_Exception);
       end if;
 
@@ -3064,13 +3040,13 @@ package body Exp_Ch7 is
       --    end if;
 
       return
-        Make_If_Statement (Loc,
+        Make_If_Statement (Data.Loc,
           Condition       =>
-            Make_And_Then (Loc,
-              Left_Opnd  => New_Reference_To (Raised_Id, Loc),
+            Make_And_Then (Data.Loc,
+              Left_Opnd  => New_Reference_To (Data.Raised_Id, Data.Loc),
               Right_Opnd =>
-                Make_Op_Not (Loc,
-                  Right_Opnd => New_Reference_To (Abort_Id, Loc))),
+                Make_Op_Not (Data.Loc,
+                  Right_Opnd => New_Reference_To (Data.Abort_Id, Data.Loc))),
 
           Then_Statements => New_List (Stmt));
    end Build_Raise_Statement;
@@ -4222,18 +4198,17 @@ package body Exp_Ch7 is
          Last_Object  : Node_Id;
          Related_Node : Node_Id)
       is
-         Abort_Id  : Entity_Id;
-         Built     : Boolean := False;
-         Desig     : Entity_Id;
-         E_Id      : Entity_Id;
-         Fin_Block : Node_Id;
-         Last_Fin  : Node_Id := Empty;
-         Loc       : Source_Ptr;
-         Obj_Id    : Entity_Id;
-         Obj_Ref   : Node_Id;
-         Obj_Typ   : Entity_Id;
-         Raised_Id : Entity_Id;
-         Stmt      : Node_Id;
+         Finalizer_Data  : Finalization_Exception_Data;
+         Finalizer_Decls : List_Id;
+         Built           : Boolean := False;
+         Desig           : Entity_Id;
+         Fin_Block       : Node_Id;
+         Last_Fin        : Node_Id := Empty;
+         Loc             : Source_Ptr;
+         Obj_Id          : Entity_Id;
+         Obj_Ref         : Node_Id;
+         Obj_Typ         : Entity_Id;
+         Stmt            : Node_Id;
 
       begin
          --  Examine all objects in the list First_Object .. Last_Object
@@ -4266,13 +4241,12 @@ package body Exp_Ch7 is
                --  time around.
 
                if not Built then
-                  Abort_Id  := Make_Temporary (Loc, 'A');
-                  E_Id      := Make_Temporary (Loc, 'E');
-                  Raised_Id := Make_Temporary (Loc, 'R');
+                  Finalizer_Decls := New_List;
+                  Build_Object_Declarations
+                      (Finalizer_Data, Finalizer_Decls, Loc);
 
-                  Insert_List_Before_And_Analyze (First_Object,
-                    Build_Object_Declarations
-                      (Loc, Abort_Id, E_Id, Raised_Id));
+                  Insert_List_Before_And_Analyze
+                    (First_Object, Finalizer_Decls);
 
                   Built := True;
                end if;
@@ -4306,7 +4280,7 @@ package body Exp_Ch7 is
                             Typ     => Desig)),
 
                        Exception_Handlers => New_List (
-                         Build_Exception_Handler (Loc, E_Id, Raised_Id))));
+                         Build_Exception_Handler (Finalizer_Data))));
                Insert_After_And_Analyze (Last_Object, Fin_Block);
 
                --  The raise statement must be inserted after all the
@@ -4371,7 +4345,7 @@ package body Exp_Ch7 is
            and then Present (Last_Fin)
          then
             Insert_After_And_Analyze (Last_Fin,
-              Build_Raise_Statement (Loc, Abort_Id, E_Id, Raised_Id));
+              Build_Raise_Statement (Finalizer_Data));
          end if;
       end Process_Transient_Objects;
 
@@ -4760,20 +4734,19 @@ package body Exp_Ch7 is
       function Build_Adjust_Or_Finalize_Statements
         (Typ : Entity_Id) return List_Id
       is
-         Comp_Typ   : constant Entity_Id  := Component_Type (Typ);
-         Index_List : constant List_Id    := New_List;
-         Loc        : constant Source_Ptr := Sloc (Typ);
-         Num_Dims   : constant Int        := Number_Dimensions (Typ);
-         Abort_Id   : Entity_Id := Empty;
-         Call       : Node_Id;
-         Comp_Ref   : Node_Id;
-         Core_Loop  : Node_Id;
-         Dim        : Int;
-         E_Id       : Entity_Id := Empty;
-         J          : Entity_Id;
-         Loop_Id    : Entity_Id;
-         Raised_Id  : Entity_Id := Empty;
-         Stmts      : List_Id;
+         Comp_Typ        : constant Entity_Id  := Component_Type (Typ);
+         Index_List      : constant List_Id    := New_List;
+         Loc             : constant Source_Ptr := Sloc (Typ);
+         Num_Dims        : constant Int        := Number_Dimensions (Typ);
+         Finalizer_Decls : List_Id := No_List;
+         Finalizer_Data  : Finalization_Exception_Data;
+         Call            : Node_Id;
+         Comp_Ref        : Node_Id;
+         Core_Loop       : Node_Id;
+         Dim             : Int;
+         J               : Entity_Id;
+         Loop_Id         : Entity_Id;
+         Stmts           : List_Id;
 
          Exceptions_OK : constant Boolean :=
                            not Restriction_Active (No_Exception_Propagation);
@@ -4802,9 +4775,8 @@ package body Exp_Ch7 is
          Build_Indices;
 
          if Exceptions_OK then
-            Abort_Id  := Make_Temporary (Loc, 'A');
-            E_Id      := Make_Temporary (Loc, 'E');
-            Raised_Id := Make_Temporary (Loc, 'R');
+            Finalizer_Decls := New_List;
+            Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
          end if;
 
          Comp_Ref :=
@@ -4848,7 +4820,7 @@ package body Exp_Ch7 is
                   Make_Handled_Sequence_Of_Statements (Loc,
                     Statements         => New_List (Call),
                     Exception_Handlers => New_List (
-                      Build_Exception_Handler (Loc, E_Id, Raised_Id))));
+                      Build_Exception_Handler (Finalizer_Data))));
          else
             Core_Loop := Call;
          end if;
@@ -4912,14 +4884,14 @@ package body Exp_Ch7 is
 
          if Exceptions_OK then
             Append_To (Stmts,
-              Build_Raise_Statement (Loc, Abort_Id, E_Id, Raised_Id));
+              Build_Raise_Statement (Finalizer_Data));
          end if;
 
          return
            New_List (
              Make_Block_Statement (Loc,
                Declarations               =>
-                 Build_Object_Declarations (Loc, Abort_Id, E_Id, Raised_Id),
+                 Finalizer_Decls,
                Handled_Statement_Sequence =>
                  Make_Handled_Sequence_Of_Statements (Loc, Stmts)));
       end Build_Adjust_Or_Finalize_Statements;
@@ -4929,24 +4901,23 @@ package body Exp_Ch7 is
       ---------------------------------
 
       function Build_Initialize_Statements (Typ : Entity_Id) return List_Id is
-         Comp_Typ    : constant Entity_Id  := Component_Type (Typ);
-         Final_List  : constant List_Id    := New_List;
-         Index_List  : constant List_Id    := New_List;
-         Loc         : constant Source_Ptr := Sloc (Typ);
-         Num_Dims    : constant Int        := Number_Dimensions (Typ);
-         Abort_Id    : Entity_Id;
-         Counter_Id  : Entity_Id;
-         Dim         : Int;
-         E_Id        : Entity_Id := Empty;
-         F           : Node_Id;
-         Fin_Stmt    : Node_Id;
-         Final_Block : Node_Id;
-         Final_Loop  : Node_Id;
-         Init_Loop   : Node_Id;
-         J           : Node_Id;
-         Loop_Id     : Node_Id;
-         Raised_Id   : Entity_Id := Empty;
-         Stmts       : List_Id;
+         Comp_Typ        : constant Entity_Id  := Component_Type (Typ);
+         Final_List      : constant List_Id    := New_List;
+         Index_List      : constant List_Id    := New_List;
+         Loc             : constant Source_Ptr := Sloc (Typ);
+         Num_Dims        : constant Int        := Number_Dimensions (Typ);
+         Counter_Id      : Entity_Id;
+         Dim             : Int;
+         F               : Node_Id;
+         Fin_Stmt        : Node_Id;
+         Final_Block     : Node_Id;
+         Final_Loop      : Node_Id;
+         Finalizer_Data  : Finalization_Exception_Data;
+         Finalizer_Decls : List_Id := No_List;
+         Init_Loop       : Node_Id;
+         J               : Node_Id;
+         Loop_Id         : Node_Id;
+         Stmts           : List_Id;
 
          Exceptions_OK : constant Boolean :=
                            not Restriction_Active (No_Exception_Propagation);
@@ -5081,9 +5052,8 @@ package body Exp_Ch7 is
          Counter_Id := Make_Temporary (Loc, 'C');
 
          if Exceptions_OK then
-            Abort_Id  := Make_Temporary (Loc, 'A');
-            E_Id      := Make_Temporary (Loc, 'E');
-            Raised_Id := Make_Temporary (Loc, 'R');
+            Finalizer_Decls := New_List;
+            Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
          end if;
 
          --  Generate the block which houses the finalization call, the index
@@ -5112,7 +5082,7 @@ package body Exp_Ch7 is
                   Make_Handled_Sequence_Of_Statements (Loc,
                     Statements         => New_List (Build_Finalization_Call),
                     Exception_Handlers => New_List (
-                      Build_Exception_Handler (Loc, E_Id, Raised_Id))));
+                      Build_Exception_Handler (Finalizer_Data))));
          else
             Fin_Stmt := Build_Finalization_Call;
          end if;
@@ -5204,14 +5174,14 @@ package body Exp_Ch7 is
 
          if Exceptions_OK then
             Append_To (Stmts,
-              Build_Raise_Statement (Loc, Abort_Id, E_Id, Raised_Id));
+              Build_Raise_Statement (Finalizer_Data));
             Append_To (Stmts, Make_Raise_Statement (Loc));
          end if;
 
          Final_Block :=
            Make_Block_Statement (Loc,
              Declarations               =>
-               Build_Object_Declarations (Loc, Abort_Id, E_Id, Raised_Id),
+               Finalizer_Decls,
              Handled_Statement_Sequence =>
                Make_Handled_Sequence_Of_Statements (Loc, Statements => Stmts));
 
@@ -5583,14 +5553,13 @@ package body Exp_Ch7 is
       -----------------------------
 
       function Build_Adjust_Statements (Typ : Entity_Id) return List_Id is
-         Loc       : constant Source_Ptr := Sloc (Typ);
-         Typ_Def   : constant Node_Id := Type_Definition (Parent (Typ));
-         Abort_Id  : Entity_Id := Empty;
-         Bod_Stmts : List_Id;
-         E_Id      : Entity_Id := Empty;
-         Raised_Id : Entity_Id := Empty;
-         Rec_Def   : Node_Id;
-         Var_Case  : Node_Id;
+         Loc             : constant Source_Ptr := Sloc (Typ);
+         Typ_Def         : constant Node_Id := Type_Definition (Parent (Typ));
+         Bod_Stmts       : List_Id;
+         Finalizer_Data  : Finalization_Exception_Data;
+         Finalizer_Decls : List_Id := No_List;
+         Rec_Def         : Node_Id;
+         Var_Case        : Node_Id;
 
          Exceptions_OK : constant Boolean :=
                            not Restriction_Active (No_Exception_Propagation);
@@ -5654,7 +5623,7 @@ package body Exp_Ch7 is
                         Make_Handled_Sequence_Of_Statements (Loc,
                           Statements         => New_List (Adj_Stmt),
                           Exception_Handlers => New_List (
-                            Build_Exception_Handler (Loc, E_Id, Raised_Id))));
+                            Build_Exception_Handler (Finalizer_Data))));
                end if;
 
                Append_To (Stmts, Adj_Stmt);
@@ -5792,9 +5761,8 @@ package body Exp_Ch7 is
 
       begin
          if Exceptions_OK then
-            Abort_Id  := Make_Temporary (Loc, 'A');
-            E_Id      := Make_Temporary (Loc, 'E');
-            Raised_Id := Make_Temporary (Loc, 'R');
+            Finalizer_Decls := New_List;
+            Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
          end if;
 
          if Nkind (Typ_Def) = N_Derived_Type_Definition then
@@ -5891,7 +5859,7 @@ package body Exp_Ch7 is
                                 Statements         => New_List (Adj_Stmt),
                                 Exception_Handlers => New_List (
                                   Build_Exception_Handler
-                                    (Loc, E_Id, Raised_Id))));
+                                    (Finalizer_Data))));
                      end if;
 
                      Prepend_To (Bod_Stmts, Adj_Stmt);
@@ -5942,7 +5910,7 @@ package body Exp_Ch7 is
                              Statements         => New_List (Adj_Stmt),
                              Exception_Handlers => New_List (
                                Build_Exception_Handler
-                                 (Loc, E_Id, Raised_Id))));
+                                 (Finalizer_Data))));
                   end if;
 
                   Append_To (Bod_Stmts,
@@ -5981,14 +5949,14 @@ package body Exp_Ch7 is
          else
             if Exceptions_OK then
                Append_To (Bod_Stmts,
-                 Build_Raise_Statement (Loc, Abort_Id, E_Id, Raised_Id));
+                 Build_Raise_Statement (Finalizer_Data));
             end if;
 
             return
               New_List (
                 Make_Block_Statement (Loc,
                   Declarations               =>
-                    Build_Object_Declarations (Loc, Abort_Id, E_Id, Raised_Id),
+                    Finalizer_Decls,
                   Handled_Statement_Sequence =>
                     Make_Handled_Sequence_Of_Statements (Loc, Bod_Stmts)));
          end if;
@@ -5999,15 +5967,14 @@ package body Exp_Ch7 is
       -------------------------------
 
       function Build_Finalize_Statements (Typ : Entity_Id) return List_Id is
-         Loc       : constant Source_Ptr := Sloc (Typ);
-         Typ_Def   : constant Node_Id := Type_Definition (Parent (Typ));
-         Abort_Id  : Entity_Id := Empty;
-         Bod_Stmts : List_Id;
-         Counter   : Int := 0;
-         E_Id      : Entity_Id := Empty;
-         Raised_Id : Entity_Id := Empty;
-         Rec_Def   : Node_Id;
-         Var_Case  : Node_Id;
+         Loc             : constant Source_Ptr := Sloc (Typ);
+         Typ_Def         : constant Node_Id := Type_Definition (Parent (Typ));
+         Bod_Stmts       : List_Id;
+         Counter         : Int := 0;
+         Finalizer_Data  : Finalization_Exception_Data;
+         Finalizer_Decls : List_Id := No_List;
+         Rec_Def         : Node_Id;
+         Var_Case        : Node_Id;
 
          Exceptions_OK : constant Boolean :=
                            not Restriction_Active (No_Exception_Propagation);
@@ -6140,7 +6107,7 @@ package body Exp_Ch7 is
                         Make_Handled_Sequence_Of_Statements (Loc,
                           Statements         => New_List (Fin_Stmt),
                           Exception_Handlers => New_List (
-                            Build_Exception_Handler (Loc, E_Id, Raised_Id))));
+                            Build_Exception_Handler (Finalizer_Data))));
                end if;
 
                Append_To (Stmts, Fin_Stmt);
@@ -6372,9 +6339,8 @@ package body Exp_Ch7 is
 
       begin
          if Exceptions_OK then
-            Abort_Id  := Make_Temporary (Loc, 'A');
-            E_Id      := Make_Temporary (Loc, 'E');
-            Raised_Id := Make_Temporary (Loc, 'R');
+            Finalizer_Decls := New_List;
+            Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
          end if;
 
          if Nkind (Typ_Def) = N_Derived_Type_Definition then
@@ -6473,7 +6439,7 @@ package body Exp_Ch7 is
                                 Statements         => New_List (Fin_Stmt),
                                 Exception_Handlers => New_List (
                                   Build_Exception_Handler
-                                    (Loc, E_Id, Raised_Id))));
+                                    (Finalizer_Data))));
                      end if;
 
                      Append_To (Bod_Stmts, Fin_Stmt);
@@ -6526,7 +6492,7 @@ package body Exp_Ch7 is
                              Statements         => New_List (Fin_Stmt),
                              Exception_Handlers => New_List (
                                Build_Exception_Handler
-                                 (Loc, E_Id, Raised_Id))));
+                                 (Finalizer_Data))));
                   end if;
 
                   Prepend_To (Bod_Stmts,
@@ -6563,14 +6529,14 @@ package body Exp_Ch7 is
          else
             if Exceptions_OK then
                Append_To (Bod_Stmts,
-                 Build_Raise_Statement (Loc, Abort_Id, E_Id, Raised_Id));
+                 Build_Raise_Statement (Finalizer_Data));
             end if;
 
             return
               New_List (
                 Make_Block_Statement (Loc,
                   Declarations               =>
-                    Build_Object_Declarations (Loc, Abort_Id, E_Id, Raised_Id),
+                    Finalizer_Decls,
                   Handled_Statement_Sequence =>
                     Make_Handled_Sequence_Of_Statements (Loc, Bod_Stmts)));
          end if;
diff --git a/gcc/ada/exp_ch7.ads b/gcc/ada/exp_ch7.ads
index dbebd8ae52a..8a0be81bac2 100644
--- a/gcc/ada/exp_ch7.ads
+++ b/gcc/ada/exp_ch7.ads
@@ -40,10 +40,39 @@ 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;
+   --  Support of exceptions from user finalization procedures
+   --
+   --  There is a specific mechanism to handle these exceptions, continue
+   --  finalization and then raise PE.
+   --  This mechanism is used by this package but also by exp_intr for
+   --  Ada.Unchecked_Deallocation.
+   --  There are 3 subprograms to use this mechanism, and the type
+   --  Finalization_Exception_Data carries internal data between these
+   --  subprograms:
+   --
+   --  1. Build_Object_Declaration: create the variables for the next two
+   --  subprograms.
+   --  2. Build_Exception_Handler: create the exception handler for a call to
+   --  a user finalization procedure.
+   --  3. Build_Raise_Stmt: create the code to potentially raise a PE exception
+   --  if am exception was raise in a user finalization procedure.
+   type Finalization_Exception_Data is record
+      Loc         : Source_Ptr;
+      --  Sloc for the added nodes
+
+      Abort_Id    : Entity_Id;
+      --  Boolean variable set to true if the finalization was triggered by
+      --  an abort.
+
       E_Id        : Entity_Id;
+      --  Variable containing the exception occurrence raised by user code
+
       Raised_Id   : Entity_Id;
+      --  Boolean variable set to true if an exception was raised in user code
+   end record;
+
+   function Build_Exception_Handler
+     (Data        : Finalization_Exception_Data;
       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:
@@ -84,15 +113,14 @@ package Exp_Ch7 is
    --  Build one controlling procedure when a late body overrides one of
    --  the controlling operations.
 
-   function Build_Object_Declarations
-     (Loc         : Source_Ptr;
-      Abort_Id    : Entity_Id;
-      E_Id        : Entity_Id;
-      Raised_Id   : Entity_Id;
-      For_Package : Boolean := False) return List_Id;
-   --  Subsidiary to Make_Deep_Array_Body and Make_Deep_Record_Body. Return a
-   --  list containing the object declarations of boolean flag Abort_Id, the
-   --  exception occurrence E_Id and boolean flag Raised_Id.
+   procedure Build_Object_Declarations
+     (Data        : out Finalization_Exception_Data;
+      Decls       : List_Id;
+      Loc         : Source_Ptr;
+      For_Package : Boolean := False);
+   --  Subsidiary to Make_Deep_Array_Body and Make_Deep_Record_Body. Create the
+   --  list List containing the object declarations of boolean flag Abort_Id,
+   --  the exception occurrence E_Id and boolean flag Raised_Id.
    --
    --    Abort_Id  : constant Boolean :=
    --                  Exception_Identity (Get_Current_Excep.all) =
@@ -104,10 +132,7 @@ package Exp_Ch7 is
    --    Raised_Id : Boolean := False;
 
    function Build_Raise_Statement
-     (Loc       : Source_Ptr;
-      Abort_Id  : Entity_Id;
-      E_Id      : Entity_Id;
-      Raised_Id : Entity_Id) return Node_Id;
+     (Data : Finalization_Exception_Data) return Node_Id;
    --  Subsidiary to routines Build_Finalizer, Make_Deep_Array_Body and Make_
    --  Deep_Record_Body. Generate the following conditional raise statement:
    --
diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb
index 07035478bff..16325829314 100644
--- a/gcc/ada/exp_intr.adb
+++ b/gcc/ada/exp_intr.adb
@@ -876,23 +876,23 @@ package body Exp_Intr is
    --  structures to find and terminate those components.
 
    procedure Expand_Unc_Deallocation (N : Node_Id) is
-      Arg     : constant Node_Id    := First_Actual (N);
-      Loc     : constant Source_Ptr := Sloc (N);
-      Typ     : constant Entity_Id  := Etype (Arg);
-      Desig_T : constant Entity_Id  := Designated_Type (Typ);
-      Rtyp    : constant Entity_Id  := Underlying_Type (Root_Type (Typ));
-      Pool    : constant Entity_Id  := Associated_Storage_Pool (Rtyp);
-      Stmts   : constant List_Id    := New_List;
-
-      Abort_Id   : Entity_Id := Empty;
+      Arg       : constant Node_Id    := First_Actual (N);
+      Loc       : constant Source_Ptr := Sloc (N);
+      Typ       : constant Entity_Id  := Etype (Arg);
+      Desig_T   : constant Entity_Id  := Designated_Type (Typ);
+      Rtyp      : constant Entity_Id  := Underlying_Type (Root_Type (Typ));
+      Pool      : constant Entity_Id  := Associated_Storage_Pool (Rtyp);
+      Stmts     : constant List_Id    := New_List;
+      Needs_Fin : constant Boolean    := Needs_Finalization (Desig_T);
+
+      Finalizer_Data  : Finalization_Exception_Data;
+
       Blk        : Node_Id := Empty;
       Deref      : Node_Id;
-      E_Id       : Entity_Id := Empty;
       Final_Code : List_Id;
       Free_Arg   : Node_Id;
       Free_Node  : Node_Id;
       Gen_Code   : Node_Id;
-      Raised_Id  : Entity_Id := Empty;
 
       Arg_Known_Non_Null : constant Boolean := Known_Non_Null (N);
       --  This captures whether we know the argument to be non-null so that
@@ -909,7 +909,7 @@ package body Exp_Intr is
 
       --  Processing for pointer to controlled type
 
-      if Needs_Finalization (Desig_T) then
+      if Needs_Fin then
          Deref :=
            Make_Explicit_Dereference (Loc,
              Prefix => Duplicate_Subexpr_No_Checks (Arg));
@@ -958,12 +958,7 @@ package body Exp_Intr is
          --          Save_Occurrence (E, Get_Current_Excep.all.all);
          --    end;
 
-         Abort_Id  := Make_Temporary (Loc, 'A');
-         E_Id      := Make_Temporary (Loc, 'E');
-         Raised_Id := Make_Temporary (Loc, 'R');
-
-         Append_List_To (Stmts,
-            Build_Object_Declarations (Loc, Abort_Id, E_Id, Raised_Id));
+         Build_Object_Declarations (Finalizer_Data, Stmts, Loc);
 
          Final_Code := New_List (
            Make_Block_Statement (Loc,
@@ -974,7 +969,7 @@ package body Exp_Intr is
                      Obj_Ref => Deref,
                      Typ     => Desig_T)),
                  Exception_Handlers => New_List (
-                   Build_Exception_Handler (Loc, E_Id, Raised_Id)))));
+                   Build_Exception_Handler (Finalizer_Data)))));
 
          --  For .NET/JVM, detach the object from the containing finalization
          --  collection before finalizing it.
@@ -1216,9 +1211,8 @@ package body Exp_Intr is
       --       Raise_From_Controlled_Operation (E);  --  all other cases
       --    end if;
 
-      if Present (Raised_Id) then
-         Append_To (Stmts,
-           Build_Raise_Statement (Loc, Abort_Id, E_Id, Raised_Id));
+      if Needs_Fin then
+         Append_To (Stmts, Build_Raise_Statement (Finalizer_Data));
       end if;
 
       --  If we know the argument is non-null, then make a block statement
diff --git a/gcc/ada/lib-xref-alfa.adb b/gcc/ada/lib-xref-alfa.adb
index 81331eb4b1a..25b7b79797c 100644
--- a/gcc/ada/lib-xref-alfa.adb
+++ b/gcc/ada/lib-xref-alfa.adb
@@ -886,14 +886,7 @@ package body Alfa is
       --  Generate file and scope Alfa information
 
       for D in 1 .. Num_Sdep loop
-
-         --  Ignore file for System
-
-         if Units.Table (Sdep_Table (D)).Source_Index /=
-           System_Source_File_Index
-         then
-            Add_Alfa_File (U => Sdep_Table (D), D => D);
-         end if;
+         Add_Alfa_File (U => Sdep_Table (D), D => D);
       end loop;
 
       --  Fill in the spec information when relevant
diff --git a/gcc/ada/projects.texi b/gcc/ada/projects.texi
index 2a3e5bc0d8d..6f87ba5a011 100644
--- a/gcc/ada/projects.texi
+++ b/gcc/ada/projects.texi
@@ -985,7 +985,6 @@ The following attributes can be defined in package @code{Naming}:
   other than Ada. They are indexed on the language name, and contain
   a list of file names respectively for headers and source code.
 
-
 @end table
 
 @ifclear vms
@@ -1315,7 +1314,6 @@ There are two main approaches to avoiding this duplication:
   more qualifiers).
 @end itemize
 
-
 @c ---------------------------------------------
 @node Global Attributes
 @subsection Global Attributes
@@ -1649,7 +1647,6 @@ Other library-related attributes can be used to change the defaults:
   upon this subsystem.
 @end table
 
-
 @c ---------------------------------------------
 @node Using Library Projects
 @subsection Using Library Projects
@@ -1873,7 +1870,6 @@ included in the library.
   must exist in the object directory.
 @end table
 
-
 @c ---------------------------------------------
 @node Installing a library with project files
 @subsection Installing a library with project files
@@ -2270,7 +2266,6 @@ aggregate project Agg is
     for Project_Files use ("myproject.gpr");
 end Agg;
 
-
 with "prj.gpr";  --  searched on Agg'Project_Path
 project MyProject is
    ...
@@ -2777,7 +2772,6 @@ The current list of qualifiers is:
   It describes compilers and other tools to @code{gprbuild}.
 @end table
 
-
 @c ---------------------------------------------
 @node Declarations
 @subsection Declarations
@@ -3226,7 +3220,6 @@ A @b{context} may be one of the following:
   whose selector is a package name in that project.
 @end itemize
 
-
 @c ---------------------------------------------
 @node Attributes
 @subsection Attributes
@@ -3547,7 +3540,6 @@ end MyProj;
 
 @noindent
 
-
 @menu
 * gnatmake and Project Files::
 * The GNAT Driver and Project Files::
@@ -4049,7 +4041,6 @@ When a library project file is specified, switches ^-b^/ACTION=BIND^ and
   (in the case of a stand-alone library) and that the library should be built.
 @end itemize
 
-
 @c ---------------------------------------------
 @node The GNAT Driver and Project Files
 @section The GNAT Driver and Project Files
@@ -4490,6 +4481,3 @@ The switches for GPRclean are:
 @item @option{-Xnm=val} : Specify an external reference for Project Files.
 
 @end itemize
-
-
-
diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb
index 18606165dd1..1bfe1568d71 100644
--- a/gcc/ada/restrict.adb
+++ b/gcc/ada/restrict.adb
@@ -117,7 +117,7 @@ package body Restrict is
       Msg_Issued          : Boolean;
       Save_Error_Msg_Sloc : Source_Ptr;
    begin
-      if Force or else Comes_From_Source (N) then
+      if Force or else Comes_From_Source (Original_Node (N)) then
 
          if Restriction_Check_Required (SPARK)
            and then Is_In_Hidden_Part_In_SPARK (Sloc (N))
@@ -145,7 +145,7 @@ package body Restrict is
    begin
       pragma Assert (Msg2'Length /= 0 and then Msg2 (Msg2'First) = '\');
 
-      if Comes_From_Source (N) then
+      if Comes_From_Source (Original_Node (N)) then
 
          if Restriction_Check_Required (SPARK)
            and then Is_In_Hidden_Part_In_SPARK (Sloc (N))
diff --git a/gcc/ada/s-rannum.adb b/gcc/ada/s-rannum.adb
index d85dd2efacf..d0b14fdf9db 100644
--- a/gcc/ada/s-rannum.adb
+++ b/gcc/ada/s-rannum.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2007-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2007-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- --
@@ -86,8 +86,8 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with Ada.Calendar;             use Ada.Calendar;
 with Ada.Unchecked_Conversion;
+with System.Random_Seed;
 
 with Interfaces; use Interfaces;
 
@@ -95,11 +95,6 @@ use Ada;
 
 package body System.Random_Numbers is
 
-   Y2K : constant Calendar.Time :=
-           Calendar.Time_Of
-             (Year => 2000, Month => 1, Day => 1, Seconds => 0.0);
-   --  First day of Year 2000 (what is this for???)
-
    Image_Numeral_Length : constant := Max_Image_Width / N;
    subtype Image_String is String (1 .. Max_Image_Width);
 
@@ -484,11 +479,9 @@ package body System.Random_Numbers is
    -----------
 
    procedure Reset (Gen : Generator) is
-      Clock              : constant Time := Calendar.Clock;
-      Duration_Since_Y2K : constant Duration := Clock - Y2K;
-
       X : constant Unsigned_32 :=
-            Unsigned_32'Mod (Unsigned_64 (Duration_Since_Y2K) * 64);
+           Unsigned_32'Mod (Unsigned_64 (Random_Seed.Get_Seed) * 64);
+      --  Why * 64 ???
 
    begin
       Init (Gen, X);
diff --git a/gcc/ada/s-ransee.adb b/gcc/ada/s-ransee.adb
new file mode 100644
index 00000000000..dec22dbf4dc
--- /dev/null
+++ b/gcc/ada/s-ransee.adb
@@ -0,0 +1,45 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--                  S Y S T E M . R A N D O M _ S E E D                     --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--               Copyright (C) 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Ada.Calendar; use Ada.Calendar;
+
+package body System.Random_Seed is
+
+   Y2K : constant Time :=
+           Time_Of (Year => 2000, Month => 1, Day => 1, Seconds => 0.0);
+   --  First day of Year 2000, to get a duration.
+
+   function Get_Seed return Duration is
+   begin
+      return Clock - Y2K;
+   end Get_Seed;
+
+end System.Random_Seed;
diff --git a/gcc/ada/s-ransee.ads b/gcc/ada/s-ransee.ads
new file mode 100644
index 00000000000..7a2dedd7e12
--- /dev/null
+++ b/gcc/ada/s-ransee.ads
@@ -0,0 +1,45 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--                  S Y S T E M . R A N D O M _ S E E D                     --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--               Copyright (C) 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This package provide a seed for pseudo-random number generation using
+--  the clock.
+--  There are two separate implementations of this package:
+--  o  one based on Ada.Calendar
+--  o  one based on Ada.Real_Time
+--  This is required because Ada.Calendar cannot be used on ravenscar, but
+--  Ada.Real_Time drags the tasking runtime on regular platforms.
+
+package System.Random_Seed is
+
+   function Get_Seed return Duration;
+   --  Get a seed based on the clock
+
+end System.Random_Seed;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index e7ec37e7c7d..25134b6dc7c 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -11340,7 +11340,10 @@ package body Sem_Ch3 is
       Related_Id  : Entity_Id;
       Suffix      : Character)
    is
-      T_Ent : Entity_Id := Entity (Subtype_Mark (SI));
+      --  Retrieve Base_Type to ensure getting to the concurrent type in the
+      --  case of a private subtype (needed when only doing semantic analysis).
+
+      T_Ent : Entity_Id := Base_Type (Entity (Subtype_Mark (SI)));
       T_Val : Entity_Id;
 
    begin
@@ -18570,9 +18573,11 @@ package body Sem_Ch3 is
             return Process_Subtype (S, Related_Nod, Related_Id, Suffix);
          end if;
 
-         --  Remaining processing depends on type
+         --  Remaining processing depends on type. Select on Base_Type kind to
+         --  ensure getting to the concrete type kind in the case of a private
+         --  subtype (needed when only doing semantic analysis).
 
-         case Ekind (Subtype_Mark_Id) is
+         case Ekind (Base_Type (Subtype_Mark_Id)) is
             when Access_Kind =>
                Constrain_Access (Def_Id, S, Related_Nod);
 
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index f26c6ee687d..3f03aeea506 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -1763,7 +1763,9 @@ package body Sem_Ch4 is
    --  Start of processing for Analyze_Explicit_Dereference
 
    begin
-      Check_SPARK_Restriction ("explicit dereference is not allowed", N);
+      if Comes_From_Source (N) then
+         Check_SPARK_Restriction ("explicit dereference is not allowed", N);
+      end if;
 
       --  In formal verification mode, keep track of all reads and writes
       --  through explicit dereferences.
@@ -4417,7 +4419,9 @@ package body Sem_Ch4 is
    --  Start of processing for Analyze_Slice
 
    begin
-      Check_SPARK_Restriction ("slice is not allowed", N);
+      if Comes_From_Source (N) then
+         Check_SPARK_Restriction ("slice is not allowed", N);
+      end if;
 
       Analyze (P);
       Analyze (D);
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index c9c246311ea..ccd431fb651 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -1965,6 +1965,7 @@ package body Sem_Ch5 is
 
             begin
                Enter_Name (Id);
+               Set_Ekind (Id, E_Constant);
 
                --  We always consider the loop variable to be referenced, since
                --  the loop may be used just for counting purposes.
@@ -2243,7 +2244,14 @@ package body Sem_Ch5 is
       Typ : Entity_Id;
 
    begin
-      Enter_Name (Def_Id);
+      --  In semantics mode, introduce loop variable so that
+      --  loop body can be properly analyzed. Otherwise this
+      --  is one after expansion.
+
+      if Operating_Mode = Check_Semantics then
+         Enter_Name (Def_Id);
+      end if;
+
       Set_Ekind (Def_Id, E_Variable);
 
       if Present (Subt) then
@@ -2326,6 +2334,10 @@ package body Sem_Ch5 is
          else
             Error_Msg_N
               ("to iterate over the elements of an array, use OF", N);
+
+            --  Prevent cascaded errors.
+
+            Set_Ekind (Def_Id, E_Constant);
             Set_Etype (Def_Id, Etype (First_Index (Typ)));
          end if;
 
@@ -2476,12 +2488,26 @@ package body Sem_Ch5 is
 
       --  If the expander is not active, then we want to analyze the loop body
       --  now even in the Ada 2012 iterator case, since the rewriting will not
-      --  be done.
+      --  be done. Insert the loop variable in the current scope, if not done
+      --  when analysing the iteration scheme.
 
       if No (Iter)
         or else No (Iterator_Specification (Iter))
         or else not Expander_Active
       then
+         if Present (Iter)
+           and then  Present (Iterator_Specification (Iter))
+         then
+            declare
+               Id : constant Entity_Id :=
+                  Defining_Identifier (Iterator_Specification (Iter));
+            begin
+               if Scope (Id) /= Current_Scope then
+                  Enter_Name (Id);
+               end if;
+            end;
+         end if;
+
          Analyze_Statements (Statements (Loop_Statement));
       end if;
 
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 85cdc2a2ab3..b4d58495df6 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -1350,12 +1350,14 @@ package body Sem_Ch6 is
          Result : Entity_Id := Empty;
 
       begin
-         --  Loop outward through the Scope_Stack, skipping blocks and loops
+         --  Loop outward through the Scope_Stack, skipping blocks, loops,
+         --  and postconditions.
 
          for J in reverse 0 .. Scope_Stack.Last loop
             Result := Scope_Stack.Table (J).Entity;
-            exit when Ekind (Result) /= E_Block and then
-                      Ekind (Result) /= E_Loop;
+            exit when Ekind (Result) /= E_Block
+              and then Ekind (Result) /= E_Loop
+            and then Chars (Result) /= Name_uPostconditions;
          end loop;
 
          pragma Assert (Present (Result));
diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index 7e64d98cd67..fb20b1a6554 100644
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -1156,11 +1156,14 @@ package body Sem_Disp is
             --  Ada 2005 (AI-251): In case of late overriding of a primitive
             --  that covers abstract interface subprograms we must register it
             --  in all the secondary dispatch tables associated with abstract
-            --  interfaces. We do this now only if not building static tables.
-            --  Otherwise the patch code is emitted after those tables are
-            --  built, to prevent access_before_elaboration in gigi.
-
-            if Body_Is_Last_Primitive then
+            --  interfaces. We do this now only if not building static tables,
+            --  nor when the expander is inactive (we avoid trying to register
+            --  primitives in semantics-only mode, since the type may not have
+            --  an associated dispatch table). Otherwise the patch code is
+            --  emitted after those tables are built, to prevent access before
+            --  elaboration in gigi.
+
+            if Body_Is_Last_Primitive and then Full_Expander_Active then
                declare
                   Subp_Body : constant Node_Id := Unit_Declaration_Node (Subp);
                   Elmt      : Elmt_Id;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 1fa9376a714..7b1fd550067 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -5090,9 +5090,9 @@ package body Sem_Prag is
       --  Start of processing for Process_Restrictions_Or_Restriction_Warnings
 
       begin
-         --  Ignore all Restrictions pragma in CodePeer and Alfa modes
+         --  Ignore all Restrictions pragma in CodePeer mode
 
-         if CodePeer_Mode or Alfa_Mode then
+         if CodePeer_Mode then
             return;
          end if;
 
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 06a89a2b8ae..fbc72a8cafa 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -12656,6 +12656,11 @@ package body Sem_Util is
 
    begin
       case Ekind (E) is
+         when E_Constant =>
+            if Present (Full_View (E)) then
+               U := Full_View (E);
+            end if;
+
          when Type_Kind =>
             if Present (Full_View (E)) then
                U := Full_View (E);
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 97d8e80825b..fc408b31a4a 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -1448,7 +1448,8 @@ package Sem_Util is
    --  views of the same entity have the same unique defining entity:
    --  * package spec and body;
    --  * subprogram declaration, subprogram stub and subprogram body;
-   --  * private view and full view of a type.
+   --  * private view and full view of a type;
+   --  * private view and full view of a deferred constant.
    --  In other cases, return the defining entity for N.
 
    function Unique_Entity (E : Entity_Id) return Entity_Id;