From 3e2399bafcb068ca3111b6fbc69cff38ed442bb8 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 18 Jun 2010 10:25:27 +0200 Subject: [PATCH] [multiple changes] 2010-06-18 Vincent Celier * make.adb (Must_Compile): New Boolean global variable (Main_On_Command_Line): New Boolean global variable (Collect_Arguments_And_Compile): Do compile if Must_Compile is True, even when the project is externally built. (Start_Compile_If_Possible): Compile in -aL directories if Check_Readonly_Files is True. Do compile if Must_Compile is True, even when the project is externally built. (Gnatmake): Set Must_Compile and Check_Readonly_Files to True when invoked with -f -u and one or several mains on the command line. (Scan_Make_Arg): Set Main_On_Command_Line to True when at least one main is specified on the command line. 2010-06-18 Ed Schonberg * sem_ch6.adb (Build_Body_For_Inline): Handle extended_return_statements * exp_ch6.adb (Expand_Inlined_Call): when possible, inline a body containing extented_return statements. * exp_util.adb (Make_CW_Equivalent_Type): If the root type is already constrained, do not build subtype declaration. From-SVN: r160962 --- gcc/ada/ChangeLog | 22 ++++++++++++++ gcc/ada/exp_ch6.adb | 68 ++++++++++++++++++++++++++++++++++++++++++-- gcc/ada/exp_util.adb | 9 ++++-- gcc/ada/make.adb | 62 +++++++++++++++++++++++++++++----------- gcc/ada/sem_ch6.adb | 68 +++++++++++++++++++++++++++++++++++--------- 5 files changed, 194 insertions(+), 35 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5075e1b12f6..5577d777cd4 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,25 @@ +2010-06-18 Vincent Celier + + * make.adb (Must_Compile): New Boolean global variable + (Main_On_Command_Line): New Boolean global variable + (Collect_Arguments_And_Compile): Do compile if Must_Compile is True, + even when the project is externally built. + (Start_Compile_If_Possible): Compile in -aL directories if + Check_Readonly_Files is True. Do compile if Must_Compile is True, even + when the project is externally built. + (Gnatmake): Set Must_Compile and Check_Readonly_Files to True when + invoked with -f -u and one or several mains on the command line. + (Scan_Make_Arg): Set Main_On_Command_Line to True when at least one main + is specified on the command line. + +2010-06-18 Ed Schonberg + + * sem_ch6.adb (Build_Body_For_Inline): Handle extended_return_statements + * exp_ch6.adb (Expand_Inlined_Call): when possible, inline a body + containing extented_return statements. + * exp_util.adb (Make_CW_Equivalent_Type): If the root type is already + constrained, do not build subtype declaration. + 2010-06-18 Robert Dewar * sem_res.adb (Analyze_Indexed_Component, Analyze_Selected_Component): diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 51fe72875e5..5a36234d30d 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -3297,6 +3297,9 @@ package body Exp_Ch6 is Temp : Entity_Id; Temp_Typ : Entity_Id; + Return_Object : Entity_Id := Empty; + -- Entity in declaration in an extended_return_statement + Is_Unc : constant Boolean := Is_Array_Type (Etype (Subp)) and then not Is_Constrained (Etype (Subp)); @@ -3390,6 +3393,21 @@ package body Exp_Ch6 is Rewrite (N, New_Copy (A)); end if; end if; + return Skip; + + elsif Is_Entity_Name (N) + and then Chars (N) = Chars (Return_Object) + then + -- Occurrence within an extended return statement. The return + -- object is local to the body been inlined, and thus the generic + -- copy is not analyzed yet, so we match by name, and replace it + -- with target of call. + + if Nkind (Targ) = N_Defining_Identifier then + Rewrite (N, New_Occurrence_Of (Targ, Loc)); + else + Rewrite (N, New_Copy_Tree (Targ)); + end if; return Skip; @@ -3397,8 +3415,7 @@ package body Exp_Ch6 is if No (Expression (N)) then Make_Exit_Label; Rewrite (N, - Make_Goto_Statement (Loc, - Name => New_Copy (Lab_Id))); + Make_Goto_Statement (Loc, Name => New_Copy (Lab_Id))); else if Nkind (Parent (N)) = N_Handled_Sequence_Of_Statements @@ -3456,6 +3473,46 @@ package body Exp_Ch6 is return OK; + elsif Nkind (N) = N_Extended_Return_Statement then + + -- An extended return becomes a block whose first statement is + -- the assignment of the initial expression of the return object + -- to the target of the call itself. + + declare + Return_Decl : constant Entity_Id := + First (Return_Object_Declarations (N)); + Assign : Node_Id; + + begin + Return_Object := Defining_Identifier (Return_Decl); + + if Present (Expression (Return_Decl)) then + if Nkind (Targ) = N_Defining_Identifier then + Assign := + Make_Assignment_Statement (Loc, + Name => New_Occurrence_Of (Targ, Loc), + Expression => Expression (Return_Decl)); + else + Assign := + Make_Assignment_Statement (Loc, + Name => New_Copy (Targ), + Expression => Expression (Return_Decl)); + end if; + + Set_Assignment_OK (Name (Assign)); + Prepend (Assign, + Statements (Handled_Statement_Sequence (N))); + end if; + + Rewrite (N, + Make_Block_Statement (Loc, + Handled_Statement_Sequence => + Handled_Statement_Sequence (N))); + + return OK; + end; + -- Remove pragma Unreferenced since it may refer to formals that -- are not visible in the inlined body, and in any case we will -- not be posting warnings on the inlined body so it is unneeded. @@ -3866,6 +3923,11 @@ package body Exp_Ch6 is then Targ := Name (Parent (N)); + elsif Nkind (Parent (N)) = N_Object_Declaration + and then Is_Limited_Type (Etype (Subp)) + then + Targ := Defining_Identifier (Parent (N)); + else -- Replace call with temporary and create its declaration diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 634a03ff2af..4f72a7a5f8a 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -3751,7 +3751,12 @@ package body Exp_Util is Sizexpr : Node_Id; begin - if not Has_Discriminants (Root_Typ) then + -- If the root type is already constrained, there are no discriminants + -- in the expression. + + if not Has_Discriminants (Root_Typ) + or else Is_Constrained (Root_Typ) + then Constr_Root := Root_Typ; else Constr_Root := Make_Temporary (Loc, 'R'); diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index f9df7fc2c50..3af872f29f0 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -202,6 +202,14 @@ package body Make is Unique_Compile_All_Projects : Boolean := False; -- Set to True if -U is used + Must_Compile : Boolean := False; + -- True if gnatmake is invoked with -f -u and one or several mains on the + -- command line. + + Main_On_Command_Line : Boolean := False; + -- True if gnatmake is invoked with one or several mains on the command + -- line. + RTS_Specified : String_Access := null; -- Used to detect multiple --RTS= switches @@ -2243,12 +2251,14 @@ package body Make is if Arguments_Project = No_Project then Add_Arguments (The_Saved_Gcc_Switches.all); - elsif not Arguments_Project.Externally_Built then + elsif not Arguments_Project.Externally_Built + or else Must_Compile + then -- We get the project directory for the relative path -- switches and arguments. - Arguments_Project := Ultimate_Extending_Project_Of - (Arguments_Project); + Arguments_Project := + Ultimate_Extending_Project_Of (Arguments_Project); -- If building a dynamic or relocatable library, compile with -- PIC option, if it exists. @@ -2258,7 +2268,6 @@ package body Make is then declare PIC : constant String := MLib.Tgt.PIC_Option; - begin if PIC /= "" then Add_Arguments ((1 => new String'(PIC))); @@ -2726,7 +2735,9 @@ package body Make is -- check for an eventual library project, and use the full path. if Arguments_Project /= No_Project then - if not Arguments_Project.Externally_Built then + if not Arguments_Project.Externally_Built + or else Must_Compile + then Prj.Env.Set_Ada_Paths (Arguments_Project, Project_Tree, @@ -2742,7 +2753,7 @@ package body Make is begin if Prj.Library - and then not Prj.Externally_Built + and then (not Prj.Externally_Built or else Must_Compile) and then not Prj.Need_To_Build_Lib then -- Add to the Q all sources of the project that have @@ -3272,8 +3283,9 @@ package body Make is Executable_Obsolete := True; end if; - In_Lib_Dir := Full_Lib_File /= No_File - and then In_Ada_Lib_Dir (Full_Lib_File); + In_Lib_Dir := not Check_Readonly_Files + and then Full_Lib_File /= No_File + and then In_Ada_Lib_Dir (Full_Lib_File); -- Since the following requires a system call, we precompute it -- when needed. @@ -3350,6 +3362,7 @@ package body Make is if Arguments_Project = No_Project or else not Arguments_Project.Externally_Built + or else Must_Compile then -- Don't waste any time if we have to recompile anyway @@ -4739,13 +4752,6 @@ package body Make is Display_Version ("GNATMAKE", "1995"); end if; - if Main_Project /= No_Project - and then Main_Project.Externally_Built - then - Make_Failed - ("nothing to do for a main project that is externally built"); - end if; - if Osint.Number_Of_Files = 0 then if Main_Project /= No_Project and then Main_Project.Library @@ -5182,6 +5188,26 @@ package body Make is end; end if; + -- The combination of -f -u and one or several mains on the command line + -- implies -a. + + if Force_Compilations + and then Unique_Compile + and then not Unique_Compile_All_Projects + and then Main_On_Command_Line + then + Check_Readonly_Files := True; + Must_Compile := True; + end if; + + if Main_Project /= No_Project + and then not Must_Compile + and then Main_Project.Externally_Built + then + Make_Failed + ("nothing to do for a main project that is externally built"); + end if; + -- Get the target parameters, which are only needed for a couple of -- cases in gnatmake. Protect against an exception, such as the case of -- system.ads missing from the library, and fail gracefully. @@ -8219,6 +8245,10 @@ package body Make is -- If not a switch it must be a file name else + if And_Save then + Main_On_Command_Line := True; + end if; + Add_File (Argv); Mains.Add_Main (Argv); end if; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index ba3967a75ea..2be771a36af 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -3103,6 +3103,15 @@ package body Sem_Ch6 is and then Has_Excluded_Statement (Statements (S)) then return True; + + elsif Nkind (S) = N_Extended_Return_Statement then + if Has_Excluded_Statement + (Statements (Handled_Statement_Sequence (S))) + or else Present + (Exception_Handlers (Handled_Statement_Sequence (S))) + then + return True; + end if; end if; Next (S); @@ -3170,12 +3179,33 @@ package body Sem_Ch6 is return Abandon; end if; + -- A return statement within an extended return is a noop + -- after inlining. + + elsif No (Expression (N)) + and then Nkind (Parent (Parent (N))) = + N_Extended_Return_Statement + then + return OK; + else -- Expression has wrong form return Abandon; end if; + -- We can only inline a build-in-place function if + -- it has a single extended return. + + elsif Nkind (N) = N_Extended_Return_Statement then + if No (Return_Statement) then + Return_Statement := N; + return OK; + + else + return Abandon; + end if; + else return OK; end if; @@ -3186,11 +3216,18 @@ package body Sem_Ch6 is -- Start of processing for Has_Single_Return begin - return Check_All_Returns (N) = OK - and then Present (Declarations (N)) - and then Present (First (Declarations (N))) - and then Chars (Expression (Return_Statement)) = - Chars (Defining_Identifier (First (Declarations (N)))); + if Check_All_Returns (N) /= OK then + return False; + + elsif Nkind (Return_Statement) = N_Extended_Return_Statement then + return True; + + else + return Present (Declarations (N)) + and then Present (First (Declarations (N))) + and then Chars (Expression (Return_Statement)) = + Chars (Defining_Identifier (First (Declarations (N)))); + end if; end Has_Single_Return; -------------------- @@ -4444,10 +4481,10 @@ package body Sem_Ch6 is Error_Msg_Sloc := Sloc (Overridden_Subp); if Ekind (Subp) = E_Entry then - Error_Msg_NE + Error_Msg_NE -- CODEFIX??? ("entry & overrides inherited operation #", Spec, Subp); else - Error_Msg_NE + Error_Msg_NE -- CODEFIX??? ("subprogram & overrides inherited operation #", Spec, Subp); end if; @@ -4498,12 +4535,12 @@ package body Sem_Ch6 is if not Is_Primitive and then Ekind (Scope (Subp)) /= E_Protected_Type then - Error_Msg_N + Error_Msg_N -- CODEFIX??? ("overriding indicator only allowed " & "if subprogram is primitive", Subp); elsif Can_Override then - Error_Msg_NE + Error_Msg_NE -- CODEFIX??? ("subprogram & overrides predefined operator ", Spec, Subp); end if; @@ -4513,7 +4550,8 @@ package body Sem_Ch6 is Set_Is_Overriding_Operation (Subp); elsif not Can_Override then - Error_Msg_NE ("subprogram & is not overriding", Spec, Subp); + Error_Msg_NE -- CODEFIX??? + ("subprogram & is not overriding", Spec, Subp); end if; elsif not Error_Posted (Subp) @@ -4542,9 +4580,11 @@ package body Sem_Ch6 is elsif Must_Override (Spec) then if Ekind (Subp) = E_Entry then - Error_Msg_NE ("entry & is not overriding", Spec, Subp); + Error_Msg_NE -- CODEFIX??? + ("entry & is not overriding", Spec, Subp); else - Error_Msg_NE ("subprogram & is not overriding", Spec, Subp); + Error_Msg_NE -- CODEFIX??? + ("subprogram & is not overriding", Spec, Subp); end if; -- If the operation is marked "not overriding" and it's not primitive @@ -4557,7 +4597,7 @@ package body Sem_Ch6 is and then Ekind (Subp) /= E_Entry and then Ekind (Scope (Subp)) /= E_Protected_Type then - Error_Msg_N + Error_Msg_N -- CODEFIX??? ("overriding indicator only allowed if subprogram is primitive", Subp); return; -- 2.30.2