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

prj-proc.adb, [...] (Get_Attribute_Index): do not systematically lower case attribute indexes that contain no "." Fix...

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

gcc/ada/ChangeLog

 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,
 	prj-part.ads, switch-m.adb, switch-m.ads, prj-makr.adb, clean.adb,
 	prj-pars.adb, prj-pars.ads, prj-conf.adb, prj-conf.ads, prj-tree.adb,

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 --
    ----------

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;

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#" &
 

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;