diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2c0a31da35d..9a1aeae53e5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,35 @@ +2016-04-18 Arnaud Charlet + + * exp_ch4.adb, gnat1drv.adb, opt.ads, sem_res.adb + (Minimize_Expression_With_Actions): New flag. + (Adjust_Global_Switches): Set Minimize_Expression_With_Actions + when generating C. + (Resolve_Short_Circuit): Redo previous change + using Minimize_Expression_With_Actions. + (Expand_N_If_Expression, + Expand_Short_Circuit_Operator): Restore old code to avoid + Expression_With_Actions when Minimize_Expression_With_Actions + is set. + +2016-04-18 Vincent Celier + + * s-os_lib.adb (Non_Blocking_Spawn, version with Stdout_File and + Stderr_File): Close local file descriptors when no longer needed. + +2016-04-18 Ed Schonberg + + * sem_ch5.adb (Analyze_Iterator_Specification): Remove SPARK + mode check that the type of the cursor in an iteration over + a formal container is not volatile. The proper check on the + element type is done elsewhere. + +2016-04-18 Ed Schonberg + + * sem_ch6.adb (Process_Formals): Do not set a delay freeze on + a subprogram that returns a class-wide type, if the subprogram + is a compilation unit, because otherwise gigi will treat the + subprogram as external, leading to link errors. + 2016-04-18 Arnaud Charlet * sem_res.adb (Resolve_Short_Circuit): Do not use diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 125fa1284ab..b08ebfe0f91 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -5267,31 +5267,59 @@ package body Exp_Ch4 is -- expression, and Sem_Elab circuitry removing it repeatedly. if Compile_Time_Known_Value (Cond) then - if Is_True (Expr_Value (Cond)) then - Expr := Thenx; - Actions := Then_Actions (N); - else - Expr := Elsex; - Actions := Else_Actions (N); - end if; + declare + function Fold_Known_Value (Cond : Node_Id) return Boolean; + -- Fold at compile time. Assumes condition known. + -- Return True if folding occurred, meaning we're done. - Remove (Expr); + ---------------------- + -- Fold_Known_Value -- + ---------------------- - if Present (Actions) then - Rewrite (N, - Make_Expression_With_Actions (Loc, - Expression => Relocate_Node (Expr), - Actions => Actions)); - Analyze_And_Resolve (N, Typ); - else - Rewrite (N, Relocate_Node (Expr)); - end if; + function Fold_Known_Value (Cond : Node_Id) return Boolean is + begin + if Is_True (Expr_Value (Cond)) then + Expr := Thenx; + Actions := Then_Actions (N); + else + Expr := Elsex; + Actions := Else_Actions (N); + end if; - -- Note that the result is never static (legitimate cases of static - -- if expressions were folded in Sem_Eval). + Remove (Expr); - Set_Is_Static_Expression (N, False); - return; + if Present (Actions) then + + -- If we want to minimize the use of + -- Expression_With_Actions, just skip the optimization, it + -- is not critical for correctness. + + if Minimize_Expression_With_Actions then + return False; + end if; + + Rewrite (N, + Make_Expression_With_Actions (Loc, + Expression => Relocate_Node (Expr), + Actions => Actions)); + Analyze_And_Resolve (N, Typ); + + else + Rewrite (N, Relocate_Node (Expr)); + end if; + + -- Note that the result is never static (legitimate cases of + -- static if expressions were folded in Sem_Eval). + + Set_Is_Static_Expression (N, False); + return True; + end Fold_Known_Value; + + begin + if Fold_Known_Value (Cond) then + return; + end if; + end; end if; -- If the type is limited, and the back end does not handle limited @@ -5423,28 +5451,74 @@ package body Exp_Ch4 is -- We now wrap the actions into the appropriate expression - if Present (Then_Actions (N)) then - Rewrite (Thenx, - Make_Expression_With_Actions (Sloc (Thenx), - Actions => Then_Actions (N), - Expression => Relocate_Node (Thenx))); + if Minimize_Expression_With_Actions then - Set_Then_Actions (N, No_List); - Analyze_And_Resolve (Thenx, Typ); + -- If we can't use N_Expression_With_Actions nodes, then we insert + -- the following sequence of actions (using Insert_Actions): + + -- Cnn : typ; + -- if cond then + -- <> + -- Cnn := then-expr; + -- else + -- <> + -- Cnn := else-expr + -- end if; + + -- and replace the if expression by a reference to Cnn + + Cnn := Make_Temporary (Loc, 'C', N); + + Decl := + Make_Object_Declaration (Loc, + Defining_Identifier => Cnn, + Object_Definition => New_Occurrence_Of (Typ, Loc)); + + New_If := + Make_Implicit_If_Statement (N, + Condition => Relocate_Node (Cond), + + Then_Statements => New_List ( + Make_Assignment_Statement (Sloc (Thenx), + Name => New_Occurrence_Of (Cnn, Sloc (Thenx)), + Expression => Relocate_Node (Thenx))), + + Else_Statements => New_List ( + Make_Assignment_Statement (Sloc (Elsex), + Name => New_Occurrence_Of (Cnn, Sloc (Elsex)), + Expression => Relocate_Node (Elsex)))); + + Set_Assignment_OK (Name (First (Then_Statements (New_If)))); + Set_Assignment_OK (Name (First (Else_Statements (New_If)))); + + New_N := New_Occurrence_Of (Cnn, Loc); + + -- Regular path using Expression_With_Actions + + else + if Present (Then_Actions (N)) then + Rewrite (Thenx, + Make_Expression_With_Actions (Sloc (Thenx), + Actions => Then_Actions (N), + Expression => Relocate_Node (Thenx))); + + Set_Then_Actions (N, No_List); + Analyze_And_Resolve (Thenx, Typ); + end if; + + if Present (Else_Actions (N)) then + Rewrite (Elsex, + Make_Expression_With_Actions (Sloc (Elsex), + Actions => Else_Actions (N), + Expression => Relocate_Node (Elsex))); + + Set_Else_Actions (N, No_List); + Analyze_And_Resolve (Elsex, Typ); + end if; + + return; end if; - if Present (Else_Actions (N)) then - Rewrite (Elsex, - Make_Expression_With_Actions (Sloc (Elsex), - Actions => Else_Actions (N), - Expression => Relocate_Node (Elsex))); - - Set_Else_Actions (N, No_List); - Analyze_And_Resolve (Elsex, Typ); - end if; - - return; - -- If no actions then no expansion needed, gigi will handle it using the -- same approach as a C conditional expression. @@ -11614,6 +11688,31 @@ package body Exp_Ch4 is Shortcut_Ent : constant Entity_Id := Boolean_Literals (Shortcut_Value); -- If Left = Shortcut_Value then Right need not be evaluated + function Make_Test_Expr (Opnd : Node_Id) return Node_Id; + -- For Opnd a boolean expression, return a Boolean expression equivalent + -- to Opnd /= Shortcut_Value. + + -------------------- + -- Make_Test_Expr -- + -------------------- + + function Make_Test_Expr (Opnd : Node_Id) return Node_Id is + begin + if Shortcut_Value then + return Make_Op_Not (Sloc (Opnd), Opnd); + else + return Opnd; + end if; + end Make_Test_Expr; + + -- Local variables + + Op_Var : Entity_Id; + -- Entity for a temporary variable holding the value of the operator, + -- used for expansion in the case where actions are present. + + -- Start of processing for Expand_Short_Circuit_Operator + begin -- Deal with non-standard booleans @@ -11668,17 +11767,72 @@ package body Exp_Ch4 is if Present (Actions (N)) then Actlist := Actions (N); - -- We now use an Expression_With_Actions node for the right operand - -- of the short-circuit form. Note that this solves the traceability + -- The old approach is to expand: + + -- left AND THEN right + + -- into + + -- C : Boolean := False; + -- IF left THEN + -- Actions; + -- IF right THEN + -- C := True; + -- END IF; + -- END IF; + + -- and finally rewrite the operator into a reference to C. Similarly + -- for left OR ELSE right, with negated values. Note that this + -- rewrite causes some difficulties for coverage analysis because + -- of the introduction of the new variable C, which obscures the + -- structure of the test. + + -- We use this "old approach" if Minimize_Expression_With_Actions + -- is True. + + if Minimize_Expression_With_Actions then + Op_Var := Make_Temporary (Loc, 'C', Related_Node => N); + + Insert_Action (N, + Make_Object_Declaration (Loc, + Defining_Identifier => Op_Var, + Object_Definition => + New_Occurrence_Of (Standard_Boolean, Loc), + Expression => + New_Occurrence_Of (Shortcut_Ent, Loc))); + + Append_To (Actlist, + Make_Implicit_If_Statement (Right, + Condition => Make_Test_Expr (Right), + Then_Statements => New_List ( + Make_Assignment_Statement (LocR, + Name => New_Occurrence_Of (Op_Var, LocR), + Expression => + New_Occurrence_Of + (Boolean_Literals (not Shortcut_Value), LocR))))); + + Insert_Action (N, + Make_Implicit_If_Statement (Left, + Condition => Make_Test_Expr (Left), + Then_Statements => Actlist)); + + Rewrite (N, New_Occurrence_Of (Op_Var, Loc)); + Analyze_And_Resolve (N, Standard_Boolean); + + -- The new approach (the default) is to use an + -- Expression_With_Actions node for the right operand of the + -- short-circuit form. Note that this solves the traceability -- problems for coverage analysis. - Rewrite (Right, - Make_Expression_With_Actions (LocR, - Expression => Relocate_Node (Right), - Actions => Actlist)); + else + Rewrite (Right, + Make_Expression_With_Actions (LocR, + Expression => Relocate_Node (Right), + Actions => Actlist)); - Set_Actions (N, No_List); - Analyze_And_Resolve (Right, Standard_Boolean); + Set_Actions (N, No_List); + Analyze_And_Resolve (Right, Standard_Boolean); + end if; Adjust_Result_Type (N, Typ); return; @@ -11694,8 +11848,8 @@ package body Exp_Ch4 is Set_SCO_Condition (Right, Expr_Value_E (Right) = Standard_True); end if; - -- Change (Left and then True), (Left or else False) to Left. - -- Note that we know there are no actions associated with the right + -- Change (Left and then True), (Left or else False) to Left. Note + -- that we know there are no actions associated with the right -- operand, since we just checked for this case above. if Expr_Value_E (Right) /= Shortcut_Ent then diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index bc52f41ae91..420482fbcaa 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -148,6 +148,7 @@ procedure Gnat1drv is if Generate_C_Code then Modify_Tree_For_C := True; Unnest_Subprogram_Mode := True; + Minimize_Expression_With_Actions := True; -- Set operating mode to Generate_Code to benefit from full front-end -- expansion (e.g. generics). diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 1766950f753..ad4ab8155c8 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -1061,6 +1061,12 @@ package Opt is -- GNATMAKE -- Set to True if minimal recompilation mode requested + Minimize_Expression_With_Actions : Boolean := False; + -- GNAT + -- If True, minimize the use of N_Expression_With_Actions node. + -- This can be used in particular on some back-ends where this node is + -- difficult to support. + Modify_Tree_For_C : Boolean := False; -- GNAT -- If this switch is set True (currently it is set only by -gnatd.V), then diff --git a/gcc/ada/s-os_lib.adb b/gcc/ada/s-os_lib.adb index 15f1fa7572a..92745ba0097 100644 --- a/gcc/ada/s-os_lib.adb +++ b/gcc/ada/s-os_lib.adb @@ -1867,6 +1867,14 @@ package body System.OS_Lib is Result := Non_Blocking_Spawn (Program_Name, Args); + -- Close the files just created for the output, as the file descriptors + -- cannot be used anywhere, being local values. It is safe to do that, + -- as the file descriptors have been duplicated to form standard output + -- and standard error of the spawned process. + + Close (Stdout_FD); + Close (Stderr_FD); + -- Restore the standard output and error Dup2 (Saved_Output, Standout); diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index b29b73fb1c6..62eea8c6cd9 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -1758,7 +1758,6 @@ package body Sem_Ch5 is Subt : constant Node_Id := Subtype_Indication (N); Iter_Name : constant Node_Id := Name (N); - Ent : Entity_Id; Typ : Entity_Id; Bas : Entity_Id; @@ -2306,7 +2305,6 @@ package body Sem_Ch5 is Get_Cursor_Type (Parent (Find_Value_Of_Aspect (Typ, Aspect_Iterable)), Typ)); - Ent := Etype (Def_Id); else Set_Etype (Def_Id, Get_Cursor_Type (Typ)); @@ -2314,20 +2312,6 @@ package body Sem_Ch5 is end if; end if; - - -- A loop parameter cannot be effectively volatile (SPARK RM 7.1.3(4)). - -- This check is relevant only when SPARK_Mode is on as it is not a - -- standard Ada legality check. - - -- Not clear whether this applies to element iterators, where the - -- cursor is not an explicit entity ??? - - if SPARK_Mode = On - and then not Of_Present (N) - and then Is_Effectively_Volatile (Ent) - then - Error_Msg_N ("loop parameter cannot be volatile", Ent); - end if; end Analyze_Iterator_Specification; ------------------- diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 494260f1161..17e9fe19fe9 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -10504,10 +10504,12 @@ package body Sem_Ch6 is Analyze_Return_Type (Related_Nod); -- If return type is class-wide, subprogram freezing may be - -- delayed as well. + -- delayed as well, unless the declaration is a compilation unit + -- in which case the freeze node would appear too late. if Is_Class_Wide_Type (Etype (Current_Scope)) and then not Is_Thunk (Current_Scope) + and then not Is_Compilation_Unit (Current_Scope) and then Nkind (Unit_Declaration_Node (Current_Scope)) = N_Subprogram_Declaration then diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 0471b14b9a1..7cf498de34d 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -10044,11 +10044,9 @@ package body Sem_Res is -- 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. Similarly, we want to minimize use of expression with - -- actions when generating C code, and finalization is not supported - -- in this mode anyway. + -- generics or if Minimize_Expression_With_Actions is set. - if Expander_Active and not Generate_C_Code then + if Expander_Active and not Minimize_Expression_With_Actions then declare Reloc_L : constant Node_Id := Relocate_Node (L); begin