This change ensures that any finalization action required within an expression
that appears as the left operand of a short circuit operator remains
contained within the code fragment that evaluates that operand (and not
scattered after the evaluation of the complete Boolean expression). This
is helpful for static analysis tools, in particular for coverage analysis.
This is achieved by enclosing the left operand in an Expression_With_Actions,
which will also capture the required finalization actions. A number of
adjustments are made so that the rest of the compiler knows to deal
appropriately with the new occurrences of these expressions with actions.
Tested on x86_64-pc-linux-gnu, committed on trunk
2013-10-17 Thomas Quinot <qui...@adacore.com>
* exp_util.adb (Get_Current_Value_Condition,
Set_Current_Value_Condition): Handle the case of expressions
with actions * exp_util.adb (Insert_Actions): Handle the case
of an expression with actions whose Actions list is empty.
* exp_util.adb (Remove_Side_Effects.Side_Effect_Free): An
expression with actions that has no Actions and whose Expression
is side effect free is itself side effect free.
* exp_util.adb (Remove_Side_Effects): Do not set an incorrect etype on
temporary 'R' (Def_Id), which is in general an access to Exp_Type, not
an Exp_Type.
* sem_res.adb (Resolve): For an expression with
actions, resolve the expression early. * sem_res.adb
(Resolve_Expression_With_Actions): Rewrite an expression with
actions whose value is compile time known and which has no
actions into just its expression, so that its constant value is
available downstream.
* sem_res.adb (Resolve_Short_Circuit):
Wrap the left operand in an expression with actions to contain
any required finalization actions.
* exp_ch4.adb (Expand_Expression_With_Actions): For an
expression with actions returning a Boolean expression, ensure
any finalization action is kept within the Actions list.
* sem_warn.adb (Check_References, Check_Unset_Reference): add
missing circuitry to handle expressions with actions.
* checks.adb (Ensure_Valid): For an expression with actions,
insert the validity check on the Expression.
* sem_ch13.adb (Build_Static_Predicate.Get_RList): An expression
with actions that has a non-empty Actions list is not static. An
expression with actions that has an empty Actions list has the
static ranges of its Expression.
* sem_util.adb (Has_No_Obvious_Side_Effects): An expression with
actions with an empty Actions list has no obvious side effects
if its Expression itsekf has no obvious side effects.
Index: exp_util.adb
===================================================================
--- exp_util.adb (revision 203762)
+++ exp_util.adb (working copy)
@@ -2706,18 +2706,36 @@
(N : Node_Id;
S : Boolean)
is
- Cond : Node_Id;
- Sens : Boolean;
+ Cond : Node_Id;
+ Prev_Cond : Node_Id;
+ Sens : Boolean;
begin
Cond := N;
Sens := S;
- -- Deal with NOT operators, inverting sense
+ loop
+ Prev_Cond := Cond;
- while Nkind (Cond) = N_Op_Not loop
- Cond := Right_Opnd (Cond);
- Sens := not Sens;
+ -- Deal with NOT operators, inverting sense
+
+ while Nkind (Cond) = N_Op_Not loop
+ Cond := Right_Opnd (Cond);
+ Sens := not Sens;
+ end loop;
+
+ -- Deal with conversions, qualifications, and expressions with
+ -- actions.
+
+ while Nkind_In (Cond,
+ N_Type_Conversion,
+ N_Qualified_Expression,
+ N_Expression_With_Actions)
+ loop
+ Cond := Expression (Cond);
+ end loop;
+
+ exit when Cond = Prev_Cond;
end loop;
-- Deal with AND THEN and AND cases
@@ -2798,9 +2816,16 @@
return;
- -- Case of Boolean variable reference, return as though the
- -- reference had said var = True.
+ elsif Nkind_In (Cond,
+ N_Type_Conversion,
+ N_Qualified_Expression,
+ N_Expression_With_Actions)
+ then
+ Cond := Expression (Cond);
+ -- Case of Boolean variable reference, return as though the
+ -- reference had said var = True.
+
else
if Is_Entity_Name (Cond) and then Ent = Entity (Cond) then
Val := New_Occurrence_Of (Standard_True, Sloc (Cond));
@@ -3406,8 +3431,13 @@
when N_Expression_With_Actions =>
if N = Expression (P) then
- Insert_List_After_And_Analyze
- (Last (Actions (P)), Ins_Actions);
+ if Is_Empty_List (Actions (P)) then
+ Append_List_To (Actions (P), Ins_Actions);
+ Analyze_List (Actions (P));
+ else
+ Insert_List_After_And_Analyze
+ (Last (Actions (P)), Ins_Actions);
+ end if;
return;
end if;
@@ -6702,6 +6732,14 @@
when N_Explicit_Dereference =>
return Safe_Prefixed_Reference (N);
+ -- An expression with action is side effect free if its expression
+ -- is side effect free and it has no actions.
+
+ when N_Expression_With_Actions =>
+ return Is_Empty_List (Actions (N))
+ and then
+ Side_Effect_Free (Expression (N));
+
-- A call to _rep_to_pos is side effect free, since we generate
-- this pure function call ourselves. Moreover it is critically
-- important to make this exception, since otherwise we can have
@@ -7103,7 +7141,6 @@
end if;
Def_Id := Make_Temporary (Loc, 'R', Exp);
- Set_Etype (Def_Id, Exp_Type);
-- The regular expansion of functions with side effects involves the
-- generation of an access type to capture the return value found on
@@ -7780,8 +7817,15 @@
Set_Entity_Current_Value (Right_Opnd (Cond));
end if;
- -- Check possible boolean variable reference
+ elsif Nkind_In (Cond,
+ N_Type_Conversion,
+ N_Qualified_Expression,
+ N_Expression_With_Actions)
+ then
+ Set_Expression_Current_Value (Expression (Cond));
+ -- Check possible boolean variable reference
+
else
Set_Entity_Current_Value (Cond);
end if;
Index: checks.adb
===================================================================
--- checks.adb (revision 203595)
+++ checks.adb (working copy)
@@ -5092,6 +5092,13 @@
then
return;
+ -- For an expression with actions, we want to insert the validity check
+ -- on the final Expression.
+
+ elsif Nkind (Expr) = N_Expression_With_Actions then
+ Ensure_Valid (Expression (Expr));
+ return;
+
-- An annoying special case. If this is an out parameter of a scalar
-- type, then the value is not going to be accessed, therefore it is
-- inappropriate to do any validity check at the call site.
Index: sem_util.adb
===================================================================
--- sem_util.adb (revision 203762)
+++ sem_util.adb (working copy)
@@ -6777,6 +6777,12 @@
and then
Has_No_Obvious_Side_Effects (Right_Opnd (N));
+ elsif Nkind (N) = N_Expression_With_Actions
+ and then
+ Is_Empty_List (Actions (N))
+ then
+ return Has_No_Obvious_Side_Effects (Expression (N));
+
elsif Nkind (N) in N_Has_Entity then
return Present (Entity (N))
and then Ekind_In (Entity (N), E_Variable,
Index: sem_res.adb
===================================================================
--- sem_res.adb (revision 203762)
+++ sem_res.adb (working copy)
@@ -2095,10 +2095,19 @@
Check_Parameterless_Call (N);
+ -- The resolution of an Expression_With_Actions is determined by
+ -- its Expression.
+
+ if Nkind (N) = N_Expression_With_Actions then
+ Resolve (Expression (N), Typ);
+
+ Found := True;
+ Expr_Type := Etype (Expression (N));
+
-- If not overloaded, then we know the type, and all that needs doing
-- is to check that this type is compatible with the context.
- if not Is_Overloaded (N) then
+ elsif not Is_Overloaded (N) then
Found := Covers (Typ, Etype (N));
Expr_Type := Etype (N);
@@ -7274,6 +7283,17 @@
procedure Resolve_Expression_With_Actions (N : Node_Id; Typ : Entity_Id) is
begin
Set_Etype (N, Typ);
+
+ -- If N has no actions, and its expression has been constant folded,
+ -- then rewrite N as just its expression. Note, we can't do this in
+ -- the general case of Is_Empty_List (Actions (N)) as this would cause
+ -- Expression (N) to be expanded again.
+
+ if Is_Empty_List (Actions (N))
+ and then Compile_Time_Known_Value (Expression (N))
+ then
+ Rewrite (N, Expression (N));
+ end if;
end Resolve_Expression_With_Actions;
---------------------------
@@ -8996,6 +9016,30 @@
R : constant Node_Id := Right_Opnd (N);
begin
+ -- Ensure all actions associated with the left operand (e.g.
+ -- finalization of transient controlled objects) are fully evaluated
+ -- locally within an expression with actions. This is particularly
+ -- helpful for coverage analysis. However this should not happen in
+ -- generics.
+
+ if Expander_Active then
+ declare
+ Reloc_L : constant Node_Id := Relocate_Node (L);
+ begin
+ Save_Interps (Old_N => L, New_N => Reloc_L);
+
+ Rewrite (L,
+ Make_Expression_With_Actions (Sloc (L),
+ Actions => New_List,
+ Expression => Reloc_L));
+
+ -- Set Comes_From_Source on L to preserve warnings for unset
+ -- reference.
+
+ Set_Comes_From_Source (L, Comes_From_Source (Reloc_L));
+ end;
+ end if;
+
Resolve (L, B_Typ);
Resolve (R, B_Typ);
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb (revision 203762)
+++ exp_ch4.adb (working copy)
@@ -12135,15 +12135,26 @@
(Decl : Node_Id;
Rel_Node : Node_Id)
is
- function Find_Enclosing_Context (N : Node_Id) return Node_Id;
- -- Find the logical context where N appears. The context is chosen such
- -- that it is possible to insert before and after it.
+ Hook_Context : Node_Id;
+ -- Node on which to insert the hook pointer (as an action)
- ----------------------------
- -- Find_Enclosing_Context --
- ----------------------------
+ Finalization_Context : Node_Id;
+ -- Node after which to insert finalization actions
- function Find_Enclosing_Context (N : Node_Id) return Node_Id is
+ Finalize_Always : Boolean;
+ -- If False, call to finalizer includes a test of whether the
+ -- hook pointer is null.
+
+ procedure Find_Enclosing_Contexts (N : Node_Id);
+ -- Find the logical context where N appears, and initializae
+ -- Hook_Context and Finalization_Context accordingly. Also
+ -- sets Finalize_Always.
+
+ -----------------------------
+ -- Find_Enclosing_Contexts --
+ -----------------------------
+
+ procedure Find_Enclosing_Contexts (N : Node_Id) is
Par : Node_Id;
Top : Node_Id;
@@ -12153,7 +12164,7 @@
-- other controlled values can reuse it.
if Scope_Is_Transient then
- return Node_To_Be_Wrapped;
+ Hook_Context := Node_To_Be_Wrapped;
-- In some cases, such as return statements, no transient scope is
-- generated, in which case we have to look up in the tree to find
@@ -12193,7 +12204,8 @@
N_Parameter_Association,
N_Pragma_Argument_Association)
then
- return Par;
+ Hook_Context := Par;
+ goto Hook_Context_Found;
-- Prevent the search from going too far
@@ -12204,26 +12216,10 @@
Par := Parent (Par);
end loop;
- return Par;
+ Hook_Context := Par;
+ goto Hook_Context_Found;
- -- Short circuit operators in complex expressions are converted into
- -- expression_with_actions.
-
else
- -- Handle the case where the node is buried deep inside an if
- -- statement. The temporary controlled object must be finalized
- -- before the then, elsif or else statements are evaluated.
-
- -- if Something
- -- and then Ctrl_Func_Call
- -- then
- -- <result must be finalized at this point>
- -- <statements>
- -- end if;
-
- -- To achieve this, find the topmost logical operator. Generated
- -- actions are then inserted before/after it.
-
Par := N;
while Present (Par) loop
@@ -12267,7 +12263,8 @@
N_Procedure_Call_Statement,
N_Simple_Return_Statement)
then
- return Par;
+ Hook_Context := Par;
+ goto Hook_Context_Found;
-- Prevent the search from going too far
@@ -12280,25 +12277,66 @@
-- Return the topmost short circuit operator
- return Top;
+ Hook_Context := Top;
end if;
- end Find_Enclosing_Context;
+ <<Hook_Context_Found>>
+
+ -- Special case for Boolean EWAs: capture expression in a temporary,
+ -- whose declaration will serve as the context around which to insert
+ -- finalization code. The finalization thus remains local to the
+ -- specific condition being evaluated.
+
+ if Is_Boolean_Type (Etype (N)) then
+
+ -- In this case, the finalization context is chosen so that
+ -- we know at finalization point that the hook pointer is
+ -- never null, so no need for a test, we can call the finalizer
+ -- unconditionally.
+
+ Finalize_Always := True;
+
+ declare
+ Loc : constant Source_Ptr := Sloc (N);
+ Temp : constant Entity_Id := Make_Temporary (Loc, 'E', N);
+ begin
+ Append_To (Actions (N),
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Temp,
+ Constant_Present => True,
+ Object_Definition =>
+ New_Occurrence_Of (Etype (N), Loc),
+ Expression => Expression (N)));
+ Finalization_Context := Last (Actions (N));
+
+ Analyze (Last (Actions (N)));
+
+ Set_Expression (N, New_Occurrence_Of (Temp, Loc));
+ Analyze (Expression (N));
+ end;
+
+ else
+ Finalize_Always := False;
+ Finalization_Context := Hook_Context;
+ end if;
+ end Find_Enclosing_Contexts;
+
-- Local variables
- Context : constant Node_Id := Find_Enclosing_Context (Rel_Node);
Loc : constant Source_Ptr := Sloc (Decl);
Obj_Id : constant Entity_Id := Defining_Identifier (Decl);
Obj_Typ : constant Node_Id := Etype (Obj_Id);
Desig_Typ : Entity_Id;
Expr : Node_Id;
- Fin_Call : Node_Id;
+ Fin_Stmts : List_Id;
Ptr_Id : Entity_Id;
Temp_Id : Entity_Id;
-- Start of processing for Process_Transient_Object
begin
+ Find_Enclosing_Contexts (Rel_Node);
+
-- Step 1: Create the access type which provides a reference to the
-- transient controlled object.
@@ -12315,7 +12353,7 @@
Ptr_Id := Make_Temporary (Loc, 'A');
- Insert_Action (Context,
+ Insert_Action (Hook_Context,
Make_Full_Type_Declaration (Loc,
Defining_Identifier => Ptr_Id,
Type_Definition =>
@@ -12330,7 +12368,7 @@
Temp_Id := Make_Temporary (Loc, 'T');
- Insert_Action (Context,
+ Insert_Action (Hook_Context,
Make_Object_Declaration (Loc,
Defining_Identifier => Temp_Id,
Object_Definition => New_Reference_To (Ptr_Id, Loc)));
@@ -12363,11 +12401,19 @@
-- <or>
-- Temp := Obj_Id'Unrestricted_Access;
- Insert_After_And_Analyze (Decl,
- Make_Assignment_Statement (Loc,
- Name => New_Reference_To (Temp_Id, Loc),
- Expression => Expr));
+ if Finalization_Context /= Hook_Context then
+ Insert_Action (Finalization_Context,
+ Make_Assignment_Statement (Loc,
+ Name => New_Reference_To (Temp_Id, Loc),
+ Expression => Expr));
+ else
+ Insert_After_And_Analyze (Decl,
+ Make_Assignment_Statement (Loc,
+ Name => New_Reference_To (Temp_Id, Loc),
+ Expression => Expr));
+ end if;
+
-- Step 4: Finalize the transient controlled object after the context
-- has been evaluated/elaborated. Generate:
@@ -12383,26 +12429,29 @@
-- insert the finalization code after the return statement as this will
-- render it unreachable.
- if Nkind (Context) /= N_Simple_Return_Statement then
- Fin_Call :=
- Make_Implicit_If_Statement (Decl,
- Condition =>
- Make_Op_Ne (Loc,
- Left_Opnd => New_Reference_To (Temp_Id, Loc),
- Right_Opnd => Make_Null (Loc)),
+ if Nkind (Finalization_Context) /= N_Simple_Return_Statement then
+ Fin_Stmts := New_List (
+ Make_Final_Call
+ (Obj_Ref =>
+ Make_Explicit_Dereference (Loc,
+ Prefix => New_Reference_To (Temp_Id, Loc)),
+ Typ => Desig_Typ),
- Then_Statements => New_List (
- Make_Final_Call
- (Obj_Ref =>
- Make_Explicit_Dereference (Loc,
- Prefix => New_Reference_To (Temp_Id, Loc)),
- Typ => Desig_Typ),
+ Make_Assignment_Statement (Loc,
+ Name => New_Reference_To (Temp_Id, Loc),
+ Expression => Make_Null (Loc)));
- Make_Assignment_Statement (Loc,
- Name => New_Reference_To (Temp_Id, Loc),
- Expression => Make_Null (Loc))));
+ if not Finalize_Always then
+ Fin_Stmts := New_List (
+ Make_Implicit_If_Statement (Decl,
+ Condition =>
+ Make_Op_Ne (Loc,
+ Left_Opnd => New_Reference_To (Temp_Id, Loc),
+ Right_Opnd => Make_Null (Loc)),
+ Then_Statements => Fin_Stmts));
+ end if;
- Insert_Action_After (Context, Fin_Call);
+ Insert_Actions_After (Finalization_Context, Fin_Stmts);
end if;
end Process_Transient_Object;
Index: sem_warn.adb
===================================================================
--- sem_warn.adb (revision 203755)
+++ sem_warn.adb (working copy)
@@ -1310,6 +1310,7 @@
UR := Original_Node (UR);
while Nkind (UR) = N_Type_Conversion
or else Nkind (UR) = N_Qualified_Expression
+ or else Nkind (UR) = N_Expression_With_Actions
loop
UR := Expression (UR);
end loop;
@@ -2034,9 +2035,12 @@
Check_Unset_Reference (Pref);
end;
- -- For type conversions or qualifications examine the expression
+ -- For type conversions, qualifications, or expressions with actions,
+ -- examine the expression.
- when N_Type_Conversion | N_Qualified_Expression =>
+ when N_Type_Conversion |
+ N_Qualified_Expression |
+ N_Expression_With_Actions =>
Check_Unset_Reference (Expression (N));
-- For explicit dereference, always check prefix, which will generate
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 203761)
+++ sem_ch13.adb (working copy)
@@ -7279,6 +7279,16 @@
when N_Qualified_Expression =>
return Get_RList (Expression (Exp));
+ -- Expression with actions: if no actions, dig out expression
+
+ when N_Expression_With_Actions =>
+ if Is_Empty_List (Actions (Exp)) then
+ return Get_RList (Expression (Exp));
+
+ else
+ raise Non_Static;
+ end if;
+
-- Xor operator
when N_Op_Xor =>
