[multiple changes]

2011-08-03  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch13.adb: Add with and use clauses for Restrict and Rident.
	(Expand_N_Free_Statement): Add a guard to protect against run-times
	which do not support controlled types.
	* exp_ch3.adb (Expand_Freeze_Class_Wide_Type): Add a guard to protect
	against run-times which do not support controlled types.
	* exp_ch4.adb (Complete_Controlled_Allocation): Add a guard to protect
	against run-times which do not support controlled types.
	* exp_ch7.adb (Build_Finalization_Collection): Add a guard to protect
	against run-times which do not support controlled types.
	* exp_util.adb (Needs_Finalization): Code reformatting. Add a guard to
	protect against run-times which do not support controlled types.

2011-08-03  Eric Botcazou  <ebotcazou@adacore.com>

	* exp_intr.adb: Put back with and use clauses for Exp_Ch11.
	(Expand_Unc_Deallocation): Expand the AT_END handler at the very end.

From-SVN: r177280

7 files changed, 81 insertions, 14 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 9cf21ed..6abd410 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,22 @@
+2011-08-03  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch13.adb: Add with and use clauses for Restrict and Rident.
+	(Expand_N_Free_Statement): Add a guard to protect against run-times
+	which do not support controlled types.
+	* exp_ch3.adb (Expand_Freeze_Class_Wide_Type): Add a guard to protect
+	against run-times which do not support controlled types.
+	* exp_ch4.adb (Complete_Controlled_Allocation): Add a guard to protect
+	against run-times which do not support controlled types.
+	* exp_ch7.adb (Build_Finalization_Collection): Add a guard to protect
+	against run-times which do not support controlled types.
+	* exp_util.adb (Needs_Finalization): Code reformatting. Add a guard to
+	protect against run-times which do not support controlled types.
+
+2011-08-03  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* exp_intr.adb: Put back with and use clauses for Exp_Ch11.
+	(Expand_Unc_Deallocation): Expand the AT_END handler at the very end.
+
 2011-08-03  Ed Schonberg  <schonberg@adacore.com>
 
 	* exp_ch5.adb (Expand_Iterator_Loop): indicate that the cursor is
diff --git a/gcc/ada/exp_ch13.adb b/gcc/ada/exp_ch13.adb
index 0af6519..761a281 100644
--- a/gcc/ada/exp_ch13.adb
+++ b/gcc/ada/exp_ch13.adb
@@ -35,6 +35,8 @@ with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
 with Opt;      use Opt;
+with Restrict; use Restrict;
+with Rident;   use Rident;
 with Rtsfind;  use Rtsfind;
 with Sem;      use Sem;
 with Sem_Ch7;  use Sem_Ch7;
@@ -215,10 +217,16 @@ package body Exp_Ch13 is
       Typ  : Entity_Id := Etype (Expr);
 
    begin
+      --  Certain run-time configurations and targets do not provide support
+      --  for controlled types.
+
+      if Restriction_Active (No_Finalization) then
+         return;
+
       --  Do not create a specialized Deallocate since .NET/JVM compilers do
       --  not support pools and address arithmetic.
 
-      if VM_Target /= No_VM then
+      elsif VM_Target /= No_VM then
          return;
       end if;
 
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 682ae94..6c98ef8 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -5574,11 +5574,17 @@ package body Exp_Ch3 is
    --  Start of processing for Expand_Freeze_Class_Wide_Type
 
    begin
+      --  Certain run-time configurations and targets do not provide support
+      --  for controlled types.
+
+      if Restriction_Active (No_Finalization) then
+         return;
+
       --  Do not create TSS routine Finalize_Address for concurrent class-wide
       --  types. Ignore C, C++, CIL and Java types since it is assumed that the
       --  non-Ada side will handle their destruction.
 
-      if Is_Concurrent_Type (Root)
+      elsif Is_Concurrent_Type (Root)
         or else Is_C_Derivation (Root)
         or else Convention (Typ) = Convention_CIL
         or else Convention (Typ) = Convention_CPP
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index fb7f3b0..58516cd 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -427,9 +427,15 @@ package body Exp_Ch4 is
    --  Start of processing for Complete_Controlled_Allocation
 
    begin
+      --  Certain run-time configurations and targets do not provide support
+      --  for controlled types.
+
+      if Restriction_Active (No_Finalization) then
+         return;
+
       --  Do nothing if the access type may never allocate an object
 
