Commit c5c780e6 by Hristian Kirtchev Committed by Arnaud Charlet

exp_ch4.adb (Process_Transient_Object): Remove constant In_Cond_Expr, use its…

exp_ch4.adb (Process_Transient_Object): Remove constant In_Cond_Expr, use its initialization expression in place.

2014-07-29  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch4.adb (Process_Transient_Object): Remove constant
	In_Cond_Expr, use its initialization expression in place.
	* exp_ch7.adb (Process_Declarations): There is no need to check
	that a transient object being hooked is controlled as it would
	not have been hooked in the first place.
	* exp_util.adb (Is_Aliased): 'Reference-d or renamed transient
	objects are not considered aliased when the related context is
	a Boolean expression_with_actions.
	(Requires_Cleanup_Actions): There is no need to check that a transient
	object being hooked is controlled as it would not have been hooked in
	the first place.

From-SVN: r213158
parent e2bc5465
2014-07-29 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch4.adb (Process_Transient_Object): Remove constant
In_Cond_Expr, use its initialization expression in place.
* exp_ch7.adb (Process_Declarations): There is no need to check
that a transient object being hooked is controlled as it would
not have been hooked in the first place.
* exp_util.adb (Is_Aliased): 'Reference-d or renamed transient
objects are not considered aliased when the related context is
a Boolean expression_with_actions.
(Requires_Cleanup_Actions): There is no need to check that a transient
object being hooked is controlled as it would not have been hooked in
the first place.
2014-07-29 Robert Dewar <dewar@adacore.com>
* errout.adb: Minor reformatting.
......
......@@ -12616,9 +12616,6 @@ package body Exp_Ch4 is
-- If False, call to finalizer includes a test of whether the hook
-- pointer is null.
In_Cond_Expr : constant Boolean :=
Within_Case_Or_If_Expression (Rel_Node);
begin
-- Step 0: determine where to attach finalization actions in the tree
......@@ -12636,10 +12633,10 @@ package body Exp_Ch4 is
-- conditional expression.
Finalize_Always :=
not (In_Cond_Expr
or else
Nkind_In (Original_Node (Rel_Node), N_Case_Expression,
N_If_Expression));
not Within_Case_Or_If_Expression (Rel_Node)
and then not Nkind_In
(Original_Node (Rel_Node), N_Case_Expression,
N_If_Expression);
declare
Loc : constant Source_Ptr := Sloc (Rel_Node);
......
......@@ -1817,9 +1817,7 @@ package body Exp_Ch7 is
elsif Is_Access_Type (Obj_Typ)
and then Present (Status_Flag_Or_Transient_Decl (Obj_Id))
and then Nkind (Status_Flag_Or_Transient_Decl (Obj_Id)) =
N_Object_Declaration
and then Is_Finalizable_Transient
(Status_Flag_Or_Transient_Decl (Obj_Id), Decl)
N_Object_Declaration
then
Processing_Actions (Has_No_Init => True);
......
......@@ -3435,9 +3435,8 @@ package body Exp_Util is
or else Etype (Assoc_Node) /= Standard_Void_Type)
and then Nkind (Assoc_Node) /= N_Procedure_Call_Statement
and then (Nkind (Assoc_Node) /= N_Attribute_Reference
or else
not Is_Procedure_Attribute_Name
(Attribute_Name (Assoc_Node)))
or else not Is_Procedure_Attribute_Name
(Attribute_Name (Assoc_Node)))
then
N := Assoc_Node;
P := Parent (Assoc_Node);
......@@ -4557,6 +4556,17 @@ package body Exp_Util is
-- Start of processing for Is_Aliased
begin
-- 'Reference-d or renamed transient objects are not consider aliased
-- when the related context is a Boolean expression_with_actions. The
-- Boolean result is always known after the action list is evaluated,
-- therefore the transient objects must be finalized at that point.
if Nkind (Rel_Node) = N_Expression_With_Actions
and then Is_Boolean_Type (Etype (Rel_Node))
then
return False;
end if;
Stmt := First_Stmt;
while Present (Stmt) loop
if Nkind (Stmt) = N_Object_Declaration then
......@@ -4652,8 +4662,7 @@ package body Exp_Util is
if Nkind (Stmt) = N_Object_Declaration
and then Present (Expression (Stmt))
and then Nkind (Expression (Stmt)) = N_Reference
and then Nkind (Prefix (Expression (Stmt))) =
N_Function_Call
and then Nkind (Prefix (Expression (Stmt))) = N_Function_Call
then
Call := Prefix (Expression (Stmt));
......@@ -7441,9 +7450,7 @@ package body Exp_Util is
elsif Is_Access_Type (Obj_Typ)
and then Present (Status_Flag_Or_Transient_Decl (Obj_Id))
and then Nkind (Status_Flag_Or_Transient_Decl (Obj_Id)) =
N_Object_Declaration
and then Is_Finalizable_Transient
(Status_Flag_Or_Transient_Decl (Obj_Id), Decl)
N_Object_Declaration
then
return True;
......@@ -7464,9 +7471,8 @@ package body Exp_Util is
-- treated as controlled since they require manual cleanup.
elsif Ekind (Obj_Id) = E_Variable
and then
(Is_Simple_Protected_Type (Obj_Typ)
or else Has_Simple_Protected_Object (Obj_Typ))
and then (Is_Simple_Protected_Type (Obj_Typ)
or else Has_Simple_Protected_Object (Obj_Typ))
then
return True;
end if;
......@@ -7529,9 +7535,7 @@ package body Exp_Util is
and then not Is_Access_Subprogram_Type (Typ)
and then Needs_Finalization
(Available_View (Designated_Type (Typ))))
or else
(Is_Type (Typ)
and then Needs_Finalization (Typ)))
or else (Is_Type (Typ) and then Needs_Finalization (Typ)))
and then Requires_Cleanup_Actions
(Actions (Decl), Lib_Level, Nested_Constructs)
then
......@@ -7756,7 +7760,8 @@ package body Exp_Util is
if Ialign /= No_Uint and then Ialign > Maximum_Alignment then
return True;
elsif Ialign /= No_Uint and then Oalign /= No_Uint
elsif Ialign /= No_Uint
and then Oalign /= No_Uint
and then Ialign <= Oalign
then
return True;
......@@ -8327,7 +8332,7 @@ package body Exp_Util is
when N_Range =>
return Side_Effect_Free (Low_Bound (N), Name_Req, Variable_Ref)
and then
and then
Side_Effect_Free (High_Bound (N), Name_Req, Variable_Ref);
-- A slice is side effect free if it is a side effect free
......
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