[multiple changes]

2011-08-04  Yannick Moy  <moy@adacore.com>

	* sem_attr.adb (Result): modify error message for misplaced 'Result

2011-08-04  Sergey Rybin  <rybin@adacore.com>

	* gnat_rm.texi (pragma Annotate): Fix syntax description to make it
	clear that the second argument must be an identifier.

2011-08-04  Thomas Quinot  <quinot@adacore.com>

	* exp_ch9.adb (Build_Barrier_Function): When compiling with
	-fpreserve-control-flow, insert an IF statement on the barrier
	condition to ensure that a conditional branch instruction is generated.

2011-08-04  Emmanuel Briot  <briot@adacore.com>

	* prj-part.adb, prj.adb, prj.ads, prj-tree.ads
	(Processing_Flags.Ignore_Missing_With): new flag.

2011-08-04  Emmanuel Briot  <briot@adacore.com>

	* prj-nmsc.adb (Find_Sources, Path_Name_Of): Fix handling of
	Source_List_File on case-insensitive systems where the file is actually
	on a case-sensitive file system (NFS,...).

2011-08-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch6.adb (Analyze_Function_Return): In a rare case where a
	function return contains a controlled [extension] aggregate and the
	return statement is not part of a handled sequence of statements, wrap
	the return in a block. This ensures that all controlled temporaries
	generated during aggregate resolution will be picked up by the
	finalization machinery.

2011-08-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_aggr.adb (Resolve_Aggregate): If aggregate has box-initialized
	components, freeze type before resolution, to ensure that default
	initializations are present for all components.
	* sem_res.adb (Resolve_Actuals): the designated object of an
	accces-to-constant type is a legal actual in a call to an
	initialization procedure.

2011-08-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_util.adb (Extract_Renamed_Object): Add N_Type_Conversion and
	N_Unchecked_Type_Conversion to the possible containers of a renamed
	transient variable.

From-SVN: r177343

13 files changed, 200 insertions, 42 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3aa9c77..9e5ec15 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,55 @@
 2011-08-04  Yannick Moy  <moy@adacore.com>
 
+	* sem_attr.adb (Result): modify error message for misplaced 'Result
+
+2011-08-04  Sergey Rybin  <rybin@adacore.com>
+
+	* gnat_rm.texi (pragma Annotate): Fix syntax description to make it
+	clear that the second argument must be an identifier.
+
+2011-08-04  Thomas Quinot  <quinot@adacore.com>
+
+	* exp_ch9.adb (Build_Barrier_Function): When compiling with
+	-fpreserve-control-flow, insert an IF statement on the barrier
+	condition to ensure that a conditional branch instruction is generated.
+
+2011-08-04  Emmanuel Briot  <briot@adacore.com>
+
+	* prj-part.adb, prj.adb, prj.ads, prj-tree.ads
+	(Processing_Flags.Ignore_Missing_With): new flag.
+
+2011-08-04  Emmanuel Briot  <briot@adacore.com>
+
+	* prj-nmsc.adb (Find_Sources, Path_Name_Of): Fix handling of
+	Source_List_File on case-insensitive systems where the file is actually
+	on a case-sensitive file system (NFS,...).
+
+2011-08-04  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_ch6.adb (Analyze_Function_Return): In a rare case where a
+	function return contains a controlled [extension] aggregate and the
+	return statement is not part of a handled sequence of statements, wrap
+	the return in a block. This ensures that all controlled temporaries
+	generated during aggregate resolution will be picked up by the
+	finalization machinery.
+
+2011-08-04  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_aggr.adb (Resolve_Aggregate): If aggregate has box-initialized
+	components, freeze type before resolution, to ensure that default
+	initializations are present for all components.
+	* sem_res.adb (Resolve_Actuals): the designated object of an
+	accces-to-constant type is a legal actual in a call to an
+	initialization procedure.
+
+2011-08-04  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_util.adb (Extract_Renamed_Object): Add N_Type_Conversion and
+	N_Unchecked_Type_Conversion to the possible containers of a renamed
+	transient variable.
+
+2011-08-04  Yannick Moy  <moy@adacore.com>
+
 	* par-ch13.adb (Aspect_Specifications_Present): recognize
 	"with Identifier'Class =>" as an aspect, so that a meaningful warning
 	is issued in Strict mode.
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index d12c92c..13396c9 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -921,10 +921,12 @@ package body Exp_Ch9 is
       Ent : Entity_Id;
       Pid : Node_Id) return Node_Id
    is
