2007-12-06 Emmanuel Briot <briot@adacore.com>

	    Vincent Celier  <celier@adacore.com>

	* prj.ads, prj.adb (Is_A_Language): Now takes a Name_Id instead of a
	string
	(Must_Check_Configuration, Default_Language_Is_Ada): new flags in
	prj.ads
	(Hash): Move instantiation of System.HTable.Hash from spec to body
	(prj-nmsc.adb): Optimize calls to Name_Find when on case sensitive
	systems, since we do not need to recompute the Name_Id for the canonical
	file name.
	(Body_Suffix_Id_Of, Spec_Suffix_Id_Of): new version that takes a name_id
	as a parameter. This parameter is in fact always "ada" in all calls, and
	we were doing 160560 extra calls to Name_Find to convert it to Name_Ada
	while loading a project with 40000 files

	* prj-attr.adb: Fix name of attribute Dependency_Driver
	Change the kind of indexing for attribute Root

	* prj-dect.adb (Parse_Declarative_Items): Allow redeclarations of
	variables already declared, in case constructions.

	* prj-env.adb (Initialize): Reset Current_Source_Path_File and
	Current_Object_Path_File to No_Path.

	* prj-ext.adb (Initialize_Project_Path): In multi language mode, use
	ADA_PROJECT_PATH if value of GPR_PROJECT_PATH is empty.

	* prj-makr.adb: new parameter Current_Dir

	* prj-nmsc.ads, prj-nmsc.adb (Find_Explicit_Sources): Do not look for
	Ada sources when language is not Ada.
	Change Opt.Follow_Links to Opt.Follow_Links_For_Files.
	(Find_Excluded_Sources, Find_Explicit_Sources): new subprograms
	(Must_Check_Configuration, Default_Language_Is_Ada): new flags.
	(Locate_Directory): Always resolve links when computing Canonical_Path
	(Look_For_Sources): Make sure that Name_Buffer contains the file name
	in Source_Files before checking for the presence of a directory
	separator.
	Optimize calls to Name_Find when on case sensitive systems.
	(Body_Suffix_Id_Of, Spec_Suffix_Id_Of): new version that takes a name_id
	as a parameter.
	(Prj.Nmsc.Check): new parameter Current_Dir
	(Check_Ada_Naming_Schemes): Restrictions on suffixes are relaxed. They
	cannot be empty and the spec suffix cannot be the same as the body or
	separate suffix.
	(Get_Unit): When a file name can be of several unit kinds (spec, body or
	subunit), always consider the longest suffix.
	(Check_Configuration): Do not issue an error if there is no compiler
	for a language. Just issue a warning and ignore the sources for the
	language.
	(Check_Library_Attributes): Only check Library_Dir if Library_Name is
	not empty.
	(Check_Naming_Schemes.Maked_Unit): Only output message if high verbosity
	(Unit_Exceptions): New hash table
	(Check_Naming_Schemes): Check if a file that could be a unit because of
	the naming scheme is not in fact a source because there is an exception
	for the unit.
	(Look_For_Sources): Put the unit exceptions in hash table
	Unit_Exceptions
	(Get_Unit_Exceptions): Give initial value No_Source to local variable
	Other_Part to avoid exception when code is compiled with validity
	checking.
	(Get_Sources_From_File): Check that there is no directory information
	in the file names.
	(Look_For_Sources): Check that there is no directory information in the
	list of file names in Source_Files.
	(Look_For_Sources): In multi-language mode, do not allow exception file
	names that are excluded.
	(Excluded_Sources_Htable): New hash table
	(Search_Directories.Check_File): New procedure to simplify
	Search_Directories.
	(Search_Directories): Do not consider excluded sources
	(Look_For_Sources): Populate Excluded_Sources_Htable before calling
	Search_Directories.
	(Get_Exceptions): Set component Lang_Kind of Source_Data
	(Get_Unit_Exceptions): Ditto
	(Search_Directories): Ditto

	* prj-pars.adb: new parameter Current_Dir

	* prj-part.ads, prj-part.adb: 
	Change Opt.Follow_Links to Opt.Follow_Links_For_Files.
	(Opt.Follow_Links_For_Dirs): New flag
	(Project_Path_Name_Of): Cache information returned by this routine as
	Locate_Regular_File is a costly routine. The code to output a log
	information and the effective call to Locate_Regular_File is now
	factorized into a routine (code clean-up).
	(Parse, Parse_Single_Project): new parameter Current_Dir
	When main project file cannot be found, indicate in the error
	message the project path that was used to do the search.

	* prj-proc.ads, prj-proc.adb (Opt.Follow_Links_For_Dirs): New flag
	(Prj.Proc.Process*): new parameter Current_Dir

	* switch-m.adb: Change Opt.Follow_Links to Opt.Follow_Links_For_Files



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@130846 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 126 insertions, 84 deletions

diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb
index f576841148f..3c46138d60d 100644
--- a/gcc/ada/prj-part.adb
+++ b/gcc/ada/prj-part.adb
@@ -39,8 +39,6 @@ with Table;
 with Ada.Characters.Handling;    use Ada.Characters.Handling;
 with Ada.Exceptions;             use Ada.Exceptions;
 
-with GNAT.Directory_Operations;  use GNAT.Directory_Operations;
-
 with System.HTable;              use System.HTable;
 
 package body Prj.Part is
@@ -48,7 +46,7 @@ package body Prj.Part is
    Buffer      : String_Access;
    Buffer_Last : Natural := 0;
 
-   Dir_Sep  : Character renames GNAT.OS_Lib.Directory_Separator;
+   Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator;
 
    ------------------------------------
    -- Local Packages and Subprograms --
@@ -116,6 +114,15 @@ package body Prj.Part is
    --  need to have a virtual extending project, to avoid processing the same
    --  project twice.
 
+   package Projects_Paths is new System.HTable.Simple_HTable
+     (Header_Num => Header_Num,
+      Element    => Path_Name_Type,
+      No_Element => No_Path,
+      Key        => Name_Id,
+      Hash       => Hash,
+      Equal      => "=");
+   --  Hash table to cache project path to avoid looking for them on the path
+
    procedure Create_Virtual_Extending_Project
      (For_Project  : Project_Node_Id;
       Main_Project : Project_Node_Id;
@@ -153,7 +160,8 @@ package body Prj.Part is
       From_Extended     : Extension_Origin;
       In_Limited        : Boolean;
       Packages_To_Check : String_List_Access;
-      Depth             : Natural);
+      Depth             : Natural;
+      Current_Dir       : String);
    --  Parse the imported projects that have been stored in table Withs,
    --  if any. From_Extended is used for the call to Parse_Single_Project
    --  below. When In_Limited is True, the importing path includes at least
@@ -327,8 +335,7 @@ package body Prj.Part is
    ----------------------------
 
    function Immediate_Directory_Of
-     (Path_Name : Path_Name_Type)
-      return Path_Name_Type
+     (Path_Name : Path_Name_Type) return Path_Name_Type
    is
    begin
       Get_Name_String (Path_Name);
@@ -366,7 +373,6 @@ package body Prj.Part is
      (Proj                : Project_Node_Id;
       In_Tree             : Project_Node_Tree_Ref;
       Potentially_Virtual : Boolean)
-
    is
       Declaration : Project_Node_Id := Empty_Node;
       --  Node for the project declaration of Proj
@@ -436,10 +442,9 @@ package body Prj.Part is
       Project_File_Name      : String;
       Always_Errout_Finalize : Boolean;
       Packages_To_Check      : String_List_Access := All_Packages;
-      Store_Comments         : Boolean := False)
+      Store_Comments         : Boolean := False;
+      Current_Directory      : String := "")
    is
-      Current_Directory : constant String := Get_Current_Dir;
-
       Dummy : Boolean;
       pragma Warnings (Off, Dummy);
 
@@ -454,6 +459,8 @@ package body Prj.Part is
 
       Project := Empty_Node;
 
+      Projects_Paths.Reset;
+
       if Current_Verbosity >= Medium then
          Write_Str ("GPR_PROJECT_PATH=""");
          Write_Str (Project_Path);
@@ -476,7 +483,9 @@ package body Prj.Part is
 
          if Path_Name = "" then
             Prj.Com.Fail
