From patchwork Mon Aug 29 09:28:17 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 111998 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id D45E4B6F92 for ; Mon, 29 Aug 2011 19:30:14 +1000 (EST) Received: (qmail 388 invoked by alias); 29 Aug 2011 09:30:08 -0000 Received: (qmail 29478 invoked by uid 22791); 29 Aug 2011 09:28:44 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL,BAYES_00,TW_PR X-Spam-Check-By: sourceware.org Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Mon, 29 Aug 2011 09:28:18 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id EDA4E2BB10E; Mon, 29 Aug 2011 05:28:17 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id ynF5e7xxBCQH; Mon, 29 Aug 2011 05:28:17 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id D45432BB109; Mon, 29 Aug 2011 05:28:17 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id C4A583FEE8; Mon, 29 Aug 2011 05:28:17 -0400 (EDT) Date: Mon, 29 Aug 2011 05:28:17 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Vincent Celier Subject: [Ada] Correct object path when binding extending SALs Message-ID: <20110829092817.GA21931@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org 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 * 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 -- ---------------------