-      if No_Pool_Assigned (Ptr_Typ) then
+      elsif No_Pool_Assigned (Ptr_Typ) then
          return;
 
       --  Access-to-controlled types are not supported on .NET/JVM
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index e72c19b..0099269 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -855,7 +855,16 @@ package body Exp_Ch7 is
    --  Start of processing for Build_Finalization_Collection
 
    begin
-      if Present (Associated_Collection (Typ)) then
+      --  Certain run-time configurations and targets do not provide support
+      --  for controlled types.
+
+      if Restriction_Active (No_Finalization) then
+         return;
+
+      --  Various machinery such as freezing may have already created a
+      --  collection.
+
+      elsif Present (Associated_Collection (Typ)) then
          return;
 
       --  Do not process types that return on the secondary stack
@@ -2077,6 +2086,7 @@ package body Exp_Ch7 is
          Is_Protected : Boolean := False)
       is
          Obj_Id    : constant Entity_Id := Defining_Identifier (Decl);
+         Loc       : constant Source_Ptr := Sloc (Decl);
          Body_Ins  : Node_Id;
          Count_Ins : Node_Id;
          Fin_Call  : Node_Id;
@@ -2926,11 +2936,13 @@ package body Exp_Ch7 is
          Raise_Id := RTE (RE_Reraise_Occurrence);
 
       --  Standard run-time library
+
       elsif RTE_Available (RE_Raise_From_Controlled_Operation) then
          Raise_Id := RTE (RE_Raise_From_Controlled_Operation);
 
       --  Restricted runtime: exception messages are not supported and hence
       --  Raise_From_Controlled_Operation is not supported.
+
       else
          Raise_Id := RTE (RE_Reraise_Occurrence);
       end if;
diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb
index a08a9e3..c5c6181 100644
--- a/gcc/ada/exp_intr.adb
+++ b/gcc/ada/exp_intr.adb
@@ -31,6 +31,7 @@ with Errout;   use Errout;
 with Exp_Atag; use Exp_Atag;
 with Exp_Ch4;  use Exp_Ch4;
 with Exp_Ch7;  use Exp_Ch7;
+with Exp_Ch11; use Exp_Ch11;
 with Exp_Code; use Exp_Code;
 with Exp_Fixd; use Exp_Fixd;
 with Exp_Util; use Exp_Util;
@@ -883,7 +884,7 @@ package body Exp_Intr is
       Pool    : constant Entity_Id  := Associated_Storage_Pool (Rtyp);
       Stmts   : constant List_Id    := New_List;
 
-      Blk          : Node_Id;
+      Blk          : Node_Id := Empty;
       Deref        : Node_Id;
       Exc_Occ_Decl : Node_Id;
       Exc_Occ_Id   : Entity_Id := Empty;
@@ -1279,6 +1280,14 @@ package body Exp_Intr is
 
       Rewrite (N, Gen_Code);
       Analyze (N);
+
+      --  If we generated a block with an At_End_Proc, expand the exception
+      --  handler. We need to wait until after everything else is analyzed.
+
+      if Present (Blk) then
+         Expand_At_End_Handler
+           (Handled_Statement_Sequence (Blk), Entity (Identifier (Blk)));
+      end if;
    end Expand_Unc_Deallocation;
 
    -----------------------
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 9388e66..5775103 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -5367,19 +5367,26 @@ package body Exp_Util is
    --  Start of processing for Needs_Finalization
 
    begin
-      --  Class-wide types must be treated as controlled because they may
-      --  contain an extension that has controlled components
+      --  Certain run-time configurations and targets do not provide support
+      --  for controlled types.
 
-      --  We can skip this if finalization is not available
+      if Restriction_Active (No_Finalization) then
+         return False;
 
-      return (Is_Class_Wide_Type (T)
-                and then not Restriction_Active (No_Finalization))
-        or else Is_Controlled (T)
-        or else Has_Controlled_Component (T)
-        or else Has_Some_Controlled_Component (T)
-        or else (Is_Concurrent_Type (T)
+      else
+         --  Class-wide types are treated as controlled because derivations
+         --  from the root type can introduce controlled components.
+
+         return
+           Is_Class_Wide_Type (T)
+             or else Is_Controlled (T)
+             or else Has_Controlled_Component (T)
+             or else Has_Some_Controlled_Component (T)
+             or else
+               (Is_Concurrent_Type (T)
                   and then Present (Corresponding_Record_Type (T))
                   and then Needs_Finalization (Corresponding_Record_Type (T)));
+      end if;
    end Needs_Finalization;
 
    ----------------------------