-      Loc         : constant Source_Ptr := Sloc (N);
-      Func_Id     : constant Entity_Id  := Barrier_Function (Ent);
       Ent_Formals : constant Node_Id    := Entry_Body_Formal_Part (N);
+      Cond        : constant Node_Id    := Condition (Ent_Formals);
+      Loc         : constant Source_Ptr := Sloc (Cond);
+      Func_Id     : constant Entity_Id  := Barrier_Function (Ent);
       Op_Decls    : constant List_Id    := New_List;
+      Stmt        : Node_Id;
       Func_Body   : Node_Id;
 
    begin
@@ -932,8 +934,33 @@ package body Exp_Ch9 is
       --  for the discriminals and privals and finally a declaration for the
       --  entry family index (if applicable).
 
-      Install_Private_Data_Declarations
-        (Loc, Func_Id, Pid, N, Op_Decls, True, Ekind (Ent) = E_Entry_Family);
+      Install_Private_Data_Declarations (Sloc (N),
+         Spec_Id  => Func_Id,
+         Conc_Typ => Pid,
+         Body_Nod => N,
+         Decls    => Op_Decls,
+         Barrier  => True,
+         Family   => Ekind (Ent) = E_Entry_Family);
+
+      --  If compiling with -fpreserve-control-flow, make sure we insert an
+      --  IF statement so that the back-end knows to generate a conditional
+      --  branch instruction, even if the condition is just the name of a
+      --  boolean object.
+
+      if Opt.Suppress_Control_Flow_Optimizations then
+         Stmt := Make_Implicit_If_Statement (Cond,
+                   Condition       =>
+                     Cond,
+                   Then_Statements => New_List (
+                     Make_Simple_Return_Statement (Loc,
+                       New_Occurrence_Of (Standard_True, Loc))),
+                   Else_Statements => New_List (
+                     Make_Simple_Return_Statement (Loc,
+                       New_Occurrence_Of (Standard_False, Loc))));
+
+      else
+         Stmt := Make_Simple_Return_Statement (Loc, Cond);
+      end if;
 
       --  Note: the condition in the barrier function needs to be properly
       --  processed for the C/Fortran boolean possibility, but this happens
@@ -947,9 +974,7 @@ package body Exp_Ch9 is
           Declarations => Op_Decls,
           Handled_Statement_Sequence =>
             Make_Handled_Sequence_Of_Statements (Loc,
-              Statements => New_List (
-                Make_Simple_Return_Statement (Loc,
-                  Expression => Condition (Ent_Formals)))));
+              Statements => New_List (Stmt)));
       Set_Is_Entry_Barrier_Function (Func_Body);
 
       return Func_Body;
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 5cade6c..c8411f9 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -3888,7 +3888,13 @@ package body Exp_Util is
                                      N_Selected_Component)
                then
                   Ren_Obj := Prefix (Ren_Obj);
-                  Change := True;
+                  Change  := True;
+
+               elsif Nkind_In (Ren_Obj, N_Type_Conversion,
+                                        N_Unchecked_Type_Conversion)
+               then
+                  Ren_Obj := Expression (Ren_Obj);
+                  Change  := True;
                end if;
             end loop;
 
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 670c23c..9d3730d 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -984,7 +984,7 @@ same syntax and effect.
 @noindent
 Syntax:
 @smallexample @c ada
