prj-proc.adb, [...] (Get_Attribute_Index): do not systematically lower case attribute...

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

	* prj-proc.adb, prj-attr.adb, prj-attr.ads (Get_Attribute_Index): do
	not systematically lower case attribute indexes that contain no "."
	Fix definition of several Naming attributes, which take
	a unit name as index and therefore should be case insensitive.
	Minor refactoring (reduce length of variable names).

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

	* makeutl.adb, makeutl.ads (Get_Switches): new subprogram.

From-SVN: r177250

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 4287e95e1e86fee854f27b62070f240069f40c33..587e390d84c7b7f8c24fb7f007da238fe657d8db 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,15 @@
+2011-08-03  Emmanuel Briot  <briot@adacore.com>
+
+       * prj-proc.adb, prj-attr.adb, prj-attr.ads (Get_Attribute_Index): do
+       not systematically lower case attribute indexes that contain no "."
+       Fix definition of several Naming attributes, which take
+       a unit name as index and therefore should be case insensitive.
+       Minor refactoring (reduce length of variable names).
+
+2011-08-03  Emmanuel Briot  <briot@adacore.com>
+
+       * makeutl.adb, makeutl.ads (Get_Switches): new subprogram.
+
 2011-08-03  Emmanuel Briot  <briot@adacore.com>
 
        * gnatcmd.adb, prj-proc.adb, prj-proc.ads, make.adb, prj-part.adb,

diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb
index 5f677ea699ee4e0ea294cc78b96dbdef160b614c..6127833a2e539bc7b98a5700b7e959591240dc30 100644 (file)
--- a/gcc/ada/makeutl.adb
+++ b/gcc/ada/makeutl.adb
@@ -652,6 +652,92 @@ package body Makeutl is
       return False;
    end File_Not_A_Source_Of;
 
+   ------------------
+   -- Get_Switches --
+   ------------------
+
+   procedure Get_Switches
+     (Source       : Prj.Source_Id;
+      Pkg_Name     : Name_Id;
+      Project_Tree : Project_Tree_Ref;
+      Value        : out Variable_Value;
+      Is_Default   : out Boolean)
+   is
+   begin
+      Get_Switches
+        (Source_File  => Source.File,
+         Source_Lang  => Source.Language.Name,
+         Source_Prj   => Source.Project,
+         Pkg_Name     => Pkg_Name,
+         Project_Tree => Project_Tree,
+         Value        => Value,
+         Is_Default   => Is_Default);
+   end Get_Switches;
+
+   ------------------
+   -- Get_Switches --
+   ------------------
+
+   procedure Get_Switches
+     (Source_File  : File_Name_Type;
+      Source_Lang  : Name_Id;
+      Source_Prj   : Project_Id;
+      Pkg_Name     : Name_Id;
+      Project_Tree : Project_Tree_Ref;
+      Value        : out Variable_Value;
+      Is_Default   : out Boolean)
+   is
+      Project       : constant Project_Id :=
+        Ultimate_Extending_Project_Of (Source_Prj);
+      Pkg : constant Package_Id :=
+        Prj.Util.Value_Of
+          (Name        => Pkg_Name,
+           In_Packages => Project.Decl.Packages,
+           In_Tree     => Project_Tree);
+   begin
+      Is_Default := False;
+
+      if Source_File /= No_File then
+         Value := Prj.Util.Value_Of
+           (Name                    => Name_Id (Source_File),
+            Attribute_Or_Array_Name => Name_Switches,
+            In_Package              => Pkg,
+            In_Tree                 => Project_Tree,
+            Allow_Wildcards         => True);
+      end if;
+
+      if Value = Nil_Variable_Value then
+         Is_Default := True;
+         Is_Default := True;
+         Value :=
+           Prj.Util.Value_Of
+             (Name                    => Source_Lang,
+              Attribute_Or_Array_Name => Name_Switches,
+              In_Package              => Pkg,
+              In_Tree                 => Project_Tree,
+              Force_Lower_Case_Index  => True);
+      end if;
+
+      if Value = Nil_Variable_Value then
+         Value :=
+           Prj.Util.Value_Of
+             (Name                    => All_Other_Names,
+              Attribute_Or_Array_Name => Name_Switches,
+              In_Package              => Pkg,
+              In_Tree                 => Project_Tree,
+              Force_Lower_Case_Index  => True);
+      end if;
+
+      if Value = Nil_Variable_Value then
+         Value :=
+           Prj.Util.Value_Of
+             (Name                    => Source_Lang,
+              Attribute_Or_Array_Name => Name_Default_Switches,
+              In_Package              => Pkg,
+              In_Tree                 => Project_Tree);
+      end if;
+   end Get_Switches;
+
    ----------
    -- Hash --
    ----------

diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads
index b1e5765c814d72d64d456809ad585e780c7a7b0f..8e9e151ee74a31b2e0b90d28696bcf589953acae 100644 (file)
--- a/gcc/ada/makeutl.ads
+++ b/gcc/ada/makeutl.ads
@@ -148,6 +148,28 @@ 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.
 
+   procedure Get_Switches
+     (Source       : Source_Id;
+      Pkg_Name     : Name_Id;
+      Project_Tree : Project_Tree_Ref;
+      Value        : out Variable_Value;
+      Is_Default   : out Boolean);
+   procedure Get_Switches
+     (Source_File  : File_Name_Type;
+      Source_Lang  : Name_Id;
+      Source_Prj   : Project_Id;
+      Pkg_Name     : Name_Id;
+      Project_Tree : Project_Tree_Ref;
+      Value        : out Variable_Value;
+      Is_Default   : out Boolean);
+   --  Compute the switches (Compilation switches for instance) for the given
+   --  file. This checks various attributes to see whether there are file
+   --  specific switches, or else defaults on the switches for the
+   --  corresponding language.
+   --  Is_Default is set to False if there were file-specific switches
+   --  Source_File can be set to No_File to force retrieval of the default
+   --  switches.
+
    function Linker_Options_Switches
      (Project  : Project_Id;
       In_Tree  : Project_Tree_Ref) return String_List;

diff --git a/gcc/ada/prj-attr.adb b/gcc/ada/prj-attr.adb
index 6fb2c0a3e5b1ec787d06f5187a3510ce454d64c6..d584f6cb89f645951d3a23aae7526d17ac21ffa0 100644 (file)
--- a/gcc/ada/prj-attr.adb
+++ b/gcc/ada/prj-attr.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2001-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2001-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- --
@@ -165,10 +165,10 @@ package body Prj.Attr is
    "SVseparate_suffix#" &
    "SVcasing#" &
    "SVdot_replacement#" &
-   "sAspecification#" &  --  Always renamed to "spec" in project tree
-   "sAspec#" &
-   "sAimplementation#" & --  Always renamed to "body" in project tree
-   "sAbody#" &
+   "saspecification#" &  --  Always renamed to "spec" in project tree
+   "saspec#" &
+   "saimplementation#" & --  Always renamed to "body" in project tree
+   "sabody#" &
    "Laspecification_exceptions#" &
    "Laimplementation_exceptions#" &
 

diff --git a/gcc/ada/prj-attr.ads b/gcc/ada/prj-attr.ads
index a16e6f3d181f5d8beb6da59d8b59519c3874d857..b171719de69f66d318914f9c5a1fa3fb2afdea10 100644 (file)
--- a/gcc/ada/prj-attr.ads
+++ b/gcc/ada/prj-attr.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2001-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2001-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- --
@@ -152,6 +152,21 @@ package Prj.Attr is
      (Attribute : Attribute_Node_Id) return Attribute_Kind;
    --  Returns the attribute kind of a known attribute. Returns Unknown if
    --  Attribute is Empty_Attribute.
