2010-12-06 Jerry DeLisle <jvdelisle@gcc.gnu.org>

[pf3gnuchains/gcc-fork.git] / gcc / ada / prj-tree.adb

diff --git a/gcc/ada/prj-tree.adb b/gcc/ada/prj-tree.adb
index 7d77e2a..f1b700b 100644 (file)
--- a/gcc/ada/prj-tree.adb
+++ b/gcc/ada/prj-tree.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2001-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 2001-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- --
@@ -23,10 +23,12 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with Ada.Unchecked_Deallocation;
 with Osint;   use Osint;
+with Prj.Env; use Prj.Env;
 with Prj.Err;
 
+with Ada.Unchecked_Deallocation;
+
 package body Prj.Tree is
 
    Node_With_Comments : constant array (Project_Node_Kind) of Boolean :=
@@ -557,11 +559,12 @@ package body Prj.Tree is
 
    function Expression_Kind_Of
      (Node    : Project_Node_Id;
-      In_Tree : Project_Node_Tree_Ref) return Variable_Kind is
+      In_Tree : Project_Node_Tree_Ref) return Variable_Kind
+   is
    begin
       pragma Assert
         (Present (Node)
-           and then
+           and then -- should use Nkind_In here ??? why not???
              (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
                 or else
               In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
@@ -569,7 +572,7 @@ package body Prj.Tree is
               In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration
                 or else
               In_Tree.Project_Nodes.Table (Node).Kind =
-                       N_Typed_Variable_Declaration
+                                                  N_Typed_Variable_Declaration
                 or else
               In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration
                 or else
@@ -579,9 +582,9 @@ package body Prj.Tree is
                 or else
               In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
                 or else
-              In_Tree.Project_Nodes.Table (Node).Kind =
-                        N_Attribute_Reference));
-
+              In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference
+                or else
+              In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value));
       return In_Tree.Project_Nodes.Table (Node).Expr_Kind;
    end Expression_Kind_Of;
 
@@ -1000,6 +1003,7 @@ package body Prj.Tree is
       if Proj /= null then
          Project_Node_Table.Free (Proj.Project_Nodes);
          Projects_Htable.Reset (Proj.Projects_HT);
+         Name_To_Name_HTable.Reset (Proj.External_References);
          Free (Proj.Project_Path);
          Unchecked_Free (Proj);
       end if;
@@ -1834,7 +1838,7 @@ package body Prj.Tree is
    begin
       pragma Assert
         (Present (Node)
-           and then
+           and then -- should use Nkind_In here ??? why not???
              (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
                 or else
               In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
@@ -1842,7 +1846,7 @@ package body Prj.Tree is
               In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration
                 or else
               In_Tree.Project_Nodes.Table (Node).Kind =
-                N_Typed_Variable_Declaration
+                                                  N_Typed_Variable_Declaration
                 or else
               In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration
                 or else
@@ -1852,8 +1856,9 @@ package body Prj.Tree is
                 or else
               In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
                 or else
-              In_Tree.Project_Nodes.Table (Node).Kind =
-                N_Attribute_Reference));
+              In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference
+                or else
+              In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value));
       In_Tree.Project_Nodes.Table (Node).Expr_Kind := To;
    end Set_Expression_Kind_Of;
 
@@ -2964,12 +2969,17 @@ package body Prj.Tree is
      (Node : Project_Node_Id;
       Tree : Project_Node_Tree_Ref) return Project_Node_Id
    is
-      Expr : constant Project_Node_Id :=
-               Default_Project_Node (Tree, N_Expression, Single);
+      Expr : Project_Node_Id;
    begin
-      Set_First_Term (Expr, Tree, Default_Project_Node (Tree, N_Term, Single));
-      Set_Current_Term (First_Term (Expr, Tree), Tree, Node);
-      return Expr;
+      if Kind_Of (Node, Tree) /= N_Expression then
+         Expr := Default_Project_Node (Tree, N_Expression, Single);
+         Set_First_Term
+           (Expr, Tree, Default_Project_Node (Tree, N_Term, Single));
+         Set_Current_Term (First_Term (Expr, Tree), Tree, Node);
+         return Expr;
+      else
+         return Node;
+      end if;
    end Enclose_In_Expression;
 
    --------------------
@@ -3020,7 +3030,7 @@ package body Prj.Tree is
       return Pack;
    end Create_Package;
 
-   -------------------
+   ----------------------
    -- Create_Attribute --
    ----------------------
 
@@ -3030,7 +3040,8 @@ package body Prj.Tree is
       Name       : Name_Id;
       Index_Name : Name_Id       := No_Name;
       Kind       : Variable_Kind := List;
-      At_Index   : Integer       := 0) return Project_Node_Id
+      At_Index   : Integer       := 0;
+      Value      : Project_Node_Id := Empty_Node) return Project_Node_Id
    is
       Node : constant Project_Node_Id :=
                Default_Project_Node (Tree, N_Attribute_Declaration, Kind);
@@ -3039,14 +3050,11 @@ package body Prj.Tree is
 
       Pkg      : Package_Node_Id;
       Start_At : Attribute_Node_Id;
+      Expr     : Project_Node_Id;
 
    begin
       Set_Name_Of (Node, Tree, Name);
 
-      if At_Index /= 0 then
-         Set_Source_Index_Of (Node, Tree, To => Int (At_Index));
-      end if;
-
       if Index_Name /= No_Name then
          Set_Associative_Array_Index_Of (Node, Tree, Index_Name);
       end if;
@@ -3071,6 +3079,33 @@ package body Prj.Tree is
         Attribute_Kind_Of (Start_At) = Case_Insensitive_Associative_Array;
       Tree.Project_Nodes.Table (Node).Flag1 := Case_Insensitive;
 
+      if At_Index /= 0 then
+         if Attribute_Kind_Of (Start_At) =
+              Optional_Index_Associative_Array
+           or else Attribute_Kind_Of (Start_At) =
+              Optional_Index_Case_Insensitive_Associative_Array
+         then
+            --  Results in:   for Name ("index" at index) use "value";
+            --  This is currently only used for executables.
+
+            Set_Source_Index_Of (Node, Tree, To => Int (At_Index));
+
+         else
+            --  Results in:   for Name ("index") use "value" at index;
+
+            --  ??? This limitation makes no sense, we should be able to
+            --  set the source index on an expression.
+
+            pragma Assert (Kind_Of (Value, Tree) = N_Literal_String);
+            Set_Source_Index_Of (Value, Tree, To => Int (At_Index));
+         end if;
+      end if;
+
+      if Value /= Empty_Node then
+         Expr := Enclose_In_Expression (Value, Tree);
+         Set_Expression_Of (Node, Tree, Expr);
+      end if;
+
       return Node;
    end Create_Attribute;