[multiple changes]

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

	* alfa.ads Update format of ALFA section in ALI file in order to add a
	mapping from bodies to specs when both are present
	(ALFA_Scope_Record): add components for spec file/scope
	* get_alfa.adb (Get_ALFA): read the new file/scope for spec when present
	* lib-xref-alfa.adb
	(Collect_ALFA): after all scopes have been collected, fill in the spec
	 information when relevant
	* put_alfa.adb (Put_ALFA): write the new file/scope for spec when
	present.

2011-08-03  Eric Botcazou  <ebotcazou@adacore.com>

	* inline.adb (Add_Inlined_Subprogram): Do not consider the enclosing
	code unit to decide whether to add internally generated subprograms.
	
2011-08-03  Javier Miranda  <miranda@adacore.com>

	* sem_aux.ads, sem_aux.adb (Is_VM_By_Copy_Actual): New subprogram.
	* exp_ch9.adb
	(Build_Simple_Entry_Call): Handle actuals that must be handled by copy
	in VM targets.

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

	* make.adb, makeutl.adb, makeutl.ads (Make.Switches_Of): now shares
	code with Makeutl.Get_Switches.
	* prj-tree.adb: Update comment.

From-SVN: r177257

8 files changed, 193 insertions, 43 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3090c3e..7ce74cf 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+2011-08-03  Emmanuel Briot  <briot@adacore.com>
+
+	* prj-proc.adb, prj-ext.adb, prj-ext.ads, prj-env.adb, prj-env.ads,
+	prj-tree.adb, prj-tree.ads (Initialize_And_Copy, Copy): new subprograms
+	(Process_Declarative_Items): new parameter Child_Env.
+
 2011-08-03  Yannick Moy  <moy@adacore.com>
 
 	* alfa.ads Update format of ALFA section in ALI file in order to add a
diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb
index 6285222..050660e 100644
--- a/gcc/ada/prj-env.adb
+++ b/gcc/ada/prj-env.adb
@@ -2197,4 +2197,18 @@ package body Prj.Env is
       Projects_Paths.Reset (Self.Cache);
    end Free;
 
+   ----------
+   -- Copy --
+   ----------
+
+   procedure Copy (From : Project_Search_Path; To : out Project_Search_Path) is
+   begin
+      Free (To);
+      if From.Path /= null then
+         To.Path := new String'(From.Path.all);
+      end if;
+
+      --  No need to copy the Cache, it will be recomputed as needed.
+   end Copy;
+
 end Prj.Env;
diff --git a/gcc/ada/prj-env.ads b/gcc/ada/prj-env.ads
index 61c0431..75f014a 100644
--- a/gcc/ada/prj-env.ads
+++ b/gcc/ada/prj-env.ads
@@ -162,6 +162,8 @@ package Prj.Env is
    --  to search for projects on the path (and caches the results to improve
    --  efficiency).
 
+   No_Project_Search_Path : constant Project_Search_Path;
+
    procedure Initialize_Default_Project_Path
      (Self        : in out Project_Search_Path;
       Target_Name : String);
@@ -170,6 +172,9 @@ package Prj.Env is
    --  variables ADA_PROJECT_PATH and GPR_PROJECT_PATH). This does nothing if
    --  Self has already been initialized.
 
+   procedure Copy (From : Project_Search_Path; To : out Project_Search_Path);
+   --  Copy From into To
+
    procedure Initialize_Empty (Self : in out Project_Search_Path);
    --  Initialize self with an empty list of directories. If Self had already
    --  been set, it is reset.
@@ -234,4 +239,9 @@ private
 
       Cache : Projects_Paths.Instance;
    end record;
+
+   No_Project_Search_Path : constant Project_Search_Path :=
+     (Path  => null,
+      Cache => Projects_Paths.Nil);
+
 end Prj.Env;
diff --git a/gcc/ada/prj-ext.adb b/gcc/ada/prj-ext.adb
index b9885c3..a235bde 100644
--- a/gcc/ada/prj-ext.adb
+++ b/gcc/ada/prj-ext.adb
@@ -46,9 +46,11 @@ package body Prj.Ext is
          if Copy_From.Refs /= null then
             N := Name_To_Name_HTable.Get_First (Copy_From.Refs.all);
             while N /= null loop
