[Ada] New directories in project path for gnatls --RTS=
Arnaud Charlet
charlet@adacore.com
Tue Jan 6 08:58:00 GMT 2015
Two new directories are added in the project path, when gnatls is invoked
with --RTS=, just before the two directories for the target.
When the runtime is a single name, the directories are:
<prefix>/<target>/<runtime>/lib/gnat
<prefix>/<target>/<runtime>/share/gpr
Otherwise, the runtime directory is either an absolute path or a path
relative to the current working directory and the two added directories
are:
<runtime_directory>/lib/gnat
<runtime_directory>/share/gpr
Tested on x86_64-pc-linux-gnu, committed on trunk
2015-01-06 Vincent Celier <celier@adacore.com>
* gnatls.adb (Search_RTS): Invoke Initialize_Default_Project_Path
with the runtime name.
* prj-env.adb (Initialize_Default_Project_Path): When both
Target_Name and Runtime_Name are not empty string, add to the
project path the two directories .../lib/gnat and .../share/gpr
related to the runtime.
* prj-env.ads (Initialize_Default_Project_Path): New String
parameter Runtime_Name, defaulted to the empty string.
-------------- next part --------------
Index: gnatls.adb
===================================================================
--- gnatls.adb (revision 219191)
+++ gnatls.adb (working copy)
@@ -1225,6 +1225,10 @@
if Src_Path /= null and then Lib_Path /= null then
Add_Search_Dirs (Src_Path, Include);
Add_Search_Dirs (Lib_Path, Objects);
+ Initialize_Default_Project_Path
+ (Prj_Path,
+ Target_Name => Sdefault.Target_Name.all,
+ Runtime_Name => Name);
return;
end if;
@@ -1237,7 +1241,9 @@
-- Try to find the RTS on the project path. First setup the project path
Initialize_Default_Project_Path
- (Prj_Path, Target_Name => Sdefault.Target_Name.all);
+ (Prj_Path,
+ Target_Name => Sdefault.Target_Name.all,
+ Runtime_Name => Name);
Rts_Full_Path := Get_Runtime_Path (Prj_Path, Name);
Index: prj-env.adb
===================================================================
--- prj-env.adb (revision 219191)
+++ prj-env.adb (working copy)
@@ -1873,8 +1873,9 @@
-------------------------------------
procedure Initialize_Default_Project_Path
- (Self : in out Project_Search_Path;
- Target_Name : String)
+ (Self : in out Project_Search_Path;
+ Target_Name : String;
+ Runtime_Name : String := "")
is
Add_Default_Dir : Boolean := Target_Name /= "-";
First : Positive;
@@ -1894,6 +1895,24 @@
-- The path name(s) of directories where project files may reside.
-- May be empty.
+ Prefix : String_Ptr;
+ Runtime : String_Ptr;
+
+ procedure Add_Target;
+
+ procedure Add_Target is
+ begin
+ Add_Str_To_Name_Buffer
+ (Path_Separator & Prefix.all & Target_Name);
+
+ -- Note: Target_Name has a trailing / when it comes from
+ -- Sdefault.
+
+ if Name_Buffer (Name_Len) /= '/' then
+ Add_Char_To_Name_Buffer (Directory_Separator);
+ end if;
+ end Add_Target;
+
begin
if Is_Initialized (Self) then
return;
@@ -2051,73 +2070,81 @@
-- Set the initial value of Current_Project_Path
if Add_Default_Dir then
- declare
- Prefix : String_Ptr;
+ if Sdefault.Search_Dir_Prefix = null then
- begin
- if Sdefault.Search_Dir_Prefix = null then
+ -- gprbuild case
- -- gprbuild case
+ Prefix := new String'(Executable_Prefix_Path);
- Prefix := new String'(Executable_Prefix_Path);
+ else
+ Prefix := new String'(Sdefault.Search_Dir_Prefix.all
+ & ".." & Dir_Separator
+ & ".." & Dir_Separator
+ & ".." & Dir_Separator
+ & ".." & Dir_Separator);
+ end if;
- else
- Prefix := new String'(Sdefault.Search_Dir_Prefix.all
- & ".." & Dir_Separator
- & ".." & Dir_Separator
- & ".." & Dir_Separator
- & ".." & Dir_Separator);
- end if;
+ if Prefix.all /= "" then
+ if Target_Name /= "" then
- if Prefix.all /= "" then
- if Target_Name /= "" then
+ if Runtime_Name /= "" then
+ if Base_Name (Runtime_Name) = Runtime_Name then
- -- $prefix/$target/lib/gnat
+ -- $prefix/$target/$runtime/lib/gnat
+ Add_Target;
+ Add_Str_To_Name_Buffer
+ (Runtime_Name & Directory_Separator &
+ "lib" & Directory_Separator & "gnat");
- Add_Str_To_Name_Buffer
- (Path_Separator & Prefix.all & Target_Name);
+ -- $prefix/$target/$runtime/share/gpr
+ Add_Target;
+ Add_Str_To_Name_Buffer
+ (Runtime_Name & Directory_Separator &
+ "share" & Directory_Separator & "gpr");
- -- Note: Target_Name has a trailing / when it comes from
- -- Sdefault.
+ else
+ Runtime :=
+ new String'(Normalize_Pathname (Runtime_Name));
- if Name_Buffer (Name_Len) /= '/' then
- Add_Char_To_Name_Buffer (Directory_Separator);
- end if;
+ -- $runtime_dir/lib/gnat
+ Add_Str_To_Name_Buffer
+ (Path_Separator & Runtime.all & Directory_Separator &
+ "lib" & Directory_Separator & "gnat");
- Add_Str_To_Name_Buffer
- ("lib" & Directory_Separator & "gnat");
-
- -- $prefix/$target/share/gpr
-
- Add_Str_To_Name_Buffer
- (Path_Separator & Prefix.all & Target_Name);
-
- -- Note: Target_Name has a trailing / when it comes from
- -- Sdefault.
-
- if Name_Buffer (Name_Len) /= '/' then
- Add_Char_To_Name_Buffer (Directory_Separator);
+ -- $runtime_dir/share/gpr
+ Add_Str_To_Name_Buffer
+ (Path_Separator & Runtime.all & Directory_Separator &
+ "share" & Directory_Separator & "gpr");
end if;
-
- Add_Str_To_Name_Buffer
- ("share" & Directory_Separator & "gpr");
end if;
- -- $prefix/share/gpr
+ -- $prefix/$target/lib/gnat
+ Add_Target;
Add_Str_To_Name_Buffer
- (Path_Separator & Prefix.all & "share"
- & Directory_Separator & "gpr");
+ ("lib" & Directory_Separator & "gnat");
- -- $prefix/lib/gnat
+ -- $prefix/$target/share/gpr
+ Add_Target;
Add_Str_To_Name_Buffer
- (Path_Separator & Prefix.all & "lib"
- & Directory_Separator & "gnat");
+ ("share" & Directory_Separator & "gpr");
end if;
- Free (Prefix);
- end;
+ -- $prefix/share/gpr
+
+ Add_Str_To_Name_Buffer
+ (Path_Separator & Prefix.all & "share"
+ & Directory_Separator & "gpr");
+
+ -- $prefix/lib/gnat
+
+ Add_Str_To_Name_Buffer
+ (Path_Separator & Prefix.all & "lib"
+ & Directory_Separator & "gnat");
+ end if;
+
+ Free (Prefix);
end if;
Self.Path := new String'(Name_Buffer (1 .. Name_Len));
Index: prj-env.ads
===================================================================
--- prj-env.ads (revision 219191)
+++ prj-env.ads (working copy)
@@ -171,14 +171,16 @@
No_Project_Search_Path : constant Project_Search_Path;
procedure Initialize_Default_Project_Path
- (Self : in out Project_Search_Path;
- Target_Name : String);
- -- Initialize Self. It will then contain the default project path on the
- -- given target (including directories specified by the environment
- -- variables GPR_PROJECT_PATH_FILE, GPR_PROJECT_PATH and ADA_PROJECT_PATH).
- -- If one of the directory or Target_Name is "-", then the path contains
- -- only those directories specified by the environment variables (except
- -- "-"). This does nothing if Self has already been initialized.
+ (Self : in out Project_Search_Path;
+ Target_Name : String;
+ Runtime_Name : String := "");
+ -- Initialize Self. It will then contain the default project path on
+ -- the given target and runtime (including directories specified by the
+ -- environment variables GPR_PROJECT_PATH_FILE, GPR_PROJECT_PATH and
+ -- ADA_PROJECT_PATH). If one of the directory or Target_Name is "-", then
+ -- the path contains only those directories specified by the environment
+ -- variables (except "-"). This does nothing if Self has already been
+ -- initialized.
procedure Copy (From : Project_Search_Path; To : out Project_Search_Path);
-- Copy From into To
More information about the Gcc-patches
mailing list