[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
This commit is contained in:
Arnaud Charlet 2011-08-03 16:49:52 +02:00
parent 7827737676
commit f553e7bc12
7 changed files with 81 additions and 14 deletions

View 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

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

View 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

View 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

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

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

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