-               N2 := new Name_To_Name;
-               N2.Key := N.Key;
-               N2.Value := N.Value;
+               N2 := new Name_To_Name'
+                 (Key    => N.Key,
+                  Value  => N.Value,
+                  Source => N.Source,
+                  Next   => null);
                Name_To_Name_HTable.Set (Self.Refs.all, N2);
                N := Name_To_Name_HTable.Get_Next (Copy_From.Refs.all);
             end loop;
@@ -63,24 +65,47 @@ package body Prj.Ext is
    procedure Add
      (Self          : External_References;
       External_Name : String;
-      Value         : String)
+      Value         : String;
+      Source        : External_Source := External_Source'First)
    is
-      N : Name_To_Name_Ptr;
+      Key : Name_Id;
+      N   : Name_To_Name_Ptr;
 
    begin
-      N := new Name_To_Name;
-
-      Name_Len := Value'Length;
-      Name_Buffer (1 .. Name_Len) := Value;
-      N.Value := Name_Find;
-
       Name_Len := External_Name'Length;
       Name_Buffer (1 .. Name_Len) := External_Name;
       Canonical_Case_Env_Var_Name (Name_Buffer (1 .. Name_Len));
-      N.Key := Name_Find;
+      Key := Name_Find;
+
+      --  Check whether the value is already defined, to properly respect the
+      --  overriding order.
+
+      if Source /= External_Source'First then
+         N := Name_To_Name_HTable.Get (Self.Refs.all, Key);
+         if N /= null then
+            if External_Source'Pos (N.Source) <
+              External_Source'Pos (Source)
+            then
+               if Current_Verbosity = High then
+                  Debug_Output
+                    ("Not overridding existing variable '" & External_Name
+                     & "', value was defined in " & N.Source'Img);
+               end if;
+               return;
+            end if;
+         end if;
+      end if;
+
+      Name_Len := Value'Length;
+      Name_Buffer (1 .. Name_Len) := Value;
+      N := new Name_To_Name'
+        (Key    => Key,
+         Source => Source,
+         Value  => Name_Find,
+         Next   => null);
 
       if Current_Verbosity = High then
-         Debug_Output ("Add (" & External_Name & ") is", N.Value);
+         Debug_Output ("Add external (" & External_Name & ") is", N.Value);
       end if;
 
       Name_To_Name_HTable.Set (Self.Refs.all, N);
@@ -103,7 +128,8 @@ package body Prj.Ext is
                External_Name =>
                  Declaration (Declaration'First .. Equal_Pos - 1),
                Value         =>
-                 Declaration (Equal_Pos + 1 .. Declaration'Last));
+                 Declaration (Equal_Pos + 1 .. Declaration'Last),
+               Source        => From_Command_Line);
             return True;
          end if;
       end loop;
@@ -146,6 +172,7 @@ package body Prj.Ext is
          Value := Name_To_Name_HTable.Get (Self.Refs.all, Name_Find);
 
          if Value /= null then
+            Debug_Output ("Value_Of (" & Name & ") is in cache", Value.Value);
             return Value.Value;
          end if;
       end if;
@@ -162,14 +189,15 @@ package body Prj.Ext is
             Val := Name_Find;
 
             if Current_Verbosity = High then
-               Debug_Output ("Value_Of (" & Get_Name_String (External_Name)
-                             & ") is", Val);
+               Debug_Output ("Value_Of (" & Name & ") is", Val);
             end if;
 
             if Self.Refs /= null then
-               Value := new Name_To_Name;
-               Value.Key := External_Name;
-               Value.Value := Val;
+               Value := new Name_To_Name'
+                 (Key    => External_Name,
+                  Value  => Val,
+                  Source => From_Environment,
+                  Next   => null);
                Name_To_Name_HTable.Set (Self.Refs.all, Value);
             end if;
 
@@ -178,8 +206,8 @@ package body Prj.Ext is
 
          else
             if Current_Verbosity = High then
-               Debug_Output ("Value_Of (" & Get_Name_String (External_Name)
-                             & ") is default", With_Default);
+               Debug_Output
+                 ("Value_Of (" & Name & ") is default", With_Default);
             end if;
 
             Free (Env_Value);
diff --git a/gcc/ada/prj-ext.ads b/gcc/ada/prj-ext.ads
index 4ea4608..75b0ed2 100644
--- a/gcc/ada/prj-ext.ads
+++ b/gcc/ada/prj-ext.ads
@@ -54,11 +54,25 @@ package Prj.Ext is
    procedure Free (Self : in out External_References);
    --  Free memory used by Self
 
+   type External_Source is
+     (From_Command_Line,
+      From_Environment,
+      From_External_Attribute);
+   --  Where was the value of an external reference defined ?
+   --  They are prioritized in that order, so that a user can always use the
+   --  command line to override a value coming from his environment, or an
+   --  environment variable to override a value defined in an aggregate project
+   --  through the "for External()..." attribute.
+
    procedure Add
      (Self          : External_References;
       External_Name : String;
-      Value         : String);
-   --  Add an external reference (or modify an existing one)
+      Value         : String;
+      Source        : External_Source := External_Source'First);
+   --  Add an external reference (or modify an existing one).
+   --  No overriding is done if the Source's priority is less than the one
+   --  used to previously set the value of the variable. The default for Source
+   --  is such that overriding always occurs.
 
    function Value_Of
      (Self          : External_References;
@@ -88,9 +102,10 @@ private
    type Name_To_Name;
    type Name_To_Name_Ptr is access all Name_To_Name;
    type Name_To_Name is record
-      Key   : Name_Id;
-      Value : Name_Id;
-      Next  : Name_To_Name_Ptr;
+      Key    : Name_Id;
+      Value  : Name_Id;
+      Source : External_Source;
+      Next   : Name_To_Name_Ptr;
    end record;
 
    procedure Set_Next (E : Name_To_Name_Ptr; Next : Name_To_Name_Ptr);
diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb
index f83a05f..4e3ba1b 100644
--- a/gcc/ada/prj-proc.adb
+++ b/gcc/ada/prj-proc.adb
@@ -131,10 +131,17 @@ package body Prj.Proc is
       Node_Tree         : Project_Node_Tree_Ref;
       Env               : Prj.Tree.Environment;
       Pkg               : Package_Id;
-      Item              : Project_Node_Id);
+      Item              : Project_Node_Id;
+      Child_Env         : in out Prj.Tree.Environment;
+      Can_Modify_Child_Env : Boolean);
    --  Process declarative items starting with From_Project_Node, and put them
    --  in declarations Decl. This is a recursive procedure; it calls itself for
    --  a package declaration or a case construction.
+   --  Child_Env is the modified environment after seeing declarations like
+   --  "for External(...) use" or "for Project_Path use" in aggregate projects.
+   --  It should have been initialized first. This environment can only be
+   --  modified if Can_Modify_Child_Env is True, otherwise all the above
+   --  attributes simply have no effect.
 
    procedure Recursive_Process
      (In_Tree                : Project_Tree_Ref;
@@ -142,13 +149,22 @@ package body Prj.Proc is
       From_Project_Node      : Project_Node_Id;
       From_Project_Node_Tree : Project_Node_Tree_Ref;
       Env                    : in out Prj.Tree.Environment;
-      Extended_By            : Project_Id);
+      Extended_By            : Project_Id;
+      Child_Env              : in out Prj.Tree.Environment;
+      Is_Root_Project        : Boolean);
    --  Process project with node From_Project_Node in the tree. Do nothing if
    --  From_Project_Node is Empty_Node. If project has already been processed,
    --  simply return its project id. Otherwise create a new project id, mark it
    --  as processed, call itself recursively for all imported projects and a
    --  extended project, if any. Then process the declarative items of the
    --  project.
+   --  Child_Env is the environment created from an aggregate project (new
+   --  external values or project path), and should be initialized before the
+   --  call.
+   --  Is_Root_Project should be true only for the project that the user
+   --  explicitly loaded. In the context of aggregate projects, only that
+   --  project is allowed to modify the environment that will be used to load
+   --  projects (Child_Env).
 
    function Get_Attribute_Index
      (Tree  : Project_Node_Tree_Ref;
@@ -1392,7 +1408,9 @@ package body Prj.Proc is
       Node_Tree              : Project_Node_Tree_Ref;
       Env                    : Prj.Tree.Environment;
       Pkg                    : Package_Id;
-      Item                   : Project_Node_Id)
+      Item                   : Project_Node_Id;
+      Child_Env              : in out Prj.Tree.Environment;
+      Can_Modify_Child_Env   : Boolean)
    is
       procedure Check_Or_Set_Typed_Variable
         (Value       : in out Variable_Value;
@@ -1597,7 +1615,9 @@ package body Prj.Proc is
                   Env                    => Env,
                   Pkg                    => New_Pkg,
                   Item                   =>
-                    First_Declarative_Item_Of (Current_Item, Node_Tree));
+                    First_Declarative_Item_Of (Current_Item, Node_Tree),
+                  Child_Env              => Child_Env,
+                  Can_Modify_Child_Env   => Can_Modify_Child_Env);
             end;
          end if;
       end Process_Package_Declaration;