-              ("project file """, Project_File_Name, """ not found");
+              ("project file """,
+               Project_File_Name,
+               """ not found in " & Project_Path);
             Project := Empty_Node;
             return;
          end if;
@@ -490,7 +499,8 @@ package body Prj.Part is
             From_Extended     => None,
             In_Limited        => False,
             Packages_To_Check => Packages_To_Check,
-            Depth             => 0);
+            Depth             => 0,
+            Current_Dir       => Current_Directory);
 
          --  If Project is an extending-all project, create the eventual
          --  virtual extending projects and check that there are no illegally
@@ -601,12 +611,10 @@ package body Prj.Part is
      (In_Tree        : Project_Node_Tree_Ref;
       Context_Clause : out With_Id)
    is
-      Current_With_Clause    : With_Id := No_With;
-      Limited_With           : Boolean         := False;
-
-      Current_With : With_Record;
-
-      Current_With_Node : Project_Node_Id := Empty_Node;
+      Current_With_Clause : With_Id := No_With;
+      Limited_With        : Boolean := False;
+      Current_With        : With_Record;
+      Current_With_Node   : Project_Node_Id := Empty_Node;
 
    begin
       --  Assume no context clause
@@ -704,7 +712,8 @@ package body Prj.Part is
       From_Extended     : Extension_Origin;
       In_Limited        : Boolean;
       Packages_To_Check : String_List_Access;
-      Depth             : Natural)
+      Depth             : Natural;
+      Current_Dir       : String)
    is
       Current_With_Clause : With_Id := Context_Clause;
 
@@ -739,7 +748,8 @@ package body Prj.Part is
             Resolved_Path : constant String :=
                               Normalize_Pathname
                                 (Imported_Path_Name,
-                                 Resolve_Links => True,
+                                 Directory     => Current_Dir,
+                                 Resolve_Links => Opt.Follow_Links_For_Files,
                                  Case_Sensitive => True);
 
             Withed_Project : Project_Node_Id := Empty_Node;
@@ -828,7 +838,8 @@ package body Prj.Part is
                      From_Extended     => From_Extended,
                      In_Limited        => Limited_With,
                      Packages_To_Check => Packages_To_Check,
-                     Depth             => Depth);
+                     Depth             => Depth,
+                     Current_Dir       => Current_Dir);
 
                else
                   Extends_All := Is_Extending_All (Withed_Project, In_Tree);
@@ -887,7 +898,8 @@ package body Prj.Part is
       From_Extended     : Extension_Origin;
       In_Limited        : Boolean;
       Packages_To_Check : String_List_Access;
-      Depth             : Natural)
+      Depth             : Natural;
+      Current_Dir       : String)
    is
       Normed_Path_Name    : Path_Name_Type;
       Canonical_Path_Name : Path_Name_Type;
@@ -918,11 +930,15 @@ package body Prj.Part is
 
       declare
          Normed_Path    : constant String := Normalize_Pathname
-                            (Path_Name, Resolve_Links => False,
-                             Case_Sensitive           => True);
+                            (Path_Name,
+                             Directory      => Current_Dir,
+                             Resolve_Links  => False,
+                             Case_Sensitive => True);
          Canonical_Path : constant String := Normalize_Pathname
-                            (Normed_Path, Resolve_Links => True,
-                             Case_Sensitive             => False);
+                            (Normed_Path,
+                             Directory      => Current_Dir,
+                             Resolve_Links  => Opt.Follow_Links_For_Files,
+                             Case_Sensitive => False);
 
       begin
          Name_Len := Normed_Path'Length;
@@ -1224,16 +1240,17 @@ package body Prj.Part is
                From_Extended     => From_Ext,
                In_Limited        => In_Limited,
                Packages_To_Check => Packages_To_Check,
-               Depth             => Depth + 1);
+               Depth             => Depth + 1,
+               Current_Dir       => Current_Dir);
             Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
          end;
 
          if not In_Configuration then
             declare
                Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
-                 Tree_Private_Part.Projects_Htable.Get_First
-                   (In_Tree.Projects_HT);
-               Project_Name : Name_Id := Name_And_Node.Name;
+                                 Tree_Private_Part.Projects_Htable.Get_First
+                                   (In_Tree.Projects_HT);
+               Project_Name  : Name_Id := Name_And_Node.Name;
 
             begin
                --  Check if we already have a project with this name
@@ -1340,7 +1357,8 @@ package body Prj.Part is
                         From_Extended     => From_Ext,
                         In_Limited        => In_Limited,
                         Packages_To_Check => Packages_To_Check,
-                        Depth             => Depth + 1);
+                        Depth             => Depth + 1,
+                        Current_Dir       => Current_Dir);
                   end;
 
                   --  A project that extends an extending-all project is also
@@ -1561,9 +1579,9 @@ package body Prj.Part is
 
    function Project_Name_From (Path_Name : String) return Name_Id is
       Canonical : String (1 .. Path_Name'Length) := Path_Name;
-      First : Natural := Canonical'Last;
-      Last  : Natural := First;
-      Index : Positive;
+      First     : Natural := Canonical'Last;
+      Last      : Natural := First;
+      Index     : Positive;
 
    begin
       if Current_Verbosity = High then
@@ -1694,7 +1712,35 @@ package body Prj.Part is
      (Project_File_Name : String;
       Directory         : String) return String
    is
-      Result : String_Access;
+
+      function Try_Path_Name (Path : String) return String_Access;
+      pragma Inline (Try_Path_Name);
+      --  Try the specified Path
+
+      -------------------
+      -- Try_Path_Name --
+      -------------------
+
+      function Try_Path_Name (Path : String) return String_Access is
+      begin
+         if Current_Verbosity = High then
+            Write_Str  ("   Trying ");
+            Write_Str  (Path);
+         end if;
+
+         return Locate_Regular_File
+           (File_Name => Path,
+            Path      => Project_Path);
+      end Try_Path_Name;
+
+      --  Local Declarations
+
+      Result    : String_Access;
+      Result_Id : Path_Name_Type;
+      Has_Dot   : Boolean := False;
+      Key       : Name_Id;
+
+   --  Start of processing for Project_Path_Name_Of
 
    begin
       if Current_Verbosity = High then
@@ -1705,70 +1751,60 @@ package body Prj.Part is
          Write_Line (""");");
       end if;
 
