[multiple changes]

2010-06-18  Vincent Celier  <celier@adacore.com>

	* 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  <schonberg@adacore.com>

	* 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

+2010-06-18  Vincent Celier  <celier@adacore.com>
+
+	* 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  <schonberg@adacore.com>
+
+	* 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  <dewar@adacore.com>
 
 	* sem_res.adb (Analyze_Indexed_Component, Analyze_Selected_Component):

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
 

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');

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;

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;