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 <cel...@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.
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