-pragma Annotate (IDENTIFIER [,IDENTIFIER] @{, ARG@});
+pragma Annotate (IDENTIFIER [,IDENTIFIER @{, ARG@}]);
 
 ARG ::= NAME | EXPRESSION
 @end smallexample
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index a2058e2..70d0b2b 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -6262,7 +6262,7 @@ package body Prj.Nmsc is
             Source_File_Path_Name : constant String :=
               Path_Name_Of
                 (File_Name_Type (Source_List_File.Value),
-                 Project.Project.Directory.Name);
+                 Project.Project.Directory.Display_Name);
 
          begin
             Has_Explicit_Sources := True;
@@ -7819,6 +7819,9 @@ package body Prj.Nmsc is
       The_Directory : constant String := Get_Name_String (Directory);
 
    begin
+      Debug_Output ("Path_Name_Of file_name=", Name_Id (File_Name));
+      Debug_Output ("Path_Name_Of directory=",
+                    Name_Id (Directory));
       Get_Name_String (File_Name);
       Result :=
         Locate_Regular_File
@@ -7829,10 +7832,9 @@ package body Prj.Nmsc is
          return "";
       else
          declare
-            R : String := Result.all;
+            R : constant String := Result.all;
          begin
             Free (Result);
-            Canonical_Case_File_Name (R);
             return R;
          end;
       end if;
diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb
index dbb5473..8985e97 100644
--- a/gcc/ada/prj-part.adb
+++ b/gcc/ada/prj-part.adb
@@ -460,6 +460,8 @@ package body Prj.Part is
       Path_Name_Id : Path_Name_Type;
 
    begin
+      In_Tree.Incomplete_With := False;
+
       if not Is_Initialized (Env.Project_Path) then
          Prj.Env.Initialize_Default_Project_Path
            (Env.Project_Path, Target_Name);
@@ -794,24 +796,29 @@ package body Prj.Part is
                Path              => Imported_Path_Name_Id);
 
             if Imported_Path_Name_Id = No_Path then
+               if Env.Flags.Ignore_Missing_With then
+                  In_Tree.Incomplete_With := True;
 
-               --  The project file cannot be found
+               else
+                  --  The project file cannot be found
 
-               Error_Msg_File_1 := File_Name_Type (Current_With.Path);
-               Error_Msg
-                 (Env.Flags, "unknown project file: {", Current_With.Location);
+                  Error_Msg_File_1 := File_Name_Type (Current_With.Path);
+                  Error_Msg
+                    (Env.Flags, "unknown project file: {",
+                     Current_With.Location);
 
-               --  If this is not imported by the main project file, display
-               --  the import path.
+                  --  If this is not imported by the main project file, display
+                  --  the import path.
 
-               if Project_Stack.Last > 1 then
-                  for Index in reverse 1 .. Project_Stack.Last loop
-                     Error_Msg_File_1 :=
-                       File_Name_Type
-                         (Project_Stack.Table (Index).Path_Name);
-                     Error_Msg
-                       (Env.Flags, "\imported by {", Current_With.Location);
-                  end loop;
+                  if Project_Stack.Last > 1 then
+                     for Index in reverse 1 .. Project_Stack.Last loop
+                        Error_Msg_File_1 :=
+                          File_Name_Type
+                            (Project_Stack.Table (Index).Path_Name);
+                        Error_Msg
+                          (Env.Flags, "\imported by {", Current_With.Location);
+                     end loop;
+                  end if;
                end if;
 
             else
diff --git a/gcc/ada/prj-tree.ads b/gcc/ada/prj-tree.ads
index fede1f9..a164099 100644
--- a/gcc/ada/prj-tree.ads
+++ b/gcc/ada/prj-tree.ads
@@ -1505,6 +1505,11 @@ package Prj.Tree is
    type Project_Node_Tree_Data is record
       Project_Nodes : Tree_Private_Part.Project_Node_Table.Instance;
       Projects_HT   : Tree_Private_Part.Projects_Htable.Instance;
