+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
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;
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;
-- 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
-- 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
-- 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
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;
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;
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;
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;
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;
-----------------------
-- 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;
----------------------------