[multiple changes]

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

	* get_scos.adb: When reading a P statement SCO without a pragma name
	(from an older ALI file), ensure that the Pragma_Name component is set
	to Unknown_Pragma (not left uninitialized).

2011-08-29  Vincent Celier  <celier@adacore.com>

	* makeutl.adb (Get_Directories): New procedure moved from Buildgpr and
	modified to compute correctly the object path of a SAL project that is
	extending another library project.
	(Write_Path_File): New procedure.
	* makeutl.ads (Directories): New table moved from Buildgpr
	(Get_Directories): New procedure moved from Buildgpr
	(Write_Path_File): New procedure
	* mlib-prj.adb (Build_Library): Use Makeutl.Get_Directories to set the
	paths before binding SALs, instead of Set_Ada_Paths.
	* prj-env.adb (Set_Path_File_Var): Procedure has been moved to package
	Prj.
	* prj.adb (Set_Path_File_Var): New procedure moved from Prj.Env
	(Current_Source_Path_File_Of): New function
	(Set_Current_Object_Path_File_Of): New procedure
	(Current_Source_Object_File_Of): New function
	(Set_Current_Object_Path_File_Of): New procedure
	* prj.ads (Set_Path_File_Var): New procedure moved from Prj.Env
	(Current_Source_Path_File_Of): New function
	(Set_Current_Object_Path_File_Of): New procedure
	(Current_Source_Object_File_Of): New function
	(Set_Current_Object_Path_File_Of): New procedure

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

	* exp_ch5.adb (Expand_N_Assignment_Statement): For an assignment to a
	packed entity, use a bit-field assignment only if there is no change of
	representation.

From-SVN: r178177

gcc/ada/ChangeLog

@@ -1,3 +1,39 @@
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+	* get_scos.adb: When reading a P statement SCO without a pragma name
+	(from an older ALI file), ensure that the Pragma_Name component is set
+	to Unknown_Pragma (not left uninitialized).
+
+2011-08-29  Vincent Celier  <celier@adacore.com>
+
+	* makeutl.adb (Get_Directories): New procedure moved from Buildgpr and
+	modified to compute correctly the object path of a SAL project that is
+	extending another library project.
+	(Write_Path_File): New procedure.
+	* makeutl.ads (Directories): New table moved from Buildgpr
+	(Get_Directories): New procedure moved from Buildgpr
+	(Write_Path_File): New procedure
+	* mlib-prj.adb (Build_Library): Use Makeutl.Get_Directories to set the
+	paths before binding SALs, instead of Set_Ada_Paths.
+	* prj-env.adb (Set_Path_File_Var): Procedure has been moved to package
+	Prj.
+	* prj.adb (Set_Path_File_Var): New procedure moved from Prj.Env
+	(Current_Source_Path_File_Of): New function
+	(Set_Current_Object_Path_File_Of): New procedure
+	(Current_Source_Object_File_Of): New function
+	(Set_Current_Object_Path_File_Of): New procedure
+	* prj.ads (Set_Path_File_Var): New procedure moved from Prj.Env
+	(Current_Source_Path_File_Of): New function
+	(Set_Current_Object_Path_File_Of): New procedure
+	(Current_Source_Object_File_Of): New function
+	(Set_Current_Object_Path_File_Of): New procedure
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch5.adb (Expand_N_Assignment_Statement): For an assignment to a
+	packed entity, use a bit-field assignment only if there is no change of
+	representation.
+
 2011-08-29  Thomas Quinot  <quinot@adacore.com>
 
 	* rtsfind.ads, exp_ch3.adb (In_Runtime): Minor code improvement, use

gcc/ada/exp_ch5.adb

@@ -1511,6 +1511,7 @@ package body Exp_Ch5 is
 
    procedure Expand_N_Assignment_Statement (N : Node_Id) is
       Loc  : constant Source_Ptr := Sloc (N);
+      Crep : constant Boolean    := Change_Of_Representation (N);
       Lhs  : constant Node_Id    := Name (N);
       Rhs  : constant Node_Id    := Expression (N);
       Typ  : constant Entity_Id  := Underlying_Type (Etype (Lhs));
@@ -1780,7 +1781,7 @@ package body Exp_Ch5 is
          --  Skip discriminant check if change of representation. Will be
          --  done when the change of representation is expanded out.
 