+
+      Incomplete_With : Boolean := False;
+      --  Set to True if the projects were loaded with the flag
+      --  Ignore_Missing_With set to True, and there were indeed some with
+      --  statements that could not be resolved
    end record;
 
    procedure Free (Proj : in out Project_Node_Tree_Ref);
diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb
index 62a3fa9..670a0a07 100644
--- a/gcc/ada/prj.adb
+++ b/gcc/ada/prj.adb
@@ -1377,7 +1377,8 @@ package body Prj is
       Error_On_Unknown_Language  : Boolean       := True;
       Require_Obj_Dirs           : Error_Warning := Error;
       Allow_Invalid_External     : Error_Warning := Error;
-      Missing_Source_Files       : Error_Warning := Error)
+      Missing_Source_Files       : Error_Warning := Error;
+      Ignore_Missing_With        : Boolean       := False)
       return Processing_Flags
    is
    begin
@@ -1390,7 +1391,8 @@ package body Prj is
          Compiler_Driver_Mandatory  => Compiler_Driver_Mandatory,
          Require_Obj_Dirs           => Require_Obj_Dirs,
          Allow_Invalid_External     => Allow_Invalid_External,
-         Missing_Source_Files       => Missing_Source_Files);
+         Missing_Source_Files       => Missing_Source_Files,
+         Ignore_Missing_With        => Ignore_Missing_With);
    end Create_Flags;
 
    ------------
diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads
index e300dd9..5942abc 100644
--- a/gcc/ada/prj.ads
+++ b/gcc/ada/prj.ads
@@ -1630,7 +1630,8 @@ package Prj is
       Error_On_Unknown_Language  : Boolean       := True;
       Require_Obj_Dirs           : Error_Warning := Error;
       Allow_Invalid_External     : Error_Warning := Error;
-      Missing_Source_Files       : Error_Warning := Error)
+      Missing_Source_Files       : Error_Warning := Error;
+      Ignore_Missing_With        : Boolean       := False)
       return Processing_Flags;
    --  Function used to create Processing_Flags structure
    --
@@ -1668,6 +1669,16 @@ package Prj is
    --  a source file mentioned in the Source_Files attributes is not actually
    --  found in the source directories. This also impacts errors for missing
    --  source directories.
+   --
+   --  If Ignore_Missing_With is True, then a "with" statement that cannot be
+   --  resolved will simply be ignored. However, in such a case, the flag
+   --  Incomplete_With in the project tree will be set to True.
+   --  This is meant for use by tools so that they can properly set the
+   --  project path in such a case:
+   --       * no "gnatls" found (so no default project path)
+   --       * user project sets Project.IDE'gnatls attribute to a cross gnatls
+   --       * user project also includes a "with" that can only be resolved
+   --         once we have found the gnatls
 
    Gprbuild_Flags : constant Processing_Flags;
    Gprclean_Flags : constant Processing_Flags;
@@ -1813,6 +1824,7 @@ private
       Require_Obj_Dirs           : Error_Warning;
       Allow_Invalid_External     : Error_Warning;
       Missing_Source_Files       : Error_Warning;
+      Ignore_Missing_With        : Boolean;
    end record;
 
    Gprbuild_Flags : constant Processing_Flags :=
@@ -1824,7 +1836,8 @@ private
       Error_On_Unknown_Language  => True,
       Require_Obj_Dirs           => Error,
       Allow_Invalid_External     => Error,