+   --
+   --  To use this function, the following code should be used:
+   --      Pkg : constant Package_Node_Id :=
+   --        Prj.Attr.Package_Node_Id_Of (Name => <package name>);
+   --      Att : constant Attribute_Node_Id :=
+   --        Prj.Attr.Attribute_Node_Id_Of
+   --          (Name => <attribute name>,
+   --           Starting_At => First_Attribute_Of (Pkg));
+   --      Kind : constant Attribute_Kind := Attribute_Kind_Of (Att);
+   --
+   --  However, you should not use this function once you have an already
+   --  parsed project tree. Instead, given a Project_Node_Id corresponding to
+   --  the attribute declaration ("for Attr (index) use ..."), it is simpler to
+   --  use
+   --      if Case_Insensitive (Attr, Tree) then ...
 
    procedure Set_Attribute_Kind_Of
      (Attribute : Attribute_Node_Id;

diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb
index 6dd3ca7311df4aabf5e23b4f50fc1f845eedea89..be3a0a7f3bfb5a535240fd08a841776461fac617 100644 (file)
--- a/gcc/ada/prj-proc.adb
+++ b/gcc/ada/prj-proc.adb
@@ -458,41 +458,19 @@ package body Prj.Proc is
    -------------------------
 
    function Get_Attribute_Index
-     (Tree  : Project_Node_Tree_Ref;
-      Attr  : Project_Node_Id;
-      Index : Name_Id) return Name_Id
-   is
-      Lower : Boolean;
-
+     (Tree   : Project_Node_Tree_Ref;
+      Attr   : Project_Node_Id;
+      Index  : Name_Id) return Name_Id is
    begin
-      if Index = All_Other_Names then
+      if Index = All_Other_Names
+        or else not Case_Insensitive (Attr, Tree)
+      then
          return Index;
       end if;
 
       Get_Name_String (Index);
-      Lower := Case_Insensitive (Attr, Tree);
-
-      --  The index is always case insensitive if it does not include any dot.
-      --  ??? Why not use the properties from prj-attr, simply, maybe because
-      --  we don't know whether we have a file as an index?
-
-      if not Lower then
-         Lower := True;
-
-         for J in 1 .. Name_Len loop
-            if Name_Buffer (J) = '.' then
-               Lower := False;
-               exit;
-            end if;
-         end loop;
-      end if;
-
-      if Lower then
-         To_Lower (Name_Buffer (1 .. Name_Len));
-         return Name_Find;
-      else
-         return Index;
-      end if;
+      To_Lower (Name_Buffer (1 .. Name_Len));
+      return Name_Find;
    end Get_Attribute_Index;
 
    ----------------
@@ -1440,7 +1418,7 @@ package body Prj.Proc is
       procedure Process_Expression
         (Current : Project_Node_Id);
       procedure Process_Expression_For_Associative_Array
-        (Current_Item : Project_Node_Id;
+        (Current : Project_Node_Id;
          New_Value    : Variable_Value);
       procedure Process_Expression_Variable_Decl
         (Current_Item : Project_Node_Id;
@@ -1869,29 +1847,25 @@ package body Prj.Proc is
       ----------------------------------------------
 
       procedure Process_Expression_For_Associative_Array
-        (Current_Item : Project_Node_Id;
-         New_Value    : Variable_Value)
+        (Current   : Project_Node_Id;
+         New_Value : Variable_Value)
       is
-         Current_Item_Name : constant Name_Id :=
-           Name_Of (Current_Item, Node_Tree);
+         Name : constant Name_Id := Name_Of (Current, Node_Tree);
          Current_Location : constant Source_Ptr :=
-           Location_Of (Current_Item, Node_Tree);
+           Location_Of (Current, Node_Tree);
 
          Index_Name : Name_Id :=
-           Associative_Array_Index_Of (Current_Item, Node_Tree);
+           Associative_Array_Index_Of (Current, Node_Tree);
 
          Source_Index : constant Int :=
-           Source_Index_Of (Current_Item, Node_Tree);
+           Source_Index_Of (Current, Node_Tree);
 
-         The_Array         : Array_Id;
-         The_Array_Element : Array_Element_Id := No_Array_Element;
+         The_Array : Array_Id;
+         Elem      : Array_Element_Id := No_Array_Element;
 
       begin
          if Index_Name /= All_Other_Names then
-            Index_Name := Get_Attribute_Index
-              (Node_Tree,
-               Current_Item,
-               Associative_Array_Index_Of (Current_Item, Node_Tree));
+            Index_Name := Get_Attribute_Index (Node_Tree, Current, Index_Name);
          end if;
 
          --  Look for the array in the appropriate list
@@ -1903,7 +1877,7 @@ package body Prj.Proc is
          end if;
 
          while The_Array /= No_Array
-           and then In_Tree.Arrays.Table (The_Array).Name /= Current_Item_Name
+           and then In_Tree.Arrays.Table (The_Array).Name /= Name
          loop
             The_Array := In_Tree.Arrays.Table (The_Array).Next;
          end loop;
@@ -1919,7 +1893,7 @@ package body Prj.Proc is
 
             if Pkg /= No_Package then
                In_Tree.Arrays.Table (The_Array) :=
-                 (Name     => Current_Item_Name,
+                 (Name     => Name,
                   Location => Current_Location,
                   Value    => No_Array_Element,
                   Next     => In_Tree.Packages.Table (Pkg).Decl.Arrays);
@@ -1928,7 +1902,7 @@ package body Prj.Proc is
 
             else
                In_Tree.Arrays.Table (The_Array) :=
-                 (Name     => Current_Item_Name,
+                 (Name     => Name,
                   Location => Current_Location,
                   Value    => No_Array_Element,
                   Next     => Project.Decl.Arrays);
@@ -1936,54 +1910,52 @@ package body Prj.Proc is
                Project.Decl.Arrays := The_Array;
             end if;
 
-            --  Otherwise initialize The_Array_Element as the
-            --  head of the element list.
-
          else
-            The_Array_Element := In_Tree.Arrays.Table (The_Array).Value;
+            Elem := In_Tree.Arrays.Table (The_Array).Value;
          end if;
 
          --  Look in the list, if any, to find an element
          --  with the same index and same source index.
 
-         while The_Array_Element /= No_Array_Element
+         while Elem /= No_Array_Element
            and then
-             (In_Tree.Array_Elements.Table (The_Array_Element).Index /=
-                Index_Name
+             (In_Tree.Array_Elements.Table (Elem).Index /= Index_Name
               or else
-                In_Tree.Array_Elements.Table (The_Array_Element).Src_Index /=
-                Source_Index)
+                In_Tree.Array_Elements.Table (Elem).Src_Index /= Source_Index)
          loop
-            The_Array_Element :=
-              In_Tree.Array_Elements.Table (The_Array_Element).Next;
+            Elem := In_Tree.Array_Elements.Table (Elem).Next;
          end loop;
 
          --  If no such element were found, create a new one
          --  and insert it in the element list, with the
          --  proper value.
 
-         if The_Array_Element = No_Array_Element then
+         if Elem = No_Array_Element then
             Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
-            The_Array_Element :=
-              Array_Element_Table.Last (In_Tree.Array_Elements);
+            Elem := Array_Element_Table.Last (In_Tree.Array_Elements);
 
             In_Tree.Array_Elements.Table
-              (The_Array_Element) :=
+              (Elem) :=
               (Index                => Index_Name,
                Src_Index            => Source_Index,
                Index_Case_Sensitive =>
-                  not Case_Insensitive (Current_Item, Node_Tree),
+                  not Case_Insensitive (Current, Node_Tree),
                Value                => New_Value,
                Next                 => In_Tree.Arrays.Table (The_Array).Value);
 
-            In_Tree.Arrays.Table (The_Array).Value := The_Array_Element;
+            In_Tree.Arrays.Table (The_Array).Value := Elem;
 
+         else
             --  An element with the same index already exists,
             --  just replace its value with the new one.
 
-         else
-            In_Tree.Array_Elements.Table (The_Array_Element).Value :=
-              New_Value;
+            In_Tree.Array_Elements.Table (Elem).Value := New_Value;
+         end if;
+
+         if Name = Snames.Name_External then
+            Debug_Output
+              ("Defined external value ("
+               & Get_Name_String (Index_Name) & ")", New_Value.Value);
          end if;
       end Process_Expression_For_Associative_Array;
 
@@ -1995,80 +1967,74 @@ package body Prj.Proc is
         (Current_Item : Project_Node_Id;
          New_Value    : Variable_Value)
       is
-         Current_Item_Name : constant Name_Id :=
-           Name_Of (Current_Item, Node_Tree);
-         The_Variable : Variable_Id := No_Variable;
+         Name : constant Name_Id := Name_Of (Current_Item, Node_Tree);
+         Var : Variable_Id := No_Variable;
+         Is_Attribute : constant Boolean :=
+           Kind_Of (Current_Item, Node_Tree) = N_Attribute_Declaration;
 
       begin
          --  First, find the list where to find the variable or attribute.
 
-         if Kind_Of (Current_Item, Node_Tree) =
-           N_Attribute_Declaration
-         then
+         if Is_Attribute then
             if Pkg /= No_Package then
-               The_Variable := In_Tree.Packages.Table (Pkg).Decl.Attributes;
+               Var := In_Tree.Packages.Table (Pkg).Decl.Attributes;
             else
-               The_Variable := Project.Decl.Attributes;
+               Var := Project.Decl.Attributes;
             end if;
 
          else
             if Pkg /= No_Package then
-               The_Variable := In_Tree.Packages.Table (Pkg).Decl.Variables;
+               Var := In_Tree.Packages.Table (Pkg).Decl.Variables;
             else
-               The_Variable := Project.Decl.Variables;
+               Var := Project.Decl.Variables;
             end if;
          end if;
 
          --  Loop through the list, to find if it has already been declared.
 
-         while The_Variable /= No_Variable
-           and then In_Tree.Variable_Elements.Table (The_Variable).Name /=
-              Current_Item_Name
+         while Var /= No_Variable
+           and then In_Tree.Variable_Elements.Table (Var).Name /= Name
          loop
-            The_Variable :=
-              In_Tree.Variable_Elements.Table (The_Variable).Next;
+            Var := In_Tree.Variable_Elements.Table (Var).Next;
          end loop;
 
          --  If it has not been declared, create a new entry
          --  in the list.
 
-         if The_Variable = No_Variable then
+         if Var = No_Variable then
 
             --  All single string attribute should already have
             --  been declared with a default empty string value.
 
             pragma Assert
-              (Kind_Of (Current_Item, Node_Tree) /=
-                 N_Attribute_Declaration,
-               "illegal attribute declaration for "
-               & Get_Name_String (Current_Item_Name));
+              (not Is_Attribute,
+               "illegal attribute declaration for " & Get_Name_String (Name));
 
             Variable_Element_Table.Increment_Last (In_Tree.Variable_Elements);
-            The_Variable := Variable_Element_Table.Last
-              (In_Tree.Variable_Elements);
+            Var := Variable_Element_Table.Last (In_Tree.Variable_Elements);
 
             --  Put the new variable in the appropriate list
 
             if Pkg /= No_Package then
-               In_Tree.Variable_Elements.Table (The_Variable) :=
+               In_Tree.Variable_Elements.Table (Var) :=
                  (Next   => In_Tree.Packages.Table (Pkg).Decl.Variables,
-                  Name   => Current_Item_Name,
+                  Name   => Name,
                   Value  => New_Value);
-               In_Tree.Packages.Table (Pkg).Decl.Variables := The_Variable;
+               In_Tree.Packages.Table (Pkg).Decl.Variables := Var;
 
             else
-               In_Tree.Variable_Elements.Table (The_Variable) :=
+               In_Tree.Variable_Elements.Table (Var) :=
                  (Next   => Project.Decl.Variables,
-                  Name   => Current_Item_Name,
+                  Name   => Name,
                   Value  => New_Value);
-               Project.Decl.Variables := The_Variable;
+               Project.Decl.Variables := Var;
             end if;
 
             --  If the variable/attribute has already been
             --  declared, just change the value.
 
          else
-            In_Tree.Variable_Elements.Table (The_Variable).Value := New_Value;
+            In_Tree.Variable_Elements.Table (Var).Value := New_Value;
          end if;
       end Process_Expression_Variable_Decl;