-         if not Change_Of_Representation (N) then
+         if not Crep then
             Apply_Discriminant_Check (Rhs, Etype (Lhs), Lhs);
          end if;
 
@@ -1830,7 +1831,7 @@ package body Exp_Ch5 is
             --  Skip discriminant check if change of representation. Will be
             --  done when the change of representation is expanded out.
 
-            if not Change_Of_Representation (N) then
+            if not Crep then
                Apply_Discriminant_Check (Rhs, Etype (Lhs));
             end if;
 
@@ -1883,10 +1884,13 @@ package body Exp_Ch5 is
          Apply_Constraint_Check (Rhs, Etype (Lhs));
       end if;
 
-      --  Case of assignment to a bit packed array element
+      --  Case of assignment to a bit packed array element. If there is a
+      --  change of representation this must be expanded into components,
+      --  otherwise this is a bit-field assignment.
 
       if Nkind (Lhs) = N_Indexed_Component
         and then Is_Bit_Packed_Array (Etype (Prefix (Lhs)))
+        and then not Crep
       then
          Expand_Bit_Packed_Element_Set (N);
          return;

gcc/ada/get_scos.adb

@@ -293,22 +293,28 @@ begin
                      Typ := ' ';
                   else
                      Skipc;
-                     if Typ = 'P' and then Nextc not in '1' .. '9' then
+                     if Typ = 'P' then
-                        N := 1;
+                        Pid := Unknown_Pragma;
-                        loop
-                           Buf (N) := Getc;
-                           exit when Nextc = ':';
-                           N := N + 1;
-                        end loop;
 
-                        begin
+                        if Nextc not in '1' .. '9' then
-                           Pid := Pragma_Id'Value (Buf (1 .. N));
+                           N := 1;
-                        exception
+                           loop
-                           when Constraint_Error =>
+                              Buf (N) := Getc;
-                              Pid := Unknown_Pragma;
+                              exit when Nextc = ':';
-                        end;
+                              N := N + 1;
+                           end loop;
+                           Skipc;
 
-                        Skipc;
+                           begin
+                              Pid := Pragma_Id'Value (Buf (1 .. N));
+                           exception
+                              when Constraint_Error =>
+
+                                 --  Pid remains set to Unknown_Pragma
+
+                                 null;
+                           end;
+                        end if;
                      end if;
                   end if;
 

gcc/ada/makeutl.adb

@@ -32,12 +32,11 @@ with Hostparm;
 with Osint;    use Osint;
 with Output;   use Output;
 with Opt;      use Opt;
+with Prj.Com;
 with Prj.Err;
 with Prj.Ext;
 with Prj.Util; use Prj.Util;
 with Sinput.P;
-with Snames;   use Snames;
-with Table;
 with Tempdir;
 
 with Ada.Command_Line;           use Ada.Command_Line;
@@ -681,6 +680,118 @@ package body Makeutl is
       return False;
    end File_Not_A_Source_Of;
 
