Commit b80a2b4b by Arnaud Charlet

[multiple changes]

2014-08-01  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb (Check_Parameterless_Call): Use Relocate_Node
	to create the name of the parameterless call, rather than
	New_Copy, to preserve the tree structure when the name is a
	complex expression, e.g. a selected component that denotes a
	protected operation, whose prefix is itself a selected component.

2014-08-01  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Use
	Unit_Declaration_Node to retrieve body when inlining, to handle
	properly subprogram child units.

2014-08-01  Robert Dewar  <dewar@adacore.com>

	* sem_attr.adb: Minor reformatting.

From-SVN: r213459
parent 4b259b2d
2014-08-01 Ed Schonberg <schonberg@adacore.com>
* sem_res.adb (Check_Parameterless_Call): Use Relocate_Node
to create the name of the parameterless call, rather than
New_Copy, to preserve the tree structure when the name is a
complex expression, e.g. a selected component that denotes a
protected operation, whose prefix is itself a selected component.
2014-08-01 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Use
Unit_Declaration_Node to retrieve body when inlining, to handle
properly subprogram child units.
2014-08-01 Robert Dewar <dewar@adacore.com>
* sem_attr.adb: Minor reformatting.
2014-08-01 Vincent Celier <celier@adacore.com> 2014-08-01 Vincent Celier <celier@adacore.com>
* debug.adb: Minor documentation addition for -dn switch. * debug.adb: Minor documentation addition for -dn switch.
......
...@@ -2983,9 +2983,7 @@ package body Sem_Attr is ...@@ -2983,9 +2983,7 @@ package body Sem_Attr is
-- because it was valid in the generic unit. Ditto if this is -- because it was valid in the generic unit. Ditto if this is
-- an inlining of a function declared in an instance. -- an inlining of a function declared in an instance.
if In_Instance if In_Instance or else In_Inlined_Body then
or else In_Inlined_Body
then
return; return;
-- For sure OK if we have a real private type itself, but must -- For sure OK if we have a real private type itself, but must
...@@ -3130,12 +3128,10 @@ package body Sem_Attr is ...@@ -3130,12 +3128,10 @@ package body Sem_Attr is
-- The prefix denotes either the task type, or else a -- The prefix denotes either the task type, or else a
-- single task whose task type is being analyzed. -- single task whose task type is being analyzed.
if (Is_Type (Tsk) if (Is_Type (Tsk) and then Tsk = S)
and then Tsk = S)
or else (not Is_Type (Tsk) or else (not Is_Type (Tsk)
and then Etype (Tsk) = S and then Etype (Tsk) = S
and then not (Comes_From_Source (S))) and then not (Comes_From_Source (S)))
then then
null; null;
else else
...@@ -3166,7 +3162,6 @@ package body Sem_Attr is ...@@ -3166,7 +3162,6 @@ package body Sem_Attr is
begin begin
Get_First_Interp (P, Index, It); Get_First_Interp (P, Index, It);
while Present (It.Nam) loop while Present (It.Nam) loop
if It.Nam = Ent then if It.Nam = Ent then
null; null;
...@@ -3241,9 +3236,7 @@ package body Sem_Attr is ...@@ -3241,9 +3236,7 @@ package body Sem_Attr is
when Attribute_Descriptor_Size => when Attribute_Descriptor_Size =>
Check_E0; Check_E0;
if not Is_Entity_Name (P) if not Is_Entity_Name (P) or else not Is_Type (Entity (P)) then
or else not Is_Type (Entity (P))
then
Error_Attr_P ("prefix of attribute % must denote a type"); Error_Attr_P ("prefix of attribute % must denote a type");
end if; end if;
...@@ -3547,8 +3540,8 @@ package body Sem_Attr is ...@@ -3547,8 +3540,8 @@ package body Sem_Attr is
if Etype (P) = Standard_Exception_Type then if Etype (P) = Standard_Exception_Type then
Set_Etype (N, RTE (RE_Exception_Id)); Set_Etype (N, RTE (RE_Exception_Id));
-- Ada 2005 (AI-345): Attribute 'Identity may be applied to -- Ada 2005 (AI-345): Attribute 'Identity may be applied to task
-- task interface class-wide types. -- interface class-wide types.
elsif Is_Task_Type (Etype (P)) elsif Is_Task_Type (Etype (P))
or else (Is_Access_Type (Etype (P)) or else (Is_Access_Type (Etype (P))
......
...@@ -3593,8 +3593,8 @@ package body Sem_Ch6 is ...@@ -3593,8 +3593,8 @@ package body Sem_Ch6 is
else else
declare declare
Body_Spec : constant Node_Id := Parent (Body_Id); Subp_Body : constant Node_Id :=
Subp_Body : constant Node_Id := Parent (Body_Spec); Unit_Declaration_Node (Body_Id);
Subp_Decl : constant List_Id := Declarations (Subp_Body); Subp_Decl : constant List_Id := Declarations (Subp_Body);
begin begin
......
...@@ -1102,7 +1102,10 @@ package body Sem_Res is ...@@ -1102,7 +1102,10 @@ package body Sem_Res is
end if; end if;
end if; end if;
Nam := New_Copy (N); -- The node is the name of the parameterless call. Preserve its
-- descendants, which may be complex expressions.
Nam := Relocate_Node (N);
-- If overloaded, overload set belongs to new copy -- If overloaded, overload set belongs to new copy
......
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