@@ -1949,9 +1969,26 @@ package body Prj.Proc is
          end if;
 
          if Name = Snames.Name_External then
+            if Can_Modify_Child_Env then
+               Add (Child_Env.External,
+                    External_Name => Get_Name_String (Index_Name),
+                    Value         => Get_Name_String (New_Value.Value),
+                    Source        => From_External_Attribute);
+               Add (Env.External,
+                    External_Name => Get_Name_String (Index_Name),
+                    Value         => Get_Name_String (New_Value.Value),
+                    Source        => From_External_Attribute);
+            else
+               if Current_Verbosity = High then
+                  Debug_Output
+                    ("'for External' has no effect except in root aggregate ("
+                     & Get_Name_String (Index_Name) & ")", New_Value.Value);
+               end if;
+            end if;
+
+         elsif Name = Snames.Name_Project_Path then
             Debug_Output
-              ("Defined external value ("
-               & Get_Name_String (Index_Name) & ")", New_Value.Value);
+              ("Defined project path");
          end if;
       end Process_Expression_For_Associative_Array;
 
@@ -2236,7 +2273,9 @@ package body Prj.Proc is
                Node_Tree              => Node_Tree,
                Env                    => Env,
                Pkg                    => Pkg,
-               Item                   => Decl_Item);
+               Item                   => Decl_Item,
+               Child_Env              => Child_Env,
+               Can_Modify_Child_Env   => Can_Modify_Child_Env);
          end if;
       end Process_Case_Construction;
 
