From patchwork Fri Sep 10 13:54:10 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 64394 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 1A211B70FC for ; Fri, 10 Sep 2010 23:54:28 +1000 (EST) Received: (qmail 13159 invoked by alias); 10 Sep 2010 13:54:26 -0000 Received: (qmail 13131 invoked by uid 22791); 10 Sep 2010 13:54:23 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (212.99.106.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Fri, 10 Sep 2010 13:54:13 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id C419DCB0319; Fri, 10 Sep 2010 15:54:10 +0200 (CEST) Received: from mel.act-europe.fr ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id Q5QSlIqTIJbQ; Fri, 10 Sep 2010 15:54:10 +0200 (CEST) Received: from saumur.act-europe.fr (saumur.act-europe.fr [10.10.0.183]) by mel.act-europe.fr (Postfix) with ESMTP id AF4CACB030D; Fri, 10 Sep 2010 15:54:10 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id 8CE6FD9BB4; Fri, 10 Sep 2010 15:54:10 +0200 (CEST) Date: Fri, 10 Sep 2010 15:54:10 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Vincent Celier Subject: [Ada] Move Create_Binder_Mapping_File to Makeutl Message-ID: <20100910135410.GA18865@adacore.com> Mime-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.9i X-IsSubscribed: yes 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 This is just a source reorganisation to make Create_Binder_Mapping_File available for gprbuild. There is no functionality change, so no test. Tested on x86_64-pc-linux-gnu, committed on trunk 2010-09-10 Vincent Celier * make.adb (Create_Binder_Mapping_File): Remove procedure. Replaced by function of the same name in Makeutl. (Gnatmake): Call function Create_Binder_Mapping_File in Makeutl, instead of removed procedure when creating a binder mapping file. * makeutl.adb (Create_Binder_Mapping_File): New function. Was a procedure in Make. * makeutl.ads (Create_Binder_Mapping_File): New function Index: make.adb =================================================================== --- make.adb (revision 164167) +++ make.adb (working copy) @@ -4136,10 +4136,6 @@ package body Make is -- Check that the main subprograms do exist and that they all -- belong to the same project file. - procedure Create_Binder_Mapping_File - (Args : in out Argument_List; Last_Arg : in out Natural); - -- Create a binder mapping file and add the necessary switch - ----------------- -- Check_Mains -- ----------------- @@ -4282,185 +4278,6 @@ package body Make is end loop; end Check_Mains; - -------------------------------- - -- Create_Binder_Mapping_File -- - -------------------------------- - - procedure Create_Binder_Mapping_File - (Args : in out Argument_List; Last_Arg : in out Natural) - is - Mapping_FD : File_Descriptor := Invalid_FD; - -- A File Descriptor for an eventual mapping file - - ALI_Unit : Unit_Name_Type := No_Unit_Name; - -- The unit name of an ALI file - - ALI_Name : File_Name_Type := No_File; - -- The file name of the ALI file - - ALI_Project : Project_Id := No_Project; - -- The project of the ALI file - - Bytes : Integer; - OK : Boolean := True; - Unit : Unit_Index; - - Status : Boolean; - -- For call to Close - - begin - Tempdir.Create_Temp_File (Mapping_FD, Mapping_Path); - Record_Temp_File (Project_Tree, Mapping_Path); - - if Mapping_FD /= Invalid_FD then - - -- Traverse all units - - Unit := Units_Htable.Get_First (Project_Tree.Units_HT); - - while Unit /= No_Unit_Index loop - if Unit.Name /= No_Name then - - -- If there is a body, put it in the mapping - - if Unit.File_Names (Impl) /= No_Source - and then Unit.File_Names (Impl).Project /= - No_Project - then - Get_Name_String (Unit.Name); - Add_Str_To_Name_Buffer ("%b"); - ALI_Unit := Name_Find; - ALI_Name := - Lib_File_Name - (Unit.File_Names (Impl).Display_File); - ALI_Project := Unit.File_Names (Impl).Project; - - -- Otherwise, if there is a spec, put it in the mapping - - elsif Unit.File_Names (Spec) /= No_Source - and then Unit.File_Names (Spec).Project /= No_Project - then - Get_Name_String (Unit.Name); - Add_Str_To_Name_Buffer ("%s"); - ALI_Unit := Name_Find; - ALI_Name := - Lib_File_Name - (Unit.File_Names (Spec).Display_File); - ALI_Project := Unit.File_Names (Spec).Project; - - else - ALI_Name := No_File; - end if; - - -- If we have something to put in the mapping then do it - -- now. However, if the project is extended, we don't put - -- anything in the mapping file, because we don't know where - -- the ALI file is: it might be in the extended project - -- object directory as well as in the extending project - -- object directory. - - if ALI_Name /= No_File - and then ALI_Project.Extended_By = No_Project - and then ALI_Project.Extends = No_Project - then - -- First check if the ALI file exists. If it does not, - -- do not put the unit in the mapping file. - - declare - ALI : constant String := Get_Name_String (ALI_Name); - - begin - -- For library projects, use the library directory, - -- for other projects, use the object directory. - - if ALI_Project.Library then - Get_Name_String (ALI_Project.Library_Dir.Name); - else - Get_Name_String - (ALI_Project.Object_Directory.Display_Name); - end if; - - if not - Is_Directory_Separator (Name_Buffer (Name_Len)) - then - Add_Char_To_Name_Buffer (Directory_Separator); - end if; - - Add_Str_To_Name_Buffer (ALI); - Add_Char_To_Name_Buffer (ASCII.LF); - - declare - ALI_Path_Name : constant String := - Name_Buffer (1 .. Name_Len); - - begin - if Is_Regular_File - (ALI_Path_Name (1 .. ALI_Path_Name'Last - 1)) - then - -- First line is the unit name - - Get_Name_String (ALI_Unit); - Add_Char_To_Name_Buffer (ASCII.LF); - Bytes := - Write - (Mapping_FD, - Name_Buffer (1)'Address, - Name_Len); - OK := Bytes = Name_Len; - - exit when not OK; - - -- Second line it the ALI file name - - Get_Name_String (ALI_Name); - Add_Char_To_Name_Buffer (ASCII.LF); - Bytes := - Write - (Mapping_FD, - Name_Buffer (1)'Address, - Name_Len); - OK := (Bytes = Name_Len); - - exit when not OK; - - -- Third line it the ALI path name - - Bytes := - Write - (Mapping_FD, - ALI_Path_Name (1)'Address, - ALI_Path_Name'Length); - OK := (Bytes = ALI_Path_Name'Length); - - -- If OK is False, it means we were unable to - -- write a line. No point in continuing with the - -- other units. - - exit when not OK; - end if; - end; - end; - end if; - end if; - - Unit := Units_Htable.Get_Next (Project_Tree.Units_HT); - end loop; - - Close (Mapping_FD, Status); - - OK := OK and Status; - - -- If the creation of the mapping file was successful, we add the - -- switch to the arguments of gnatbind. - - if OK then - Last_Arg := Last_Arg + 1; - Args (Last_Arg) := - new String'("-F=" & Get_Name_String (Mapping_Path)); - end if; - end if; - end Create_Binder_Mapping_File; - -- Start of processing for Gnatmake -- This body is very long, should be broken down??? @@ -6013,7 +5830,13 @@ package body Make is -- If switch -C was specified, create a binder mapping file if Create_Mapping_File then - Create_Binder_Mapping_File (Args, Last_Arg); + Mapping_Path := Create_Binder_Mapping_File; + + if Mapping_Path /= No_Path then + Last_Arg := Last_Arg + 1; + Args (Last_Arg) := + new String'("-F=" & Get_Name_String (Mapping_Path)); + end if; end if; end if; Index: makeutl.adb =================================================================== --- makeutl.adb (revision 164167) +++ makeutl.adb (working copy) @@ -34,6 +34,7 @@ with Prj.Ext; with Prj.Util; with Snames; use Snames; with Table; +with Tempdir; with Ada.Command_Line; use Ada.Command_Line; @@ -295,6 +296,183 @@ package body Makeutl is return True; end Check_Source_Info_In_ALI; + -------------------------------- + -- Create_Binder_Mapping_File -- + -------------------------------- + + function Create_Binder_Mapping_File return Path_Name_Type is + Mapping_Path : Path_Name_Type := No_Path; + + Mapping_FD : File_Descriptor := Invalid_FD; + -- A File Descriptor for an eventual mapping file + + ALI_Unit : Unit_Name_Type := No_Unit_Name; + -- The unit name of an ALI file + + ALI_Name : File_Name_Type := No_File; + -- The file name of the ALI file + + ALI_Project : Project_Id := No_Project; + -- The project of the ALI file + + Bytes : Integer; + OK : Boolean := False; + Unit : Unit_Index; + + Status : Boolean; + -- For call to Close + + begin + Tempdir.Create_Temp_File (Mapping_FD, Mapping_Path); + Record_Temp_File (Project_Tree, Mapping_Path); + + if Mapping_FD /= Invalid_FD then + OK := True; + + -- Traverse all units + + Unit := Units_Htable.Get_First (Project_Tree.Units_HT); + while Unit /= No_Unit_Index loop + if Unit.Name /= No_Name then + + -- If there is a body, put it in the mapping + + if Unit.File_Names (Impl) /= No_Source + and then Unit.File_Names (Impl).Project /= No_Project + then + Get_Name_String (Unit.Name); + Add_Str_To_Name_Buffer ("%b"); + ALI_Unit := Name_Find; + ALI_Name := + Lib_File_Name (Unit.File_Names (Impl).Display_File); + ALI_Project := Unit.File_Names (Impl).Project; + + -- Otherwise, if there is a spec, put it in the mapping + + elsif Unit.File_Names (Spec) /= No_Source + and then Unit.File_Names (Spec).Project /= No_Project + then + Get_Name_String (Unit.Name); + Add_Str_To_Name_Buffer ("%s"); + ALI_Unit := Name_Find; + ALI_Name := + Lib_File_Name (Unit.File_Names (Spec).Display_File); + ALI_Project := Unit.File_Names (Spec).Project; + + else + ALI_Name := No_File; + end if; + + -- If we have something to put in the mapping then do it now. + -- However, if the project is extended, we don't put anything + -- in the mapping file, since we don't know where the ALI file + -- is: it might be in the extended project object directory as + -- well as in the extending project object directory. + + if ALI_Name /= No_File + and then ALI_Project.Extended_By = No_Project + and then ALI_Project.Extends = No_Project + then + -- First check if the ALI file exists. If it does not, do + -- not put the unit in the mapping file. + + declare + ALI : constant String := Get_Name_String (ALI_Name); + + begin + -- For library projects, use the library ALI directory, + -- for other projects, use the object directory. + + if ALI_Project.Library then + Get_Name_String + (ALI_Project.Library_ALI_Dir.Display_Name); + else + Get_Name_String + (ALI_Project.Object_Directory.Display_Name); + end if; + + if not + Is_Directory_Separator (Name_Buffer (Name_Len)) + then + Add_Char_To_Name_Buffer (Directory_Separator); + end if; + + Add_Str_To_Name_Buffer (ALI); + Add_Char_To_Name_Buffer (ASCII.LF); + + declare + ALI_Path_Name : constant String := + Name_Buffer (1 .. Name_Len); + + begin + if Is_Regular_File + (ALI_Path_Name (1 .. ALI_Path_Name'Last - 1)) + then + -- First line is the unit name + + Get_Name_String (ALI_Unit); + Add_Char_To_Name_Buffer (ASCII.LF); + Bytes := + Write + (Mapping_FD, + Name_Buffer (1)'Address, + Name_Len); + OK := Bytes = Name_Len; + + exit when not OK; + + -- Second line it the ALI file name + + Get_Name_String (ALI_Name); + Add_Char_To_Name_Buffer (ASCII.LF); + Bytes := + Write + (Mapping_FD, + Name_Buffer (1)'Address, + Name_Len); + OK := (Bytes = Name_Len); + + exit when not OK; + + -- Third line it the ALI path name + + Bytes := + Write + (Mapping_FD, + ALI_Path_Name (1)'Address, + ALI_Path_Name'Length); + OK := (Bytes = ALI_Path_Name'Length); + + -- If OK is False, it means we were unable to + -- write a line. No point in continuing with the + -- other units. + + exit when not OK; + end if; + end; + end; + end if; + end if; + + Unit := Units_Htable.Get_Next (Project_Tree.Units_HT); + end loop; + + Close (Mapping_FD, Status); + + OK := OK and Status; + end if; + + -- If the creation of the mapping file was successful, we add the switch + -- to the arguments of gnatbind. + + if OK then + return Mapping_Path; + + else + return No_Path; + end if; + end Create_Binder_Mapping_File; + ----------------- -- Create_Name -- ----------------- Index: makeutl.ads =================================================================== --- makeutl.ads (revision 164167) +++ makeutl.ads (working copy) @@ -70,6 +70,9 @@ package Makeutl is Last : in out Natural); -- Add a string to a list of strings + function Create_Binder_Mapping_File return Path_Name_Type; + -- Create a binder mapping file and returns its path name + function Create_Name (Name : String) return File_Name_Type; function Create_Name (Name : String) return Name_Id; function Create_Name (Name : String) return Path_Name_Type;