+   ---------------------
+   -- Get_Directories --
+   ---------------------
+
+   procedure Get_Directories
+     (Project_Tree : Project_Tree_Ref;
+      For_Project  : Project_Id;
+      Activity     : Activity_Type;
+      Languages    : Name_Ids)
+   is
+
+      procedure Recursive_Add
+        (Project  : Project_Id;
+         Tree     : Project_Tree_Ref;
+         Extended : in out Boolean);
+      --  Add all the source directories of a project to the path only if
+      --  this project has not been visited. Calls itself recursively for
+      --  projects being extended, and imported projects.
+
+      procedure Add_Dir (Value : Path_Name_Type);
+      --  Add directory Value in table Directories, if it is defined and not
+      --  already there.
+
+      -------------
+      -- Add_Dir --
+      -------------
+
+      procedure Add_Dir (Value : Path_Name_Type) is
+         Add_It : Boolean := True;
+
+      begin
+         if Value /= No_Path then
+            for Index in 1 .. Directories.Last loop
+               if Directories.Table (Index) = Value then
+                  Add_It := False;
+                  exit;
+               end if;
+            end loop;
+
+            if Add_It then
+               Directories.Increment_Last;
+               Directories.Table (Directories.Last) := Value;
+            end if;
+         end if;
+      end Add_Dir;
+
+      -------------------
+      -- Recursive_Add --
+      -------------------
+
+      procedure Recursive_Add
+        (Project  : Project_Id;
+         Tree     : Project_Tree_Ref;
+         Extended : in out Boolean)
+      is
+         Current   : String_List_Id;
+         Dir       : String_Element;
+         OK        : Boolean := False;
+         Lang_Proc : Language_Ptr := Project.Languages;
+      begin
+         --  Add to path all directories of this project
+
+         if Activity = Compilation then
+            Lang_Loop :
+            while Lang_Proc /= No_Language_Index loop
+               for J in Languages'Range loop
+                  OK := Lang_Proc.Name = Languages (J);
+                  exit Lang_Loop when OK;
+               end loop;
+
+               Lang_Proc := Lang_Proc.Next;
+            end loop Lang_Loop;
+
+            if OK then
+               Current := Project.Source_Dirs;
+
+               while Current /= Nil_String loop
+                  Dir := Tree.Shared.String_Elements.Table (Current);
+                  Add_Dir (Path_Name_Type (Dir.Value));
+                  Current := Dir.Next;
+               end loop;
+            end if;
+
+         elsif Project.Library then
+            if Activity = SAL_Binding and then Extended then
+               Add_Dir (Project.Object_Directory.Display_Name);
+
+            else
+               Add_Dir (Project.Library_ALI_Dir.Display_Name);
+            end if;
+
+         else
+            Add_Dir (Project.Object_Directory.Display_Name);
+         end if;
+
+         if Project.Extends = No_Project then
+            Extended := False;
+         end if;
+      end Recursive_Add;
+
+      procedure For_All_Projects is
+        new For_Every_Project_Imported (Boolean, Recursive_Add);
+
+      Extended : Boolean := True;
+
+      --  Start of processing for Get_Directories
+
+   begin
+      Directories.Init;
+      For_All_Projects (For_Project, Project_Tree, Extended);
+   end Get_Directories;
+
    ------------------
    -- Get_Switches --
    ------------------
@@ -3208,4 +3319,33 @@ package body Makeutl is
       end if;
    end Compute_Builder_Switches;
 