@@ -2291,6 +2330,7 @@ package body Prj.Proc is
       Env                    : in out Prj.Tree.Environment;
       Reset_Tree             : Boolean := True)
    is
+      Child_Env : Prj.Tree.Environment;
    begin
       if Reset_Tree then
 
@@ -2306,13 +2346,19 @@ package body Prj.Proc is
 
       Debug_Increase_Indent ("Process tree, phase 1");
 
+      Initialize_And_Copy (Child_Env, Copy_From => Env);
+
       Recursive_Process
         (Project                => Project,
          In_Tree                => In_Tree,
          From_Project_Node      => From_Project_Node,
          From_Project_Node_Tree => From_Project_Node_Tree,
          Env                    => Env,
-         Extended_By            => No_Project);
+         Extended_By            => No_Project,
+         Child_Env              => Child_Env,
+         Is_Root_Project        => True);
+
+      Free (Child_Env);
 
       Success :=
         Total_Errors_Detected = 0
@@ -2448,7 +2494,9 @@ package body Prj.Proc is
       From_Project_Node      : Project_Node_Id;
       From_Project_Node_Tree : Project_Node_Tree_Ref;
       Env                    : in out Prj.Tree.Environment;
-      Extended_By            : Project_Id)
+      Extended_By            : Project_Id;
+      Child_Env              : in out Prj.Tree.Environment;
+      Is_Root_Project        : Boolean)
    is
       procedure Process_Imported_Projects
         (Imported     : in out Project_List;
@@ -2501,7 +2549,9 @@ package body Prj.Proc is
                       (With_Clause, From_Project_Node_Tree),
                   From_Project_Node_Tree => From_Project_Node_Tree,
                   Env                    => Env,
-                  Extended_By            => No_Project);
+                  Extended_By            => No_Project,
+                  Child_Env              => Child_Env,
+                  Is_Root_Project        => False);
 
                --  Imported is the id of the last imported project. If
                --  it is nil, then this imported project is our first.
