+2013-10-17 Thomas Quinot <quinot@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.
+
2013-10-17 Ed Schonberg <schonberg@adacore.com>
* sem_aux.ads, sem_aux.adb (Is_Immutably_Limited_Type): Make
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.
(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
+
+ Finalize_Always : Boolean;
+ -- If False, call to finalizer includes a test of whether the
+ -- hook pointer is null.
- function Find_Enclosing_Context (N : Node_Id) return Node_Id is
+ 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;
-- 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
N_Parameter_Association,
N_Pragma_Argument_Association)
then
- return Par;
+ Hook_Context := Par;
+ goto Hook_Context_Found;
-- Prevent the search from going too far
Par := Parent (Par);
end loop;
- return Par;
-
- -- Short circuit operators in complex expressions are converted into
- -- expression_with_actions.
+ Hook_Context := Par;
+ goto Hook_Context_Found;
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
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
-- 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.
Ptr_Id := Make_Temporary (Loc, 'A');
- Insert_Action (Context,
+ Insert_Action (Hook_Context,
Make_Full_Type_Declaration (Loc,
Defining_Identifier => Ptr_Id,
Type_Definition =>
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)));
-- <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:
-- 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;
(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
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
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;
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
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
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);
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 =>
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);
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;
---------------------------
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);
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,
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;
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
projects / thirdparty / gcc.git / commitdiff
