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

1 files changed, 16 insertions, 22 deletions

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