-      Missing_Source_Files       => Error);
+      Missing_Source_Files       => Error,
+      Ignore_Missing_With        => False);
 
    Gprclean_Flags : constant Processing_Flags :=
      (Report_Error               => null,
@@ -1835,7 +1848,8 @@ private
       Error_On_Unknown_Language  => True,
       Require_Obj_Dirs           => Warning,
       Allow_Invalid_External     => Error,
-      Missing_Source_Files       => Error);
+      Missing_Source_Files       => Error,
+      Ignore_Missing_With        => False);
 
    Gnatmake_Flags : constant Processing_Flags :=
      (Report_Error               => null,
@@ -1846,6 +1860,7 @@ private
       Error_On_Unknown_Language  => False,
       Require_Obj_Dirs           => Error,
       Allow_Invalid_External     => Error,
-      Missing_Source_Files       => Error);
+      Missing_Source_Files       => Error,
+      Ignore_Missing_With        => False);
 
 end Prj;
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 050930b..948410d 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -978,6 +978,30 @@ package body Sem_Aggr is
          return;
       end if;
 
+      --  If the aggregate has box-initialized components, its type must be
+      --  frozen so that initialization procedures can properly be called
+      --  in the resolution that follows.  The replacement of boxes with
+      --  initialization calls is properly an expansion activity but it must
+      --  be done during revolution.
+
+      if Expander_Active
+        and then  Present (Component_Associations (N))
+      then
+         declare
+            Comp : Node_Id;
+
+         begin
+            Comp := First (Component_Associations (N));
+            while Present (Comp) loop
+               if Box_Present (Comp) then
+                  Insert_Actions (N, Freeze_Entity (Typ, N));
+                  exit;
+               end if;
+               Next (Comp);
+            end loop;
+         end;
+      end if;
+
       --  An unqualified aggregate is restricted in SPARK to:
 
       --    An aggregate item inside an aggregate for a multi-dimensional array
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index d1f927a..70c745d 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -4102,15 +4102,9 @@ package body Sem_Attr is
                Analyze_And_Resolve (N, Etype (PS));
 
             else
-               if Ada_Version >= Ada_2012 then
-                  Error_Attr
-                    ("% attribute can only appear" &
-                      " in function Postcondition pragma or Post aspect", P);
-               else
-                  Error_Attr
-                    ("% attribute can only appear" &
-                      " in function Postcondition pragma", P);
-               end if;
+               Error_Attr
+                 ("% attribute can only appear in postcondition of function",
+                  P);
             end if;
          end if;
       end Result;
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 847f920..054c7a8 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -638,6 +638,28 @@ package body Sem_Ch6 is
             return;
 
          else
+            --  The resolution of a controlled [extension] aggregate associated
+            --  with a return statement creates a temporary which needs to be
+            --  finalized on function exit. Wrap the return statement inside a
+            --  block so that the finalization machinery can detect this case.
+            --  This early expansion is done only when the return statement is
+            --  not part of a handled sequence of statements.
+
+            if Nkind_In (Expr, N_Aggregate,
+                               N_Extension_Aggregate)
+              and then Needs_Finalization (R_Type)
+              and then Nkind (Parent (N)) /= N_Handled_Sequence_Of_Statements
+            then
+               Rewrite (N,
+                 Make_Block_Statement (Loc,
+                   Handled_Statement_Sequence =>
+                     Make_Handled_Sequence_Of_Statements (Loc,
+                       Statements => New_List (Relocate_Node (N)))));
+
+               Analyze (N);
+               return;
+            end if;
+
             Analyze_And_Resolve (Expr, R_Type);
             Check_Limited_Return (Expr);
          end if;
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 294322d..56f1457 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -3736,7 +3736,13 @@ package body Sem_Res is
                --  Is_OK_Variable_For_Out_Formal generates the required
                --  reference in this case.
 
-               if not Is_OK_Variable_For_Out_Formal (A) then
+               --  A call to an initialization procedure for an aggregate
+               --  component may initialize a nested component of a constant
+               --  designated object. In this context the object is variable.
+
+               if not Is_OK_Variable_For_Out_Formal (A)
+                 and then not Is_Init_Proc (Nam)
+               then
                   Error_Msg_NE ("actual for& must be a variable", A, F);
                end if;