[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Wed, 3 Aug 2011 14:49:52 +0000 (16:49 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Wed, 3 Aug 2011 14:49:52 +0000 (16:49 +0200)
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

gcc/ada/ChangeLog
gcc/ada/exp_ch13.adb
gcc/ada/exp_ch3.adb
gcc/ada/exp_ch4.adb
gcc/ada/exp_ch7.adb
gcc/ada/exp_intr.adb
gcc/ada/exp_util.adb

index 9cf21ed38f28a9b0d221d3c81019f783a1f59b5e..6abd4106cf0eb63c86fbaddcc44ce608b253c062 100644 (file)
@@ -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
index 0af6519a46d55461d6a830ec2c8b8de6c34538ba..761a2818ccb597cc070c7239b655ac3200f65c65 100644 (file)
@@ -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;
 
index 682ae94a18d98f71cd71d9984f2dfe8ccc198de6..6c98ef8aed6a7a884b3d343a22fb7a40f2a4a8f4 100644 (file)
@@ -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
index fb7f3b04e9cc16178f39cc1ce109f65ac992a365..58516cdf36b2e97646d4bc9b53a2e23cd6336048 100644 (file)
@@ -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
index e72c19b409550f19d68378a3f513d3c5bb8c8dc9..00992691d1ae48f56b664ba14754363e6ec702a9 100644 (file)
@@ -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;
index a08a9e3865cf94fdefd7a7e3da7798eaeeea293b..c5c6181c68ec85822af0a02bcd5ee4ed1918cfc0 100644 (file)
@@ -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;
 
    -----------------------
index 9388e664a0cbf37188cbf12b5d011b27e567fbd8..57751033c5cca2b813a4e3e44535a50ea57763d7 100644 (file)
@@ -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;
 
    ----------------------------