diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 866df4e94c4..1ac765362cd 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2016-05-02 Javier Miranda + + * exp_util.ads, exp_util.adb (Force_Evaluation): Adding new formal. + (Remove_Side_Effects): Adding a new formal. + * exp_ch6.adb (Expand_Simple_Function_Return): Generating the + call to the _Postconditions procedure ensure that side-effects + are unconditionally removed. + +2016-05-02 Ed Schonberg + + * sem_ch12.adb (Check_Formal_Package_Instance, Check_Mismatch): + Use original node to determine whether the declaration is for + a formal type declaration, to take into account that formwl + private types are rewritten as private extension declarations + to simplify semantic analysis. + 2016-05-02 Gary Dismukes * exp_ch9.adb, sem_ch6.adb, sem_ch6.ads: Minor reformatting and typo diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 8d0b96309fe..4c89374f9d0 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -6800,7 +6800,7 @@ package body Exp_Ch6 is -- once in the call to _Postconditions, and once in the actual return -- statement, but we can't have side effects happening twice. - Remove_Side_Effects (Exp); + Force_Evaluation (Exp, Mode => Strict); -- Generate call to _Postconditions diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index b4efc938060..06d3c32d941 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -3118,7 +3118,8 @@ package body Exp_Util is Name_Req : Boolean := False; Related_Id : Entity_Id := Empty; Is_Low_Bound : Boolean := False; - Is_High_Bound : Boolean := False) + Is_High_Bound : Boolean := False; + Mode : Force_Evaluation_Mode := Relaxed) is begin Remove_Side_Effects @@ -3128,7 +3129,10 @@ package body Exp_Util is Renaming_Req => False, Related_Id => Related_Id, Is_Low_Bound => Is_Low_Bound, - Is_High_Bound => Is_High_Bound); + Is_High_Bound => Is_High_Bound, + Check_Side_Effects => + Is_Static_Expression (Exp) + or else Mode = Relaxed); end Force_Evaluation; --------------------------------- @@ -7545,13 +7549,14 @@ package body Exp_Util is ------------------------- procedure Remove_Side_Effects - (Exp : Node_Id; - Name_Req : Boolean := False; - Renaming_Req : Boolean := False; - Variable_Ref : Boolean := False; - Related_Id : Entity_Id := Empty; - Is_Low_Bound : Boolean := False; - Is_High_Bound : Boolean := False) + (Exp : Node_Id; + Name_Req : Boolean := False; + Renaming_Req : Boolean := False; + Variable_Ref : Boolean := False; + Related_Id : Entity_Id := Empty; + Is_Low_Bound : Boolean := False; + Is_High_Bound : Boolean := False; + Check_Side_Effects : Boolean := True) is function Build_Temporary (Loc : Source_Ptr; @@ -7685,7 +7690,9 @@ package body Exp_Util is -- No action needed for side-effect free expressions - elsif Side_Effect_Free (Exp, Name_Req, Variable_Ref) then + elsif Check_Side_Effects + and then Side_Effect_Free (Exp, Name_Req, Variable_Ref) + then return; end if; diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index 1bde973f0e7..9beb054fca4 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -526,19 +526,25 @@ package Exp_Util is -- Note: currently this function does not scan the private part, that seems -- like a potential bug ??? + type Force_Evaluation_Mode is (Relaxed, Strict); + procedure Force_Evaluation (Exp : Node_Id; Name_Req : Boolean := False; Related_Id : Entity_Id := Empty; Is_Low_Bound : Boolean := False; - Is_High_Bound : Boolean := False); + Is_High_Bound : Boolean := False; + Mode : Force_Evaluation_Mode := Relaxed); -- Force the evaluation of the expression right away. Similar behavior -- to Remove_Side_Effects when Variable_Ref is set to TRUE. That is to -- say, it removes the side effects and captures the values of the -- variables. Remove_Side_Effects guarantees that multiple evaluations -- of the same expression won't generate multiple side effects, whereas -- Force_Evaluation further guarantees that all evaluations will yield - -- the same result. + -- the same result. If Mode is Relaxed then calls to this subprogram have + -- no effect if Exp is side-effects free; if Mode is Strict and Exp is not + -- a static expression then no side-effects check is performed on Exp and + -- temporaries are unconditionally generated. -- -- Related_Id denotes the entity of the context where Expr appears. Flags -- Is_Low_Bound and Is_High_Bound specify whether the expression to check @@ -861,13 +867,14 @@ package Exp_Util is -- associated with Var, and if found, remove and return that call node. procedure Remove_Side_Effects - (Exp : Node_Id; - Name_Req : Boolean := False; - Renaming_Req : Boolean := False; - Variable_Ref : Boolean := False; - Related_Id : Entity_Id := Empty; - Is_Low_Bound : Boolean := False; - Is_High_Bound : Boolean := False); + (Exp : Node_Id; + Name_Req : Boolean := False; + Renaming_Req : Boolean := False; + Variable_Ref : Boolean := False; + Related_Id : Entity_Id := Empty; + Is_Low_Bound : Boolean := False; + Is_High_Bound : Boolean := False; + Check_Side_Effects : Boolean := True); -- Given the node for a subexpression, this function replaces the node if -- necessary by an equivalent subexpression that is guaranteed to be side -- effect free. This is done by extracting any actions that could cause @@ -880,7 +887,8 @@ package Exp_Util is -- expression. If Variable_Ref is set to True, a variable is considered as -- side effect (used in implementing Force_Evaluation). Note: after call to -- Remove_Side_Effects, it is safe to call New_Copy_Tree to obtain a copy - -- of the resulting expression. + -- of the resulting expression. If Check_Side_Effects is set to True then + -- no action is performed if Exp is known to be side-effect free. -- -- Related_Id denotes the entity of the context where Expr appears. Flags -- Is_Low_Bound and Is_High_Bound specify whether the expression to check diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 04b7fb4d392..0d8446df96c 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -5759,7 +5759,11 @@ package body Sem_Ch12 is -------------------- procedure Check_Mismatch (B : Boolean) is - Kind : constant Node_Kind := Nkind (Parent (E2)); + -- a Formal_Type_Declaration for a derived private type is rewritten + -- as a private extension decl. (see Analyze_Formal_Derived_Type), + -- which is why we examine the original node. + + Kind : constant Node_Kind := Nkind (Original_Node (Parent (E2))); begin if Kind = N_Formal_Type_Declaration then @@ -5923,7 +5927,10 @@ package body Sem_Ch12 is -- If the formal entity comes from a formal declaration, it was -- defaulted in the formal package, and no check is needed on it. - elsif Nkind (Parent (E2)) = N_Formal_Object_Declaration then + elsif + Nkind_In (Original_Node (Parent (E2)), + N_Formal_Object_Declaration, N_Formal_Type_Declaration) + then goto Next_E; -- Ditto for defaulted formal subprograms.