@@ -2555,7 +2605,7 @@ package body Prj.Proc is
                Errout_Handling   => Prj.Part.Never_Finalize,
                Current_Directory => Get_Name_String (Project.Directory.Name),
                Is_Config_File    => False,
-               Env               => Env);
+               Env               => Child_Env);
 
             Success := not Prj.Tree.No (Loaded_Tree);
 
@@ -2565,8 +2615,10 @@ package body Prj.Proc is
                   Project                => List.Project,
                   From_Project_Node      => Loaded_Tree,
                   From_Project_Node_Tree => From_Project_Node_Tree,
-                  Env                    => Env,
-                  Extended_By            => No_Project);
+                  Env                    => Child_Env,
+                  Extended_By            => No_Project,
+                  Child_Env              => Child_Env,
+                  Is_Root_Project        => False);
             else
                Debug_Output ("Failed to parse", Name_Id (List.Path));
             end if;
@@ -2768,7 +2820,9 @@ package body Prj.Proc is
                  (Declaration_Node, From_Project_Node_Tree),
                From_Project_Node_Tree => From_Project_Node_Tree,
                Env                    => Env,
-               Extended_By            => Project);
+               Extended_By            => Project,
+               Child_Env              => Child_Env,
+               Is_Root_Project        => False);
 
             Process_Declarative_Items
               (Project                => Project,
@@ -2778,7 +2832,9 @@ package body Prj.Proc is
                Env                    => Env,
                Pkg                    => No_Package,
                Item                   => First_Declarative_Item_Of
-                 (Declaration_Node, From_Project_Node_Tree));
+                 (Declaration_Node, From_Project_Node_Tree),
+               Child_Env              => Child_Env,
+               Can_Modify_Child_Env   => Is_Root_Project);
 
             if Project.Extends /= No_Project then
                Process_Extended_Project;
diff --git a/gcc/ada/prj-tree.adb b/gcc/ada/prj-tree.adb
index 3ac6a88..0a1b9a5 100644
--- a/gcc/ada/prj-tree.adb
+++ b/gcc/ada/prj-tree.adb
@@ -1005,7 +1005,8 @@ package body Prj.Tree is
    ----------------
 
    procedure Initialize
-     (Self : in out Environment; Flags : Processing_Flags) is
+     (Self      : out Environment;
+      Flags     : Processing_Flags) is
    begin
       --  Do not reset the external references, in case we are reloading a
       --  project, since we want to preserve the current environment. But we
@@ -1018,6 +1019,19 @@ package body Prj.Tree is
       Self.Flags := Flags;
    end Initialize;
 
+   -------------------------
+   -- Initialize_And_Copy --
+   -------------------------
+
+   procedure Initialize_And_Copy
+     (Self      : out Environment;
+      Copy_From : Environment) is
+   begin
+      Self.Flags := Copy_From.Flags;
+      Prj.Ext.Initialize (Self.External, Copy_From => Copy_From.External);
+      Prj.Env.Copy (From => Copy_From.Project_Path, To => Self.Project_Path);
+   end Initialize_And_Copy;
+
    ----------
    -- Free --
    ----------
diff --git a/gcc/ada/prj-tree.ads b/gcc/ada/prj-tree.ads
index 69372ae..fede1f9 100644
--- a/gcc/ada/prj-tree.ads
+++ b/gcc/ada/prj-tree.ads
@@ -60,9 +60,16 @@ package Prj.Tree is
       --  Configure errors and warnings
    end record;
 
-   procedure Initialize (Self : in out Environment; Flags : Processing_Flags);
+   procedure Initialize
+     (Self      : out Environment;
+      Flags     : Processing_Flags);
    --  Initialize a new environment
 
+   procedure Initialize_And_Copy
+     (Self      : out Environment;
+      Copy_From : Environment);
+   --  Initialize a new environment, copying its values from Copy_From
+
    procedure Free (Self : in out Environment);
    --  Free the memory used by Self