-      if not Is_Absolute_Path (Project_File_Name) then
-         --  First we try <directory>/<file_name>.<extension>
+      --  Check the project cache
 
-         if Current_Verbosity = High then
-            Write_Str  ("   Trying ");
-            Write_Str  (Directory);
-            Write_Char (Directory_Separator);
-            Write_Str (Project_File_Name);
-            Write_Line (Project_File_Extension);
-         end if;
+      Name_Len := Project_File_Name'Length;
+      Name_Buffer (1 .. Name_Len) := Project_File_Name;
+      Key := Name_Find;
+      Result_Id := Projects_Paths.Get (Key);
 
-         Result :=
-           Locate_Regular_File
-           (File_Name => Directory & Directory_Separator &
-              Project_File_Name & Project_File_Extension,
-            Path      => Project_Path);
+      if Result_Id /= No_Path then
+         return Get_Name_String (Result_Id);
+      end if;
 
-         --  Then we try <directory>/<file_name>
+      --  Check if Project_File_Name contains an extension (a dot before a
+      --  directory separator). If it is the case we do not try project file
+      --  with an added extension as it is not possible to have multiple dots
+      --  on a project file name.
 
-         if Result = null then
-            if Current_Verbosity = High then
-               Write_Str  ("   Trying ");
-               Write_Str  (Directory);
-               Write_Char (Directory_Separator);
-               Write_Line (Project_File_Name);
-            end if;
-
-            Result :=
-              Locate_Regular_File
-              (File_Name => Directory & Directory_Separator &
-                 Project_File_Name,
-               Path      => Project_Path);
+      Check_Dot : for K in reverse Project_File_Name'Range loop
+         if Project_File_Name (K) = '.' then
+            Has_Dot := True;
+            exit Check_Dot;
          end if;
-      end if;
 
-      if Result = null then
+         exit Check_Dot when Project_File_Name (K) = Directory_Separator
+           or else Project_File_Name (K) = '/';
+      end loop Check_Dot;
 
-         --  Then we try <file_name>.<extension>
+      if not Is_Absolute_Path (Project_File_Name) then
 
-         if Current_Verbosity = High then
-            Write_Str  ("   Trying ");
-            Write_Str (Project_File_Name);
-            Write_Line (Project_File_Extension);
+         --  First we try <directory>/<file_name>.<extension>
+
+         if not Has_Dot then
+            Result := Try_Path_Name
+              (Directory & Directory_Separator &
+               Project_File_Name & Project_File_Extension);
          end if;
 
-         Result :=
-           Locate_Regular_File
-           (File_Name => Project_File_Name & Project_File_Extension,
-            Path      => Project_Path);
+         --  Then we try <directory>/<file_name>
+
+         if Result = null then
+            Result := Try_Path_Name
+              (Directory & Directory_Separator & Project_File_Name);
+         end if;
       end if;
 
-      if Result = null then
+      --  Then we try <file_name>.<extension>
 
-         --  Then we try <file_name>
+      if Result = null and then not Has_Dot then
+         Result := Try_Path_Name (Project_File_Name & Project_File_Extension);
+      end if;
 
-         if Current_Verbosity = High then
-            Write_Str  ("   Trying ");
-            Write_Line  (Project_File_Name);
-         end if;
+      --  Then we try <file_name>
 
-         Result :=
-           Locate_Regular_File
-           (File_Name => Project_File_Name,
-            Path      => Project_Path);
+      if Result = null then
+         Result := Try_Path_Name (Project_File_Name);
       end if;
 
       --  If we cannot find the project file, we return an empty string
@@ -1781,10 +1817,16 @@ package body Prj.Part is
             Final_Result : constant String :=
                              GNAT.OS_Lib.Normalize_Pathname
                                (Result.all,
+                                Directory      => Directory,
                                 Resolve_Links  => False,
                                 Case_Sensitive => True);
          begin
             Free (Result);
+            Name_Len := Final_Result'Length;
+            Name_Buffer (1 .. Name_Len) := Final_Result;
+            Result_Id := Name_Find;
+
+            Projects_Paths.Set (Key, Result_Id);
             return Final_Result;
          end;
       end if;