From: Thomas Quinot Date: Thu, 17 Oct 2013 13:58:39 +0000 (+0000) Subject: exp_util.adb (Get_Current_Value_Condition, [...]): Handle the case of expressions... X-Git-Tag: releases/gcc-4.9.0~3400 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=064f4527c45595301de59346f8bf3e200a93f966;p=thirdparty%2Fgcc.git exp_util.adb (Get_Current_Value_Condition, [...]): Handle the case of expressions with actions * exp_util.adb (Insert_Actions):... 2013-10-17 Thomas Quinot * 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. From-SVN: r203763 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0580bf2d9729..a815f366bc63 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,39 @@ +2013-10-17 Thomas Quinot + + * 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 * sem_aux.ads, sem_aux.adb (Is_Immutably_Limited_Type): Make diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 65dedc20a95a..328e05e5aaf3 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -5092,6 +5092,13 @@ package body Checks is 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. diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 00da14726b1c..0356b67e6c69 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -12135,15 +12135,26 @@ package body Exp_Ch4 is (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; @@ -12153,7 +12164,7 @@ package body Exp_Ch4 is -- 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 @@ package body Exp_Ch4 is 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 @@ package body Exp_Ch4 is 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 - -- - -- - -- 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 @@ package body Exp_Ch4 is 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 @@ package body Exp_Ch4 is -- Return the topmost short circuit operator - return Top; + Hook_Context := Top; end if; - end Find_Enclosing_Context; + + <> + + -- 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 @@ package body Exp_Ch4 is 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 @@ package body Exp_Ch4 is 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,10 +12401,18 @@ package body Exp_Ch4 is -- -- 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 @@ package body Exp_Ch4 is -- 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; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 2e0185ea7fab..c260207550de 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -2706,18 +2706,36 @@ package body Exp_Util is (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,8 +2816,15 @@ package body Exp_Util is 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 @@ -3406,8 +3431,13 @@ package body Exp_Util is 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 @@ package body Exp_Util is 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 @@ package body Exp_Util is 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,7 +7817,14 @@ package body Exp_Util is 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); diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 6aef3843016d..0ba9d8fa14a0 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -7279,6 +7279,16 @@ package body Sem_Ch13 is 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 => diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 805dc68a9238..ca7310585b4f 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -2095,10 +2095,19 @@ package body Sem_Res is 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 @@ package body Sem_Res is 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 @@ package body Sem_Res is 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); diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index f0dcd0333c33..6e9e7fe464fb 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -6777,6 +6777,12 @@ package body Sem_Util is 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, diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 493c5e4f517d..dd6a904daa6c 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -1310,6 +1310,7 @@ package body Sem_Warn is 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 @@ package body Sem_Warn is 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