[Ada] No symbolics resolved in path name of project files

Arnaud Charlet charlet@adacore.com
Tue May 27 12:04:00 GMT 2008


When there are many symbolic links for directories, there were cases when
some of these symbolic links were resolved when getting the path name of
a project file. This patch ensures that it is not the case.

Tested on i686-pc-linux-gnu, committed on trunk

2008-05-27  Vincent Celier  <celier@adacore.com>

	* prj-part.adb:
	(Project_Path_Name_Of.Try_Path): Do not use Locate_Regular_File to find
	a project file, so that symbolic links are not resolved.

-------------- next part --------------
Index: prj-part.adb
===================================================================
--- prj-part.adb	(revision 135912)
+++ prj-part.adb	(working copy)
@@ -39,6 +39,8 @@ 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
@@ -1864,15 +1866,64 @@ package body Prj.Part is
       -------------------
 
       function Try_Path_Name (Path : String) return String_Access is
+         Prj_Path : constant String := Project_Path;
+         First    : Natural := Prj_Path'First;
+         Last     : Natural;
+         Result   : String_Access := null;
+
       begin
          if Current_Verbosity = High then
             Write_Str  ("   Trying ");
             Write_Line (Path);
          end if;
 
-         return Locate_Regular_File
-           (File_Name => Path,
-            Path      => Project_Path);
+         if Is_Absolute_Path (Path) then
+            if Is_Regular_File (Path) then
+               Result := new String'(Path);
+            end if;
+
+         else
+            --  Because we don't want to resolve symbolic links, we cannot use
+            --  Locate_Regular_File. So, we try each possible path
+            --  successively.
+
+            while First <= Prj_Path'Last loop
+               while First <= Prj_Path'Last
+                 and then Prj_Path (First) = Path_Separator
+               loop
+                  First := First + 1;
+               end loop;
+
+               exit when First > Prj_Path'Last;
+
+               Last := First;
+               while Last < Prj_Path'Last
+                 and then Prj_Path (Last + 1) /= Path_Separator
+               loop
+                  Last := Last + 1;
+               end loop;
+
+               Name_Len := 0;
+
+               if not Is_Absolute_Path (Prj_Path (First .. Last)) then
+                  Add_Str_To_Name_Buffer (Get_Current_Dir);
+                  Add_Char_To_Name_Buffer (Directory_Separator);
+               end if;
+
+               Add_Str_To_Name_Buffer (Prj_Path (First .. Last));
+               Add_Char_To_Name_Buffer (Directory_Separator);
+               Add_Str_To_Name_Buffer (Path);
+
+               if Is_Regular_File (Name_Buffer (1 .. Name_Len)) then
+                  Result := new String'(Name_Buffer (1 .. Name_Len));
+                  exit;
+               end if;
+
+               First := Last + 1;
+            end loop;
+         end if;
+
+         return Result;
       end Try_Path_Name;
 
       --  Local Declarations


More information about the Gcc-patches mailing list