[multiple changes]

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

	* prj-part.adb, prj-part.ads, prj-makr.adb, prj-pars.adb, prj-conf.adb,
	prj-env.adb (Prj.Part.Parse): change parameter Always_Errout_Finalize
	to Errout_Handling.

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

	* prj-dect.adb (Parse_Attribute_Declaration): make sure we can use
	"external" as an attribute name in aggregate projects.

2011-08-03  Jose Ruiz  <ruiz@adacore.com>

	* s-taprop-vxworks.adb: (Create_Task, Initialize): Ada 2012 pragma CPU
	uses CPU numbers starting 1, while VxWorks uses CPU numbers starting
	from 0, so we need to adjust.

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

	* prj-proc.adb, prj-ext.adb, prj-ext.ads, makeutl.adb, prj-tree.adb,
	prj-tree.ads, gnatcmd.adb, clean.adb (External_References): new type.

From-SVN: r177244

1 files changed, 121 insertions, 25 deletions

diff --git a/gcc/ada/prj-ext.adb b/gcc/ada/prj-ext.adb
index 9c7458e..ee6d2c3 100644
--- a/gcc/ada/prj-ext.adb
+++ b/gcc/ada/prj-ext.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2000-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2000-2011, 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- --
@@ -23,31 +23,65 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Ada.Unchecked_Deallocation;
 with Osint;    use Osint;
-with Prj.Tree; use Prj.Tree;
 
 package body Prj.Ext is
 
+   ----------------
+   -- Initialize --
+   ----------------
+
+   procedure Initialize
+     (Self      : out External_References;
+      Copy_From : External_References := No_External_Refs)
+   is
+      N  : Name_To_Name_Ptr;
+      N2 : Name_To_Name_Ptr;
+   begin
+      if Self.Refs = null then
+         Self.Refs := new Name_To_Name_HTable.Instance;
+
+         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;
+               Name_To_Name_HTable.Set (Self.Refs.all, N2);
+               N := Name_To_Name_HTable.Get_Next (Copy_From.Refs.all);
+            end loop;
+         end if;
+      end if;
+   end Initialize;
+
    ---------
    -- Add --
    ---------
 
    procedure Add
-     (Tree          : Prj.Tree.Project_Node_Tree_Ref;
+     (Self          : External_References;
       External_Name : String;
       Value         : String)
    is
-      The_Key   : Name_Id;
-      The_Value : Name_Id;
+      N : Name_To_Name_Ptr;
    begin
+      N := new Name_To_Name;
+
       Name_Len := Value'Length;
       Name_Buffer (1 .. Name_Len) := Value;
-      The_Value := Name_Find;
+      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));
-      The_Key := Name_Find;
-      Name_To_Name_HTable.Set (Tree.External_References, The_Key, The_Value);
+      N.Key := Name_Find;
+
+      if Current_Verbosity = High then
+         Debug_Output ("Add (" & External_Name & ") is", N.Value);
+      end if;
+
+      Name_To_Name_HTable.Set (Self.Refs.all, N);
    end Add;
 
    -----------
@@ -55,7 +89,7 @@ package body Prj.Ext is
    -----------
 
    function Check
-     (Tree        : Prj.Tree.Project_Node_Tree_Ref;
+     (Self        : External_References;
       Declaration : String) return Boolean
    is
    begin
@@ -63,7 +97,7 @@ package body Prj.Ext is
          if Declaration (Equal_Pos) = '=' then
             exit when Equal_Pos = Declaration'First;
             Add
-              (Tree          => Tree,
+              (Self          => Self,
                External_Name =>
                  Declaration (Declaration'First .. Equal_Pos - 1),
                Value         =>
@@ -79,9 +113,12 @@ package body Prj.Ext is
    -- Reset --
    -----------
 
-   procedure Reset (Tree : Prj.Tree.Project_Node_Tree_Ref) is
+   procedure Reset (Self : External_References) is
    begin
-      Name_To_Name_HTable.Reset (Tree.External_References);
+      if Self.Refs /= null then
+         Debug_Output ("Reset external references");
+         Name_To_Name_HTable.Reset (Self.Refs.all);
+      end if;
    end Reset;
 
    --------------
@@ -89,23 +126,26 @@ package body Prj.Ext is
    --------------
 
    function Value_Of
-     (Tree          : Prj.Tree.Project_Node_Tree_Ref;
+     (Self          : External_References;
       External_Name : Name_Id;
       With_Default  : Name_Id := No_Name)
       return          Name_Id
    is
-      The_Value : Name_Id;
-      Name      : String := Get_Name_String (External_Name);
+      Value : Name_To_Name_Ptr;
+      Val   : Name_Id;
+      Name  : String := Get_Name_String (External_Name);
 
    begin
       Canonical_Case_Env_Var_Name (Name);
-      Name_Len := Name'Length;
-      Name_Buffer (1 .. Name_Len) := Name;
-      The_Value :=
-        Name_To_Name_HTable.Get (Tree.External_References, Name_Find);
 
-      if The_Value /= No_Name then
-         return The_Value;
+      if Self.Refs /= null then
+         Name_Len := Name'Length;
+         Name_Buffer (1 .. Name_Len) := Name;
+         Value := Name_To_Name_HTable.Get (Self.Refs.all, Name_Find);
+
+         if Value /= null then
+            return Value.Value;
+         end if;
       end if;
 
       --  Find if it is an environment, if it is, put value in the hash table
@@ -117,17 +157,73 @@ package body Prj.Ext is
          if Env_Value /= null and then Env_Value'Length > 0 then
             Name_Len := Env_Value'Length;
             Name_Buffer (1 .. Name_Len) := Env_Value.all;
-            The_Value := Name_Find;
-            Name_To_Name_HTable.Set
-              (Tree.External_References, External_Name, The_Value);
+            Val := Name_Find;
+
+            if Current_Verbosity = High then
+               Debug_Output ("Value_Of (" & Get_Name_String (External_Name)
+                             & ") is", Val);
+            end if;
+
+            if Self.Refs /= null then
+               Value := new Name_To_Name;
+               Value.Key := External_Name;
+               Value.Value := Val;
+               Name_To_Name_HTable.Set (Self.Refs.all, Value);
+            end if;
+
             Free (Env_Value);
-            return The_Value;
+            return Val;
 
          else
+            if Current_Verbosity = High then
+               Debug_Output ("Value_Of (" & Get_Name_String (External_Name)
+                             & ") is default", With_Default);
+            end if;
             Free (Env_Value);
             return With_Default;
          end if;
       end;
    end Value_Of;
 
+   ----------
+   -- Free --
+   ----------
+
+   procedure Free (Self : in out External_References) is
+      procedure Unchecked_Free is new Ada.Unchecked_Deallocation
+        (Name_To_Name_HTable.Instance, Instance_Access);
+   begin
+      if Self.Refs /= null then
+         Reset (Self);
+         Unchecked_Free (Self.Refs);
+      end if;
+   end Free;
+
+   --------------
+   -- Set_Next --
+   --------------
+
+   procedure Set_Next (E : Name_To_Name_Ptr; Next : Name_To_Name_Ptr) is
+   begin
+      E.Next := Next;
+   end Set_Next;
+
+   ----------
+   -- Next --
+   ----------
+
+   function Next (E : Name_To_Name_Ptr) return Name_To_Name_Ptr is
+   begin
+      return E.Next;
+   end Next;
+
+   -------------
+   -- Get_Key --
+   -------------
+
+   function Get_Key (E : Name_To_Name_Ptr) return Name_Id is
+   begin
+      return E.Key;
+   end Get_Key;
+
 end Prj.Ext;