Commit 25e29378 by Arnaud Charlet

[multiple changes]

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

	* sem_attr.adb (Resolve_Attribute): After replacing the range attribute
	node with a range expression ensure that its evaluation will not have
	side effects.
	* exp_ch5.adb (Expand_Assign_Array): Propagate the Parent to the
	unchecked conversion node generated to handle assignment of private
	types. Required to allow climbing the subtree if Insert_Action is
	invoked later.

2010-10-21  Robert Dewar  <dewar@adacore.com>

	* par-ch3.adb (P_Interface_Type_Definition): Allow for possibility of
	aspect clause presence terminating the type definition.

From-SVN: r165757
parent 90c63b09
2010-10-21 Javier Miranda <miranda@adacore.com>
* sem_attr.adb (Resolve_Attribute): After replacing the range attribute
node with a range expression ensure that its evaluation will not have
side effects.
* exp_ch5.adb (Expand_Assign_Array): Propagate the Parent to the
unchecked conversion node generated to handle assignment of private
types. Required to allow climbing the subtree if Insert_Action is
invoked later.
2010-10-21 Robert Dewar <dewar@adacore.com>
* par-ch3.adb (P_Interface_Type_Definition): Allow for possibility of
aspect clause presence terminating the type definition.
2010-10-21 Robert Dewar <dewar@adacore.com> 2010-10-21 Robert Dewar <dewar@adacore.com>
* exp_ch4.adb, exp_intr.adb, par-ch4.adb, scn.adb, sem_ch4.adb, * exp_ch4.adb, exp_intr.adb, par-ch4.adb, scn.adb, sem_ch4.adb,
......
...@@ -562,15 +562,23 @@ package body Exp_Ch5 is ...@@ -562,15 +562,23 @@ package body Exp_Ch5 is
-- cannot assign to elements of the array without this extra -- cannot assign to elements of the array without this extra
-- unchecked conversion. -- unchecked conversion.
-- Note: We must propagate Parent to the conversion node to allow
-- climbing the subtree if Insert_Action is invoked later.
if Nkind (Act_Lhs) = N_Slice then if Nkind (Act_Lhs) = N_Slice then
Larray := Prefix (Act_Lhs); Larray := Prefix (Act_Lhs);
else else
Larray := Act_Lhs; Larray := Act_Lhs;
if Is_Private_Type (Etype (Larray)) then if Is_Private_Type (Etype (Larray)) then
Larray := declare
Unchecked_Convert_To Par : constant Node_Id := Parent (Larray);
(Underlying_Type (Etype (Larray)), Larray); begin
Larray :=
Unchecked_Convert_To
(Underlying_Type (Etype (Larray)), Larray);
Set_Parent (Larray, Par);
end;
end if; end if;
end if; end if;
...@@ -580,9 +588,14 @@ package body Exp_Ch5 is ...@@ -580,9 +588,14 @@ package body Exp_Ch5 is
Rarray := Act_Rhs; Rarray := Act_Rhs;
if Is_Private_Type (Etype (Rarray)) then if Is_Private_Type (Etype (Rarray)) then
Rarray := declare
Unchecked_Convert_To Par : constant Node_Id := Parent (Rarray);
(Underlying_Type (Etype (Rarray)), Rarray); begin
Rarray :=
Unchecked_Convert_To
(Underlying_Type (Etype (Rarray)), Rarray);
Set_Parent (Rarray, Par);
end;
end if; end if;
end if; end if;
...@@ -1049,6 +1062,8 @@ package body Exp_Ch5 is ...@@ -1049,6 +1062,8 @@ package body Exp_Ch5 is
return Step; return Step;
end Build_Step; end Build_Step;
-- Start of processing for Expand_Assign_Array_Loop
begin begin
if Rev then if Rev then
F_Or_L := Name_Last; F_Or_L := Name_Last;
......
...@@ -3784,7 +3784,7 @@ package body Ch3 is ...@@ -3784,7 +3784,7 @@ package body Ch3 is
-- Ada 2005 (AI-345): In case of interfaces with a null list of -- Ada 2005 (AI-345): In case of interfaces with a null list of
-- interfaces we build a record_definition node. -- interfaces we build a record_definition node.
if Token = Tok_Semicolon then if Token = Tok_Semicolon or else Aspect_Specifications_Present then
Typedef_Node := New_Node (N_Record_Definition, Token_Ptr); Typedef_Node := New_Node (N_Record_Definition, Token_Ptr);
Set_Abstract_Present (Typedef_Node); Set_Abstract_Present (Typedef_Node);
......
...@@ -8791,6 +8791,11 @@ package body Sem_Attr is ...@@ -8791,6 +8791,11 @@ package body Sem_Attr is
Rewrite (N, Make_Range (Loc, LB, HB)); Rewrite (N, Make_Range (Loc, LB, HB));
Analyze_And_Resolve (N, Typ); Analyze_And_Resolve (N, Typ);
-- Ensure that the expanded range does not have side effects
Force_Evaluation (LB);
Force_Evaluation (HB);
-- Normally after resolving attribute nodes, Eval_Attribute -- Normally after resolving attribute nodes, Eval_Attribute
-- is called to do any possible static evaluation of the node. -- is called to do any possible static evaluation of the node.
-- However, here since the Range attribute has just been -- However, here since the Range attribute has just been
......
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