Commit a780db15 by Arnaud Charlet

[multiple changes]

2010-10-18  Javier Miranda  <miranda@adacore.com>

	* exp_util.adb (Side_Effect_Free): Code clean up.

2010-10-18  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb (Is_Primitive_Operator_In_Use): Renamed from
	Is_Primitive_Operator. When ending the scope of a use package scope, a
	primitive operator remains in use if the base type has a current use
	(type) clause.

2010-10-18  Javier Miranda  <miranda@adacore.com>

	* einfo.ads (Is_Dynamic_Support): Add missing support for limited
	private types whose full-view is a task type.
	* sem_util.adb (Enclosing_Subprogram): Add missing support for limited
	private types whose full-view is a task type.
	* exp_ch7.adb (Find_Final_List): Minor code cleanup replacing code by
	function Nearest_Dynamic_Scope which provides the needed functionality.

2010-10-18  Arnaud Charlet  <charlet@adacore.com>

	* sem_prag.adb (Set_Exported): Do not generate error when exporting a
	variable with an address clause in codepeer mode.

From-SVN: r165614
parent fda9c731
2010-10-18 Javier Miranda <miranda@adacore.com>
* exp_util.adb (Side_Effect_Free): Code clean up.
2010-10-18 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (Is_Primitive_Operator_In_Use): Renamed from
Is_Primitive_Operator. When ending the scope of a use package scope, a
primitive operator remains in use if the base type has a current use
(type) clause.
2010-10-18 Javier Miranda <miranda@adacore.com>
* einfo.ads (Is_Dynamic_Support): Add missing support for limited
private types whose full-view is a task type.
* sem_util.adb (Enclosing_Subprogram): Add missing support for limited
private types whose full-view is a task type.
* exp_ch7.adb (Find_Final_List): Minor code cleanup replacing code by
function Nearest_Dynamic_Scope which provides the needed functionality.
2010-10-18 Arnaud Charlet <charlet@adacore.com>
* sem_prag.adb (Set_Exported): Do not generate error when exporting a
variable with an address clause in codepeer mode.
2010-10-18 Robert Dewar <dewar@adacore.com> 2010-10-18 Robert Dewar <dewar@adacore.com>
* g-trasym-vms-ia64.adb: Minor reformatting. * g-trasym-vms-ia64.adb: Minor reformatting.
......
...@@ -6130,6 +6130,10 @@ package body Einfo is ...@@ -6130,6 +6130,10 @@ package body Einfo is
or else or else
Ekind (Id) = E_Task_Type Ekind (Id) = E_Task_Type
or else or else
(Ekind (Id) = E_Limited_Private_Type
and then Present (Full_View (Id))
and then Ekind (Full_View (Id)) = E_Task_Type)
or else
Ekind (Id) = E_Entry Ekind (Id) = E_Entry
or else or else
Ekind (Id) = E_Entry_Family Ekind (Id) = E_Entry_Family
......
...@@ -1739,11 +1739,7 @@ package body Exp_Ch7 is ...@@ -1739,11 +1739,7 @@ package body Exp_Ch7 is
end if; end if;
else else
if Is_Dynamic_Scope (E) then S := Nearest_Dynamic_Scope (E);
S := E;
else
S := Enclosing_Dynamic_Scope (E);
end if;
-- When the finalization chain entity is 'Error', it means that there -- When the finalization chain entity is 'Error', it means that there
-- should not be any chain at that level and that the enclosing one -- should not be any chain at that level and that the enclosing one
......
...@@ -4655,8 +4655,8 @@ package body Exp_Util is ...@@ -4655,8 +4655,8 @@ package body Exp_Util is
elsif VM_Target /= No_VM elsif VM_Target /= No_VM
and then not Comes_From_Source (N) and then not Comes_From_Source (N)
and then Is_Class_Wide_Type (Etype (N))
and then Nkind (Parent (N)) = N_Object_Renaming_Declaration and then Nkind (Parent (N)) = N_Object_Renaming_Declaration
and then Is_Class_Wide_Type (Etype (N))
then then
return True; return True;
end if; end if;
......
...@@ -3361,24 +3361,25 @@ package body Sem_Ch8 is ...@@ -3361,24 +3361,25 @@ package body Sem_Ch8 is
Id : Entity_Id; Id : Entity_Id;
Elmt : Elmt_Id; Elmt : Elmt_Id;
function Is_Primitive_Operator function Is_Primitive_Operator_In_Use
(Op : Entity_Id; (Op : Entity_Id;
F : Entity_Id) return Boolean; F : Entity_Id) return Boolean;
-- Check whether Op is a primitive operator of a use-visible type -- Check whether Op is a primitive operator of a use-visible type
--------------------------- ----------------------------------
-- Is_Primitive_Operator -- -- Is_Primitive_Operator_In_Use --
--------------------------- ----------------------------------
function Is_Primitive_Operator function Is_Primitive_Operator_In_Use
(Op : Entity_Id; (Op : Entity_Id;
F : Entity_Id) return Boolean F : Entity_Id) return Boolean
is is
T : constant Entity_Id := Etype (F); T : constant Entity_Id := Etype (F);
begin begin
return In_Use (T) return (In_Use (T)
or else Present (Current_Use_Clause (Base_Type (T))))
and then Scope (T) = Scope (Op); and then Scope (T) = Scope (Op);
end Is_Primitive_Operator; end Is_Primitive_Operator_In_Use;
-- Start of processing for End_Use_Package -- Start of processing for End_Use_Package
...@@ -3409,11 +3410,12 @@ package body Sem_Ch8 is ...@@ -3409,11 +3410,12 @@ package body Sem_Ch8 is
if Nkind (Id) = N_Defining_Operator_Symbol if Nkind (Id) = N_Defining_Operator_Symbol
and then and then
(Is_Primitive_Operator (Id, First_Formal (Id)) (Is_Primitive_Operator_In_Use
(Id, First_Formal (Id))
or else or else
(Present (Next_Formal (First_Formal (Id))) (Present (Next_Formal (First_Formal (Id)))
and then and then
Is_Primitive_Operator Is_Primitive_Operator_In_Use
(Id, Next_Formal (First_Formal (Id))))) (Id, Next_Formal (First_Formal (Id)))))
then then
null; null;
......
...@@ -4986,7 +4986,7 @@ package body Sem_Prag is ...@@ -4986,7 +4986,7 @@ package body Sem_Prag is
Error_Pragma_Arg Error_Pragma_Arg
("cannot export entity& that was previously imported", Arg); ("cannot export entity& that was previously imported", Arg);
elsif Present (Address_Clause (E)) then elsif Present (Address_Clause (E)) and then not CodePeer_Mode then
Error_Pragma_Arg Error_Pragma_Arg
("cannot export entity& that has an address clause", Arg); ("cannot export entity& that has an address clause", Arg);
end if; end if;
......
...@@ -2715,6 +2715,12 @@ package body Sem_Util is ...@@ -2715,6 +2715,12 @@ package body Sem_Util is
elsif Ekind (Dynamic_Scope) = E_Task_Type then elsif Ekind (Dynamic_Scope) = E_Task_Type then
return Get_Task_Body_Procedure (Dynamic_Scope); return Get_Task_Body_Procedure (Dynamic_Scope);
elsif Ekind (Dynamic_Scope) = E_Limited_Private_Type
and then Present (Full_View (Dynamic_Scope))
and then Ekind (Full_View (Dynamic_Scope)) = E_Task_Type
then
return Get_Task_Body_Procedure (Full_View (Dynamic_Scope));
-- No body is generated if the protected operation is eliminated -- No body is generated if the protected operation is eliminated
elsif Convention (Dynamic_Scope) = Convention_Protected elsif Convention (Dynamic_Scope) = Convention_Protected
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment