OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2010-08-05  Ed Schonberg  <schonberg@adacore.com>

	* exp_util.adb (Insert_Actions): If the action appears within a
	conditional expression that is already analyzed, insert action further
	out.

2010-08-05  Robert Dewar  <dewar@adacore.com>

	* exp_ch4.adb: Minor reformatting.

From-SVN: r162907
This commit is contained in:
Arnaud Charlet 2010-08-05 11:21:58 +02:00
parent 0d90129062
commit aa9a7dd7c2
3 changed files with 61 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
gcc/ada/ChangeLog
View File

@ -1,3 +1,13 @@
2010-08-05 Ed Schonberg <schonberg@adacore.com>
* exp_util.adb (Insert_Actions): If the action appears within a
conditional expression that is already analyzed, insert action further
out.
2010-08-05 Robert Dewar <dewar@adacore.com>
* exp_ch4.adb: Minor reformatting.
2010-08-05 Thomas Quinot <quinot@adacore.com> 2010-08-05 Thomas Quinot <quinot@adacore.com>
* exp_ch4.adb: Minor reformatting * exp_ch4.adb: Minor reformatting

14
gcc/ada/exp_ch4.adb
View File

@ -6995,14 +6995,15 @@ package body Exp_Ch4 is
begin begin
if Safe_In_Place_Array_Op (Lhs, Op1, Op2) then if Safe_In_Place_Array_Op (Lhs, Op1, Op2) then
if N = Op1 and then Nkind (Op2) = N_Op_Not then
-- (not A) op (not B) can be reduced to a single call
-- (not A) op (not B) can be reduced to a single call
if N = Op1 and then Nkind (Op2) = N_Op_Not then
return; return;
elsif N = Op2 and then Nkind (Parent (N)) = N_Op_Xor then -- A xor (not B) can also be special-cased
-- A xor (not B) can also be special-cased
elsif N = Op2 and then Nkind (Parent (N)) = N_Op_Xor then
return; return;
end if; end if;
end if; end if;
@ -7274,7 +7275,10 @@ package body Exp_Ch4 is
-- Arithmetic overflow checks for signed integer/fixed point types -- Arithmetic overflow checks for signed integer/fixed point types
if Is_Signed_Integer_Type (Typ) or else Is_Fixed_Point_Type (Typ) then if Is_Signed_Integer_Type (Typ)
or else
Is_Fixed_Point_Type (Typ)
then
Apply_Arithmetic_Overflow_Check (N); Apply_Arithmetic_Overflow_Check (N);
-- VAX floating-point types case -- VAX floating-point types case

77
gcc/ada/exp_util.adb
View File

@ -814,8 +814,8 @@ package body Exp_Util is
Stats : constant List_Id := New_List; Stats : constant List_Id := New_List;
begin begin
-- For a dynamic task, the name comes from the target variable. -- For a dynamic task, the name comes from the target variable. For a
-- For a static one it is a formal of the enclosing init proc. -- static one it is a formal of the enclosing init proc.
if Dyn then if Dyn then
Get_Name_String (Chars (Entity (Prefix (Id_Ref)))); Get_Name_String (Chars (Entity (Prefix (Id_Ref))));
@ -1105,8 +1105,8 @@ package body Exp_Util is
IR : Node_Id; IR : Node_Id;
begin begin
-- An itype reference must only be created if this is a local -- An itype reference must only be created if this is a local itype, so
-- itype, so that gigi can elaborate it on the proper objstack. -- that gigi can elaborate it on the proper objstack.
if Is_Itype (Typ) if Is_Itype (Typ)
and then Scope (Typ) = Current_Scope and then Scope (Typ) = Current_Scope
@ -1356,9 +1356,9 @@ package body Exp_Util is
pragma Assert (Is_Class_Wide_Type (Unc_Type)); pragma Assert (Is_Class_Wide_Type (Unc_Type));
null; null;
-- In Ada95, nothing to be done if the type of the expression is -- In Ada95 nothing to be done if the type of the expression is limited,
-- limited, because in this case the expression cannot be copied, -- because in this case the expression cannot be copied, and its use can
-- and its use can only be by reference. -- only be by reference.
-- In Ada2005, the context can be an object declaration whose expression -- In Ada2005, the context can be an object declaration whose expression
-- is a function that returns in place. If the nominal subtype has -- is a function that returns in place. If the nominal subtype has
@ -1823,9 +1823,9 @@ package body Exp_Util is
if Nkind (Cond) = N_And_Then if Nkind (Cond) = N_And_Then
or else Nkind (Cond) = N_Op_And or else Nkind (Cond) = N_Op_And
then then
-- Don't ever try to invert a condition that is of the form -- Don't ever try to invert a condition that is of the form of an
-- of an AND or AND THEN (since we are not doing sufficiently -- AND or AND THEN (since we are not doing sufficiently general
-- general processing to allow this). -- processing to allow this).
if Sens = False then if Sens = False then
Op := N_Empty; Op := N_Empty;
@ -2002,8 +2002,8 @@ package body Exp_Util is
end; end;
-- ELSIF part. Condition is known true within the referenced -- ELSIF part. Condition is known true within the referenced
-- ELSIF, known False in any subsequent ELSIF or ELSE part, and -- ELSIF, known False in any subsequent ELSIF or ELSE part,
-- unknown before the ELSE part or after the IF statement. -- and unknown before the ELSE part or after the IF statement.
elsif Nkind (CV) = N_Elsif_Part then elsif Nkind (CV) = N_Elsif_Part then
@ -2386,12 +2386,19 @@ package body Exp_Util is
ElseX : constant Node_Id := Next (ThenX); ElseX : constant Node_Id := Next (ThenX);
begin begin
-- Actions belong to the then expression, temporarily -- If the enclosing expression is already analyzed, as
-- place them as Then_Actions of the conditional expr. -- is the case for nested elaboration checks, insert the
-- They will be moved to the proper place later when -- conditional further out.
-- the conditional expression is expanded.
if N = ThenX then if Analyzed (P) then
null;
-- Actions belong to the then expression, temporarily place
-- them as Then_Actions of the conditional expr. They will
-- be moved to the proper place later when the conditional
-- expression is expanded.
elsif N = ThenX then
if Present (Then_Actions (P)) then if Present (Then_Actions (P)) then
Insert_List_After_And_Analyze Insert_List_After_And_Analyze
(Last (Then_Actions (P)), Ins_Actions); (Last (Then_Actions (P)), Ins_Actions);
@ -2427,9 +2434,9 @@ package body Exp_Util is
end if; end if;
end; end;
-- Alternative of case expression, we place the action in -- Alternative of case expression, we place the action in the
-- the Actions field of the case expression alternative, this -- Actions field of the case expression alternative, this will
-- will be handled when the case expression is expanded. -- be handled when the case expression is expanded.
when N_Case_Expression_Alternative => when N_Case_Expression_Alternative =>
if Present (Actions (P)) then if Present (Actions (P)) then
@ -2464,11 +2471,11 @@ package body Exp_Util is
else else
Set_Condition_Actions (P, Ins_Actions); Set_Condition_Actions (P, Ins_Actions);
-- Set the parent of the insert actions explicitly. -- Set the parent of the insert actions explicitly. This
-- This is not a syntactic field, but we need the -- is not a syntactic field, but we need the parent field
-- parent field set, in particular so that freeze -- set, in particular so that freeze can understand that
-- can understand that it is dealing with condition -- it is dealing with condition actions, and properly
-- actions, and properly insert the freezing actions. -- insert the freezing actions.
Set_Parent (Ins_Actions, P); Set_Parent (Ins_Actions, P);
Analyze_List (Condition_Actions (P)); Analyze_List (Condition_Actions (P));
@ -2574,6 +2581,7 @@ package body Exp_Util is
-- subsequent use in the back end: within a package spec the -- subsequent use in the back end: within a package spec the
-- loop is part of the elaboration procedure and is only -- loop is part of the elaboration procedure and is only
-- elaborated during the second pass. -- elaborated during the second pass.
-- If the loop comes from source, or the entity is local to -- If the loop comes from source, or the entity is local to
-- the loop itself it must remain within. -- the loop itself it must remain within.
@ -2596,10 +2604,9 @@ package body Exp_Util is
return; return;
end if; end if;
-- A special case, N_Raise_xxx_Error can act either as a -- A special case, N_Raise_xxx_Error can act either as a statement
-- statement or a subexpression. We tell the difference -- or a subexpression. We tell the difference by looking at the
-- by looking at the Etype. It is set to Standard_Void_Type -- Etype. It is set to Standard_Void_Type in the statement case.
-- in the statement case.
when when
N_Raise_xxx_Error => N_Raise_xxx_Error =>
@ -2645,9 +2652,9 @@ package body Exp_Util is
Decl : Node_Id; Decl : Node_Id;
begin begin
-- Check whether these actions were generated -- Check whether these actions were generated by a
-- by a declaration that is part of the loop_ -- declaration that is part of the loop_ actions
-- actions for the component_association. -- for the component_association.
Decl := Assoc_Node; Decl := Assoc_Node;
while Present (Decl) loop while Present (Decl) loop
@ -2855,9 +2862,9 @@ package body Exp_Util is
if Nkind (Parent (N)) = N_Subunit then if Nkind (Parent (N)) = N_Subunit then
-- This is the proper body corresponding to a stub. Insertion -- This is the proper body corresponding to a stub. Insertion must
-- must be done at the point of the stub, which is in the decla- -- be done at the point of the stub, which is in the declarative
-- rative part of the parent unit. -- part of the parent unit.
P := Corresponding_Stub (Parent (N)); P := Corresponding_Stub (Parent (N));