+   ---------------------
+   -- Write_Path_File --
+   ---------------------
+
+   procedure Write_Path_File (FD : File_Descriptor) is
+      Last : Natural;
+      Status : Boolean;
+   begin
+      Name_Len := 0;
+
+      for Index in Directories.First .. Directories.Last loop
+         Add_Str_To_Name_Buffer (Get_Name_String (Directories.Table (Index)));
+         Add_Char_To_Name_Buffer (ASCII.LF);
+      end loop;
+
+      Last := Write (FD, Name_Buffer (1)'Address, Name_Len);
+
+      if Last = Name_Len then
+         Close (FD, Status);
+
+      else
+         Status := False;
+      end if;
+
+      if not Status then
+         Prj.Com.Fail ("could not write temporary file");
+      end if;
+   end Write_Path_File;
+
 end Makeutl;

gcc/ada/makeutl.ads

@@ -33,6 +33,8 @@ with Opt;
 with Osint;
 with Prj;      use Prj;
 with Prj.Tree;
+with Snames;   use Snames;
+with Table;
 with Types;    use Types;
 
 with GNAT.OS_Lib; use GNAT.OS_Lib;
@@ -65,6 +67,16 @@ package Makeutl is
    Create_Map_File_Switch : constant String := "--create-map-file";
    --  Switch to create a map file when an executable is linked
 
+   package Directories is new Table.Table
+     (Table_Component_Type => Path_Name_Type,
+      Table_Index_Type     => Integer,
+      Table_Low_Bound      => 1,
+      Table_Initial        => 200,
+      Table_Increment      => 100,
+      Table_Name           => "Makegpr.Directories");
+   --  Table of all the source or object directories, filled up by
+   --  Get_Directories.
+
    procedure Add
      (Option : String_Access;
       To     : in out String_List_Access;
@@ -159,6 +171,30 @@ package Makeutl is
    --  is printed last. Both N1 and N2 are printed in quotation marks. The two
    --  forms differ only in taking Name_Id or File_name_Type arguments.
 
+   type Name_Ids is array (Positive range <>) of Name_Id;
+   No_Names : constant Name_Ids := (1 .. 0 => No_Name);
+   --  Name_Ids is used for list of language names in procedure Get_Directories
+   --  below.
+   Ada_Only : constant Name_Ids := (1 => Name_Ada);
+   --  Used to invoke Get_Directories in gnatmake
+
+   type Activity_Type is (Compilation, Executable_Binding, SAL_Binding);
+
+   procedure Get_Directories
+     (Project_Tree : Project_Tree_Ref;
+      For_Project  : Project_Id;
+      Activity     : Activity_Type;
+      Languages    : Name_Ids);
+   --  Put in table Directories the source (when Sources is True) or
+   --  object/library (when Sources is False) directories of project
+   --  For_Project and of all the project it imports directly or indirectly.
+   --  The source directories of imported projects are only included if one
+   --  of the declared languages is in the list Languages.
+
+   procedure Write_Path_File (FD : File_Descriptor);
+   --  Write in the specified open path file the directories in table
+   --  Directories, then closed the path file.
+
    procedure Get_Switches
      (Source       : Source_Id;
       Pkg_Name     : Name_Id;

gcc/ada/mlib-prj.adb

@@ -25,6 +25,7 @@
 
 with ALI;      use ALI;
 with Gnatvsn;  use Gnatvsn;
+with Makeutl;  use Makeutl;
 with MLib.Fil; use MLib.Fil;
 with MLib.Tgt; use MLib.Tgt;
 with MLib.Utl; use MLib.Utl;
@@ -802,6 +803,9 @@ package body MLib.Prj is
          end loop;
       end Process_Imported_Libraries;
 
+      Path_FD : File_Descriptor := Invalid_FD;
+      --  Used for setting the source and object paths
+
    --  Start of processing for Build_Library
 
    begin
@@ -1044,10 +1048,56 @@ package body MLib.Prj is
 
             --  Set the paths
 
-            Set_Ada_Paths
+            --  First the source path
-              (Project             => For_Project,
+
-               In_Tree             => In_Tree,
+            if For_Project.Include_Path_File = No_Path then
-               Including_Libraries => True);
+               Get_Directories
+                 (Project_Tree => In_Tree,
+                  For_Project  => For_Project,
+                  Activity     => Compilation,
+                  Languages    => Ada_Only);
+
+               Create_New_Path_File
+                 (In_Tree.Shared, Path_FD, For_Project.Include_Path_File);
+
+               Write_Path_File (Path_FD);
+               Path_FD := Invalid_FD;
+
+            end if;
+
+            if Current_Source_Path_File_Of (In_Tree.Shared) /=
+              For_Project.Include_Path_File
+            then
+               Set_Current_Source_Path_File_Of
+                 (In_Tree.Shared,
+                 For_Project.Include_Path_File);
+               Set_Path_File_Var
+                 (Project_Include_Path_File,
+                  Get_Name_String (For_Project.Include_Path_File));
+            end if;
+
+            --  Then, the object path
+
+            Get_Directories
+              (Project_Tree => In_Tree,
+               For_Project  => For_Project,
+               Activity     => SAL_Binding,
+               Languages    => Ada_Only);
+
+            declare
+               Path_File_Name : Path_Name_Type;
+            begin
+               Create_New_Path_File (In_Tree.Shared, Path_FD, Path_File_Name);
+
+               Write_Path_File (Path_FD);
+               Path_FD := Invalid_FD;
+
+               Set_Path_File_Var
+                 (Project_Objects_Path_File,
+                  Get_Name_String (Path_File_Name));
+               Set_Current_Source_Path_File_Of
+                 (In_Tree.Shared, Path_File_Name);
+            end;
 
             --  Display the gnatbind command, if not in quiet output
 

gcc/ada/prj-env.adb

@@ -102,9 +102,6 @@ package body Prj.Env is
    --  Add Object_Dir to object path table. Make sure it is not duplicate
    --  and it is the last one in the current table.
 
-   procedure Set_Path_File_Var (Name : String; Value : String);
-   --  Call Setenv, after calling To_Host_File_Spec
-
    ----------------------
    -- Ada_Include_Path --
    ----------------------
@@ -1776,22 +1773,6 @@ package body Prj.Env is
       Free (Buffer);
    end Set_Ada_Paths;
 
-   -----------------------
-   -- Set_Path_File_Var --
-   -----------------------
-
-   procedure Set_Path_File_Var (Name : String; Value : String) is
-      Host_Spec : String_Access := To_Host_File_Spec (Value);
-   begin
-      if Host_Spec = null then
-         Prj.Com.Fail
-           ("could not convert file name """ & Value & """ to host spec");
-      else
-         Setenv (Name, Host_Spec.all);
-         Free (Host_Spec);
-      end if;
-   end Set_Path_File_Var;
-
    ---------------------
    -- Add_Directories --
    ---------------------

gcc/ada/prj.adb

@@ -27,6 +27,7 @@ with Debug;
 with Osint;    use Osint;
 with Output;   use Output;
 with Prj.Attr;
+with Prj.Com;
 with Prj.Err;  use Prj.Err;
 with Snames;   use Snames;
 with Uintp;    use Uintp;
@@ -113,6 +114,28 @@ package body Prj is
       Last := Last + S'Length;
    end Add_To_Buffer;
 
+   ---------------------------------
+   -- Current_Object_Path_File_Of --
+   ---------------------------------
+
+   function Current_Object_Path_File_Of
+     (Shared : Shared_Project_Tree_Data_Access)
+      return Path_Name_Type is
+   begin
+      return Shared.Private_Part.Current_Object_Path_File;
+   end Current_Object_Path_File_Of;
+
+   ---------------------------------
+   -- Current_Source_Path_File_Of --
+   ---------------------------------
+
+   function Current_Source_Path_File_Of
+     (Shared : Shared_Project_Tree_Data_Access)
+      return Path_Name_Type is
+   begin
+      return Shared.Private_Part.Current_Source_Path_File;
+   end Current_Source_Path_File_Of;
+
    ---------------------------
    -- Delete_Temporary_File --
    ---------------------------
@@ -1029,6 +1052,46 @@ package body Prj is
       Free_Units (Tree.Units_HT);
    end Reset;
 
+   -------------------------------------
+   -- Set_Current_Object_Path_File_Of --
+   -------------------------------------
+
+   procedure Set_Current_Object_Path_File_Of
+     (Shared : Shared_Project_Tree_Data_Access;
+      To     : Path_Name_Type)
+   is
+   begin
+      Shared.Private_Part.Current_Object_Path_File := To;
+   end Set_Current_Object_Path_File_Of;
+
+   -------------------------------------
+   -- Set_Current_Source_Path_File_Of --
+   -------------------------------------
+
+   procedure Set_Current_Source_Path_File_Of
+     (Shared : Shared_Project_Tree_Data_Access;
+      To     : Path_Name_Type)
+   is
+   begin
+      Shared.Private_Part.Current_Source_Path_File := To;
+   end Set_Current_Source_Path_File_Of;
+
+   -----------------------
+   -- Set_Path_File_Var --
+   -----------------------
+
+   procedure Set_Path_File_Var (Name : String; Value : String) is
+      Host_Spec : String_Access := To_Host_File_Spec (Value);
+   begin
+      if Host_Spec = null then
+         Prj.Com.Fail
+           ("could not convert file name """ & Value & """ to host spec");
+      else
+         Setenv (Name, Host_Spec.all);
+         Free (Host_Spec);
+      end if;
+   end Set_Path_File_Var;
+
    -------------------
    -- Switches_Name --
    -------------------

gcc/ada/prj.ads

@@ -1595,6 +1595,29 @@ package Prj is
      (Source_File_Name : File_Name_Type) return File_Name_Type;
    --  Returns the switches file name corresponding to a source file name
 
+   procedure Set_Path_File_Var (Name : String; Value : String);
+   --  Call Setenv, after calling To_Host_File_Spec
+
+   function Current_Source_Path_File_Of
+     (Shared : Shared_Project_Tree_Data_Access)
+      return Path_Name_Type;
+   --  Get the current include path file name
+
+   procedure Set_Current_Source_Path_File_Of
+     (Shared : Shared_Project_Tree_Data_Access;
+      To     : Path_Name_Type);
+   --  Record the current include path file name
+
+   function Current_Object_Path_File_Of
+     (Shared : Shared_Project_Tree_Data_Access)
+      return Path_Name_Type;
+   --  Get the current object path file name
+
+   procedure Set_Current_Object_Path_File_Of
+     (Shared : Shared_Project_Tree_Data_Access;
+      To     : Path_Name_Type);
+   --  Record the current object path file name
+
    -----------
    -- Flags --
    -----------
@@ -1676,7 +1699,7 @@ package Prj is
    --  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:
+   --  project path in such a case:Shared_
    --       * 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