When binding a Stand-Alone library that is extending another Stand-Alone
library, ALI files that are not interfaces of the SAL project may not
be found, because the object path was incorrectly set.
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-08-29 Vincent Celier <cel...@adacore.com>
* makeutl.adb (Get_Directories): New procedure moved from Buildgpr and
modified to compute correctly the object path of a SAL project that is
extending another library project.
(Write_Path_File): New procedure.
* makeutl.ads (Directories): New table moved from Buildgpr
(Get_Directories): New procedure moved from Buildgpr
(Write_Path_File): New procedure
* mlib-prj.adb (Build_Library): Use Makeutl.Get_Directories to set the
paths before binding SALs, instead of Set_Ada_Paths.
* prj-env.adb (Set_Path_File_Var): Procedure has been moved to package
Prj.
* prj.adb (Set_Path_File_Var): New procedure moved from Prj.Env
(Current_Source_Path_File_Of): New function
(Set_Current_Object_Path_File_Of): New procedure
(Current_Source_Object_File_Of): New function
(Set_Current_Object_Path_File_Of): New procedure
* prj.ads (Set_Path_File_Var): New procedure moved from Prj.Env
(Current_Source_Path_File_Of): New function
(Set_Current_Object_Path_File_Of): New procedure
(Current_Source_Object_File_Of): New function
(Set_Current_Object_Path_File_Of): New procedure
Index: mlib-prj.adb
===================================================================
--- mlib-prj.adb (revision 178155)
+++ mlib-prj.adb (working copy)
@@ -25,6 +25,7 @@
with ALI; use ALI;
with Gnatvsn; use Gnatvsn;
+with Makeutl; use Makeutl;
with MLib.Fil; use MLib.Fil;
with MLib.Tgt; use MLib.Tgt;
with MLib.Utl; use MLib.Utl;
@@ -802,6 +803,9 @@
end loop;
end Process_Imported_Libraries;
+ Path_FD : File_Descriptor := Invalid_FD;
+ -- Used for setting the source and object paths
+
-- Start of processing for Build_Library
begin
@@ -1044,11 +1048,57 @@
-- Set the paths
- Set_Ada_Paths
- (Project => For_Project,
- In_Tree => In_Tree,
- Including_Libraries => True);
+ -- First the source path
+ if For_Project.Include_Path_File = No_Path then
+ Get_Directories
+ (Project_Tree => In_Tree,
+ For_Project => For_Project,
+ Activity => Compilation,
+ Languages => Ada_Only);
+
+ Create_New_Path_File
+ (In_Tree.Shared, Path_FD, For_Project.Include_Path_File);
+
+ Write_Path_File (Path_FD);
+ Path_FD := Invalid_FD;
+
+ end if;
+
+ if Current_Source_Path_File_Of (In_Tree.Shared) /=
+ For_Project.Include_Path_File
+ then
+ Set_Current_Source_Path_File_Of
+ (In_Tree.Shared,
+ For_Project.Include_Path_File);
+ Set_Path_File_Var
+ (Project_Include_Path_File,
+ Get_Name_String (For_Project.Include_Path_File));
+ end if;
+
+ -- Then, the object path
+
+ Get_Directories
+ (Project_Tree => In_Tree,
+ For_Project => For_Project,
+ Activity => SAL_Binding,
+ Languages => Ada_Only);
+
+ declare
+ Path_File_Name : Path_Name_Type;
+ begin
+ Create_New_Path_File (In_Tree.Shared, Path_FD, Path_File_Name);
+
+ Write_Path_File (Path_FD);
+ Path_FD := Invalid_FD;
+
+ Set_Path_File_Var
+ (Project_Objects_Path_File,
+ Get_Name_String (Path_File_Name));
+ Set_Current_Source_Path_File_Of
+ (In_Tree.Shared, Path_File_Name);
+ end;
+
-- Display the gnatbind command, if not in quiet output
Display (Gnatbind);
Index: prj.adb
===================================================================
--- prj.adb (revision 178155)
+++ prj.adb (working copy)
@@ -27,6 +27,7 @@
with Osint; use Osint;
with Output; use Output;
with Prj.Attr;
+with Prj.Com;
with Prj.Err; use Prj.Err;
with Snames; use Snames;
with Uintp; use Uintp;
@@ -113,6 +114,28 @@
Last := Last + S'Length;
end Add_To_Buffer;
+ ---------------------------------
+ -- Current_Object_Path_File_Of --
+ ---------------------------------
+
+ function Current_Object_Path_File_Of
+ (Shared : Shared_Project_Tree_Data_Access)
+ return Path_Name_Type is
+ begin
+ return Shared.Private_Part.Current_Object_Path_File;
+ end Current_Object_Path_File_Of;
+
+ ---------------------------------
+ -- Current_Source_Path_File_Of --
+ ---------------------------------
+
+ function Current_Source_Path_File_Of
+ (Shared : Shared_Project_Tree_Data_Access)
+ return Path_Name_Type is
+ begin
+ return Shared.Private_Part.Current_Source_Path_File;
+ end Current_Source_Path_File_Of;
+
---------------------------
-- Delete_Temporary_File --
---------------------------
@@ -1029,6 +1052,46 @@
Free_Units (Tree.Units_HT);
end Reset;
+ -------------------------------------
+ -- Set_Current_Object_Path_File_Of --
+ -------------------------------------
+
+ procedure Set_Current_Object_Path_File_Of
+ (Shared : Shared_Project_Tree_Data_Access;
+ To : Path_Name_Type)
+ is
+ begin
+ Shared.Private_Part.Current_Object_Path_File := To;
+ end Set_Current_Object_Path_File_Of;
+
+ -------------------------------------
+ -- Set_Current_Source_Path_File_Of --
+ -------------------------------------
+
+ procedure Set_Current_Source_Path_File_Of
+ (Shared : Shared_Project_Tree_Data_Access;
+ To : Path_Name_Type)
+ is
+ begin
+ Shared.Private_Part.Current_Source_Path_File := To;
+ end Set_Current_Source_Path_File_Of;
+
+ -----------------------
+ -- Set_Path_File_Var --
+ -----------------------
+
+ procedure Set_Path_File_Var (Name : String; Value : String) is
+ Host_Spec : String_Access := To_Host_File_Spec (Value);
+ begin
+ if Host_Spec = null then
+ Prj.Com.Fail
+ ("could not convert file name """ & Value & """ to host spec");
+ else
+ Setenv (Name, Host_Spec.all);
+ Free (Host_Spec);
+ end if;
+ end Set_Path_File_Var;
+
-------------------
-- Switches_Name --
-------------------
Index: prj.ads
===================================================================
--- prj.ads (revision 178156)
+++ prj.ads (working copy)
@@ -1595,6 +1595,29 @@
(Source_File_Name : File_Name_Type) return File_Name_Type;
-- Returns the switches file name corresponding to a source file name
+ procedure Set_Path_File_Var (Name : String; Value : String);
+ -- Call Setenv, after calling To_Host_File_Spec
+
+ function Current_Source_Path_File_Of
+ (Shared : Shared_Project_Tree_Data_Access)
+ return Path_Name_Type;
+ -- Get the current include path file name
+
+ procedure Set_Current_Source_Path_File_Of
+ (Shared : Shared_Project_Tree_Data_Access;
+ To : Path_Name_Type);
+ -- Record the current include path file name
+
+ function Current_Object_Path_File_Of
+ (Shared : Shared_Project_Tree_Data_Access)
+ return Path_Name_Type;
+ -- Get the current object path file name
+
+ procedure Set_Current_Object_Path_File_Of
+ (Shared : Shared_Project_Tree_Data_Access;
+ To : Path_Name_Type);
+ -- Record the current object path file name
+
-----------
-- Flags --
-----------
@@ -1676,7 +1699,7 @@
-- resolved will simply be ignored. However, in such a case, the flag
-- Incomplete_With in the project tree will be set to True.
-- This is meant for use by tools so that they can properly set the
- -- project path in such a case:
+ -- project path in such a case:Shared_
-- * no "gnatls" found (so no default project path)
-- * user project sets Project.IDE'gnatls attribute to a cross gnatls
-- * user project also includes a "with" that can only be resolved
Index: makeutl.adb
===================================================================
--- makeutl.adb (revision 178155)
+++ makeutl.adb (working copy)
@@ -32,12 +32,11 @@
with Osint; use Osint;
with Output; use Output;
with Opt; use Opt;
+with Prj.Com;
with Prj.Err;
with Prj.Ext;
with Prj.Util; use Prj.Util;
with Sinput.P;
-with Snames; use Snames;
-with Table;
with Tempdir;
with Ada.Command_Line; use Ada.Command_Line;
@@ -681,6 +680,118 @@
return False;
end File_Not_A_Source_Of;
+ ---------------------
+ -- Get_Directories --
+ ---------------------
+
+ procedure Get_Directories
+ (Project_Tree : Project_Tree_Ref;
+ For_Project : Project_Id;
+ Activity : Activity_Type;
+ Languages : Name_Ids)
+ is
+
+ procedure Recursive_Add
+ (Project : Project_Id;
+ Tree : Project_Tree_Ref;
+ Extended : in out Boolean);
+ -- Add all the source directories of a project to the path only if
+ -- this project has not been visited. Calls itself recursively for
+ -- projects being extended, and imported projects.
+
+ procedure Add_Dir (Value : Path_Name_Type);
+ -- Add directory Value in table Directories, if it is defined and not
+ -- already there.
+
+ -------------
+ -- Add_Dir --
+ -------------
+
+ procedure Add_Dir (Value : Path_Name_Type) is
+ Add_It : Boolean := True;
+
+ begin
+ if Value /= No_Path then
+ for Index in 1 .. Directories.Last loop
+ if Directories.Table (Index) = Value then
+ Add_It := False;
+ exit;
+ end if;
+ end loop;
+
+ if Add_It then
+ Directories.Increment_Last;
+ Directories.Table (Directories.Last) := Value;
+ end if;
+ end if;
+ end Add_Dir;
+
+ -------------------
+ -- Recursive_Add --
+ -------------------
+
+ procedure Recursive_Add
+ (Project : Project_Id;
+ Tree : Project_Tree_Ref;
+ Extended : in out Boolean)
+ is
+ Current : String_List_Id;
+ Dir : String_Element;
+ OK : Boolean := False;
+ Lang_Proc : Language_Ptr := Project.Languages;
+ begin
+ -- Add to path all directories of this project
+
+ if Activity = Compilation then
+ Lang_Loop :
+ while Lang_Proc /= No_Language_Index loop
+ for J in Languages'Range loop
+ OK := Lang_Proc.Name = Languages (J);
+ exit Lang_Loop when OK;
+ end loop;
+
+ Lang_Proc := Lang_Proc.Next;
+ end loop Lang_Loop;
+
+ if OK then
+ Current := Project.Source_Dirs;
+
+ while Current /= Nil_String loop
+ Dir := Tree.Shared.String_Elements.Table (Current);
+ Add_Dir (Path_Name_Type (Dir.Value));
+ Current := Dir.Next;
+ end loop;
+ end if;
+
+ elsif Project.Library then
+ if Activity = SAL_Binding and then Extended then
+ Add_Dir (Project.Object_Directory.Display_Name);
+
+ else
+ Add_Dir (Project.Library_ALI_Dir.Display_Name);
+ end if;
+
+ else
+ Add_Dir (Project.Object_Directory.Display_Name);
+ end if;
+
+ if Project.Extends = No_Project then
+ Extended := False;
+ end if;
+ end Recursive_Add;
+
+ procedure For_All_Projects is
+ new For_Every_Project_Imported (Boolean, Recursive_Add);
+
+ Extended : Boolean := True;
+
+ -- Start of processing for Get_Directories
+
+ begin
+ Directories.Init;
+ For_All_Projects (For_Project, Project_Tree, Extended);
+ end Get_Directories;
+
------------------
-- Get_Switches --
------------------
@@ -3208,4 +3319,33 @@
end if;
end Compute_Builder_Switches;
+ ---------------------
+ -- Write_Path_File --
+ ---------------------
+
+ procedure Write_Path_File (FD : File_Descriptor) is
+ Last : Natural;
+ Status : Boolean;
+ begin
+ Name_Len := 0;
+
+ for Index in Directories.First .. Directories.Last loop
+ Add_Str_To_Name_Buffer (Get_Name_String (Directories.Table (Index)));
+ Add_Char_To_Name_Buffer (ASCII.LF);
+ end loop;
+
+ Last := Write (FD, Name_Buffer (1)'Address, Name_Len);
+
+ if Last = Name_Len then
+ Close (FD, Status);
+
+ else
+ Status := False;
+ end if;
+
+ if not Status then
+ Prj.Com.Fail ("could not write temporary file");
+ end if;
+ end Write_Path_File;
+
end Makeutl;
Index: makeutl.ads
===================================================================
--- makeutl.ads (revision 178155)
+++ makeutl.ads (working copy)
@@ -33,6 +33,8 @@
with Osint;
with Prj; use Prj;
with Prj.Tree;
+with Snames; use Snames;
+with Table;
with Types; use Types;
with GNAT.OS_Lib; use GNAT.OS_Lib;
@@ -65,6 +67,16 @@
Create_Map_File_Switch : constant String := "--create-map-file";
-- Switch to create a map file when an executable is linked
+ package Directories is new Table.Table
+ (Table_Component_Type => Path_Name_Type,
+ Table_Index_Type => Integer,
+ Table_Low_Bound => 1,
+ Table_Initial => 200,
+ Table_Increment => 100,
+ Table_Name => "Makegpr.Directories");
+ -- Table of all the source or object directories, filled up by
+ -- Get_Directories.
+
procedure Add
(Option : String_Access;
To : in out String_List_Access;
@@ -159,6 +171,30 @@
-- 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.
+ type Name_Ids is array (Positive range <>) of Name_Id;
+ No_Names : constant Name_Ids := (1 .. 0 => No_Name);
+ -- Name_Ids is used for list of language names in procedure Get_Directories
+ -- below.
+ Ada_Only : constant Name_Ids := (1 => Name_Ada);
+ -- Used to invoke Get_Directories in gnatmake
+
+ type Activity_Type is (Compilation, Executable_Binding, SAL_Binding);
+
+ procedure Get_Directories
+ (Project_Tree : Project_Tree_Ref;
+ For_Project : Project_Id;
+ Activity : Activity_Type;
+ Languages : Name_Ids);
+ -- Put in table Directories the source (when Sources is True) or
+ -- object/library (when Sources is False) directories of project
+ -- For_Project and of all the project it imports directly or indirectly.
+ -- The source directories of imported projects are only included if one
+ -- of the declared languages is in the list Languages.
+
+ procedure Write_Path_File (FD : File_Descriptor);
+ -- Write in the specified open path file the directories in table
+ -- Directories, then closed the path file.
+
procedure Get_Switches
(Source : Source_Id;
Pkg_Name : Name_Id;
Index: prj-env.adb
===================================================================
--- prj-env.adb (revision 178155)
+++ prj-env.adb (working copy)
@@ -102,9 +102,6 @@
-- Add Object_Dir to object path table. Make sure it is not duplicate
-- and it is the last one in the current table.
- procedure Set_Path_File_Var (Name : String; Value : String);
- -- Call Setenv, after calling To_Host_File_Spec
-
----------------------
-- Ada_Include_Path --
----------------------
@@ -1776,22 +1773,6 @@
Free (Buffer);
end Set_Ada_Paths;
- -----------------------
- -- Set_Path_File_Var --
- -----------------------
-
- procedure Set_Path_File_Var (Name : String; Value : String) is
- Host_Spec : String_Access := To_Host_File_Spec (Value);
- begin
- if Host_Spec = null then
- Prj.Com.Fail
- ("could not convert file name """ & Value & """ to host spec");
- else
- Setenv (Name, Host_Spec.all);
- Free (Host_Spec);
- end if;
- end Set_Path_File_Var;
-
---------------------
-- Add_Directories --
---------------------
