From f553e7bc12de8a7d47f51cc5ea0c3d2a22de487e Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 3 Aug 2011 16:49:52 +0200 Subject: [PATCH] [multiple changes] 2011-08-03 Hristian Kirtchev * 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 * 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 | 19 +++++++++++++++++++ gcc/ada/exp_ch13.adb | 10 +++++++++- gcc/ada/exp_ch3.adb | 8 +++++++- gcc/ada/exp_ch4.adb | 8 +++++++- gcc/ada/exp_ch7.adb | 14 +++++++++++++- gcc/ada/exp_intr.adb | 11 ++++++++++- gcc/ada/exp_util.adb | 25 ++++++++++++++++--------- 7 files changed, 81 insertions(+), 14 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9cf21ed38f2..6abd4106cf0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,22 @@ +2011-08-03 Hristian Kirtchev + + * 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 + + * 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 * 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 0af6519a46d..761a2818ccb 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 682ae94a18d..6c98ef8aed6 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 fb7f3b04e9c..58516cdf36b 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 e72c19b4095..00992691d1a 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 a08a9e3865c..c5c6181c68e 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 9388e664a0c..57751033c5c 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; ---------------------------- -- 2.30.2