From patchwork Tue Jun 22 09:40:27 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 56442 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 BC215B6F0E for ; Tue, 22 Jun 2010 19:41:00 +1000 (EST) Received: (qmail 15002 invoked by alias); 22 Jun 2010 09:40:57 -0000 Received: (qmail 14985 invoked by uid 22791); 22 Jun 2010 09:40:52 -0000 X-SWARE-Spam-Status: No, hits=-0.5 required=5.0 tests=AWL, BAYES_50, 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; Tue, 22 Jun 2010 09:40:27 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 1B7C2CB025E; Tue, 22 Jun 2010 11:40:28 +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 cw+6zbpwgfch; Tue, 22 Jun 2010 11:40:28 +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 0740BCB024F; Tue, 22 Jun 2010 11:40:28 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id EAB51D9B31; Tue, 22 Jun 2010 11:40:27 +0200 (CEST) Date: Tue, 22 Jun 2010 11:40:27 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Thomas Quinot Subject: [Ada] New gnatbind command switch -A Message-ID: <20100622094027.GA21401@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 change introduces a new gnatbind command switch -A used to produce a listing of all ALI files in the partition. The switch takes an optional file name (else the list is output to stdout). The existing -O switch is extended to accept an optional file name in a similar fashion. Tested on x86_64-pc-linux-gnu, committed on trunk 2010-06-22 Thomas Quinot * bindgen.adb, bindusg.adb, gnatbind.adb, gnat_ugn.texi, opt.ads, osint-b.adb, osint-b.ads, output.adb, output.ads, switch-b.adb, vms_data.ads: Add a new command line switch -A to gnatbind to output the list of all ALI files for the partition. Index: bindgen.adb =================================================================== --- bindgen.adb (revision 161073) +++ bindgen.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -1936,6 +1936,10 @@ package body Bindgen is WBI (""); Write_Info_Ada_C ("-- ", "/* ", " BEGIN Object file/option list"); + if Object_List_Filename /= null then + Set_List_File (Object_List_Filename.all); + end if; + for E in Elab_Order.First .. Elab_Order.Last loop -- If not spec that has an associated body, then generate a @@ -1985,6 +1989,10 @@ package body Bindgen is end if; end loop; + if Object_List_Filename /= null then + Close_List_File; + end if; + -- Add a "-Ldir" for each directory in the object path for J in 1 .. Nb_Dir_In_Obj_Search_Path loop Index: bindusg.adb =================================================================== --- bindusg.adb (revision 161073) +++ bindusg.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -73,6 +73,10 @@ package body Bindusg is Write_Line (" -a Automatically initialize elaboration " & "procedure"); + -- Line for -A switch + + Write_Line (" -A Give list of ALI files in partition"); + -- Line for -b switch Write_Line (" -b Generate brief messages to stderr " & Index: gnatbind.adb =================================================================== --- gnatbind.adb (revision 161148) +++ gnatbind.adb (working copy) @@ -738,7 +738,7 @@ begin Free (Text); end if; - -- Acquire all information in ALI files that have been read in + -- Load ALIs for all dependent units for Index in ALIs.First .. ALIs.Last loop Read_Withed_ALIs (Index); @@ -750,6 +750,32 @@ begin raise Unrecoverable_Error; end if; + -- Output list of ALI files in closure + + if Output_ALI_List then + declare + FD : File_Descriptor; + begin + if ALI_List_Filename /= null then + Set_List_File (ALI_List_Filename.all); + end if; + + for Index in ALIs.First .. ALIs.Last loop + declare + Full_Afile : constant File_Name_Type := + Find_File (ALIs.Table (Index).Afile, Library); + begin + Write_Name (Full_Afile); + Write_Eol; + end; + end loop; + + if ALI_List_Filename /= null then + Close_List_File; + end if; + end; + end if; + -- Build source file table from the ALI files we have read in Set_Source_Table; Index: gnat_ugn.texi =================================================================== --- gnat_ugn.texi (revision 161152) +++ gnat_ugn.texi (working copy) @@ -8028,6 +8028,10 @@ Specify directory to be searched for ALI @cindex @option{^-aI^/SOURCE_SEARCH^} (@command{gnatbind}) Specify directory to be searched for source file. +@item ^-A^/ALI_LIST^@r{[=}@var{filename}@r{]} +@cindex @option{^-A^/ALI_LIST^} (@command{gnatbind}) +Output ALI list (to standard output or to the named file). + @item ^-b^/REPORT_ERRORS=BRIEF^ @cindex @option{^-b^/REPORT_ERRORS=BRIEF^} (@command{gnatbind}) Generate brief messages to @file{stderr} even if verbose mode set. @@ -8180,9 +8184,9 @@ Name the output file @var{file} (default Note that if this option is used, then linking must be done manually, gnatlink cannot be used. -@item ^-O^/OBJECT_LIST^ +@item ^-O^/OBJECT_LIST^@r{[=}@var{filename}@r{]} @cindex @option{^-O^/OBJECT_LIST^} (@command{gnatbind}) -Output object list. +Output object list (to standard output or to the named file). @item ^-p^/PESSIMISTIC_ELABORATION^ @cindex @option{^-p^/PESSIMISTIC_ELABORATION^} (@command{gnatbind}) Index: opt.ads =================================================================== --- opt.ads (revision 161073) +++ opt.ads (working copy) @@ -951,9 +951,17 @@ package Opt is -- GNATBIND -- True if output of list of linker options is requested (-K switch set) - Output_Object_List : Boolean := False; + Output_ALI_List : Boolean := False; + ALI_List_Filename : String_Ptr; -- GNATBIND - -- True if output of list of objects is requested (-O switch set) + -- True if output of list of ALIs is requested (-A switch set). List is + -- output under the given filename, or standard output if not specified. + + Output_Object_List : Boolean := False; + Object_List_Filename : String_Ptr; + -- GNATBIND + -- True if output of list of objects is requested (-O switch set). List is + -- output under the given filename, or standard output if not specified. Overflow_Checks_Unsuppressed : Boolean := False; -- GNAT Index: osint-b.adb =================================================================== --- osint-b.adb (revision 161073) +++ osint-b.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2010, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -24,10 +24,13 @@ ------------------------------------------------------------------------------ with Opt; use Opt; +with Output; use Output; with Targparm; use Targparm; package body Osint.B is + Current_List_File : File_Descriptor := Invalid_FD; + ------------------------- -- Close_Binder_Output -- ------------------------- @@ -45,6 +48,19 @@ package body Osint.B is end Close_Binder_Output; + --------------------- + -- Close_List_File -- + --------------------- + + procedure Close_List_File is + begin + if Current_List_File /= Invalid_FD then + Close (Current_List_File); + Current_List_File := Invalid_FD; + Set_Standard_Output; + end if; + end Close_List_File; + -------------------------- -- Create_Binder_Output -- -------------------------- @@ -65,8 +81,8 @@ package body Osint.B is begin if Output_File_Name /= "" then - Name_Buffer (Output_File_Name'Range) := Output_File_Name; - Name_Buffer (Output_File_Name'Last + 1) := ASCII.NUL; + Name_Buffer (1 .. Output_File_Name'Length) := Output_File_Name; + Name_Buffer (Output_File_Name'Length + 1) := ASCII.NUL; if Typ = 's' then Name_Buffer (Output_File_Name'Last) := 's'; @@ -176,6 +192,19 @@ package body Osint.B is Current_File_Name_Index := To; end Set_Current_File_Name_Index; + procedure Set_List_File (Filename : String) is + begin + pragma Assert (Current_List_File = Invalid_FD); + Current_List_File := Create_File (Filename, Text); + + if Current_List_File = Invalid_FD then + Fail ("cannot create list file: " & Filename); + + else + Set_Output (Current_List_File); + end if; + end Set_List_File; + ----------------------- -- Write_Binder_Info -- ----------------------- Index: osint-b.ads =================================================================== --- osint-b.ads (revision 161073) +++ osint-b.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2010, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -44,9 +44,9 @@ package Osint.B is -- Binder Output -- ------------------- - -- These routines are used by the binder to generate the C source file - -- containing the binder output. The format of this file is described - -- in the package Bindfmt. + -- These routines are used by the binder to generate the C or Ada source + -- files containing the binder output. The format of these files is + -- described in package Bindgen. procedure Create_Binder_Output (Output_File_Name : String; @@ -81,4 +81,16 @@ package Osint.B is procedure Set_Current_File_Name_Index (To : Int); -- Set value of Current_File_Name_Index (in private part of Osint) to To + ---------------------------------- + -- Other binder-generated files -- + ---------------------------------- + + procedure Set_List_File (Filename : String); + -- Create Filename as a text output file and set it as the current output + -- (see Output.Set_Output). + + procedure Close_List_File; + -- If a specific output file was created by Set_List_File, close it and + -- reset the current output file to standard output. + end Osint.B; Index: output.adb =================================================================== --- output.adb (revision 161073) +++ output.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -29,8 +29,6 @@ -- -- ------------------------------------------------------------------------------ -with System.OS_Lib; use System.OS_Lib; - package body Output is Current_FD : File_Descriptor := Standout; @@ -228,17 +226,26 @@ package body Output is Special_Output_Proc := P; end Set_Special_Output; - ------------------------ - -- Set_Standard_Error -- - ------------------------ + ---------------- + -- Set_Output -- + ---------------- - procedure Set_Standard_Error is + procedure Set_Output (FD : File_Descriptor) is begin if Special_Output_Proc = null then Flush_Buffer; end if; - Current_FD := Standerr; + Current_FD := FD; + end Set_Output; + + ------------------------ + -- Set_Standard_Error -- + ------------------------ + + procedure Set_Standard_Error is + begin + Set_Output (Standerr); end Set_Standard_Error; ------------------------- @@ -247,11 +254,7 @@ package body Output is procedure Set_Standard_Output is begin - if Special_Output_Proc = null then - Flush_Buffer; - end if; - - Current_FD := Standout; + Set_Output (Standout); end Set_Standard_Output; ------- Index: output.ads =================================================================== --- output.ads (revision 161073) +++ output.ads (working copy) @@ -33,6 +33,8 @@ -- writing error messages and informational output. It is also used by the -- debug source file output routines (see Sprint.Print_Debug_Line). +with System.OS_Lib; use System.OS_Lib; + with Hostparm; use Hostparm; with Types; use Types; @@ -85,6 +87,12 @@ package Output is -- has been cancelled. Output to standard output is the default mode -- before any call to either of the Set procedures. + procedure Set_Output (FD : File_Descriptor); + -- Sets subsequent output to appear on the given file descriptor when no + -- special output is in effect. When a special output is in effect, + -- the output will appear on the given file descriptor only after special + -- output has been cancelled. + procedure Indent; -- Increases the current indentation level. Whenever a line is written -- (triggered by Eol), an appropriate amount of whitespace is added to the Index: switch-b.adb =================================================================== --- switch-b.adb (revision 161073) +++ switch-b.adb (working copy) @@ -41,10 +41,35 @@ package body Switch.B is Ptr : Integer := Switch_Chars'First; C : Character := ' '; + function Get_Optional_Filename return String_Ptr; + -- If current character is '=', return a newly allocated string + -- containing the remainder of the current switch (after the '='), else + -- return null. + function Get_Stack_Size (S : Character) return Int; -- Used for -d and -D to scan stack size including handling k/m. -- S is set to 'd' or 'D' to indicate the switch being scanned. + --------------------------- + -- Get_Optional_Filename -- + --------------------------- + + function Get_Optional_Filename return String_Ptr is + Result : String_Ptr; + begin + if Ptr <= Max and then Switch_Chars (Ptr) = '=' then + if Ptr = Max then + Bad_Switch (Switch_Chars); + else + Result := new String'(Switch_Chars (Ptr + 1 .. Max)); + Ptr := Max + 1; + return Result; + end if; + else + return null; + end if; + end Get_Optional_Filename; + -------------------- -- Get_Stack_Size -- -------------------- @@ -125,7 +150,8 @@ package body Switch.B is when 'A' => Ptr := Ptr + 1; - Ada_Bind_File := True; + Output_ALI_List := True; + ALI_List_Filename := Get_Optional_Filename; -- Processing for b switch @@ -144,7 +170,6 @@ package body Switch.B is when 'C' => Ptr := Ptr + 1; - Ada_Bind_File := False; Write_Line ("warning: gnatbind switch -C is obsolescent"); @@ -318,6 +343,7 @@ package body Switch.B is when 'O' => Ptr := Ptr + 1; Output_Object_List := True; + Object_List_Filename := Get_Optional_Filename; -- Processing for p switch Index: vms_data.ads =================================================================== --- vms_data.ads (revision 161073) +++ vms_data.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1996-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1996-2010, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -196,6 +196,14 @@ package VMS_Data is -- -- Add directories to the project search path. + S_Bind_ALI : aliased constant S := "/ALI_LIST " & + "-A"; + -- /NOALI_LIST (D) + -- /ALI_LIST + -- + -- Output full names of all the ALI files in the partition. The output is + -- written to SYS$OUTPUT. + S_Bind_Bind : aliased constant S := "/BIND_FILE=" & "ADA " & "-A " & @@ -385,7 +393,7 @@ package VMS_Data is -- /NOOBJECT_LIST (D) -- /OBJECT_LIST -- - -- Output full names of all the object files that must be linker to + -- Output full names of all the object files that must be linked to -- provide the Ada component of the program. The output is written to -- SYS$OUTPUT. @@ -669,6 +677,7 @@ package VMS_Data is Bind_Switches : aliased constant Switches := (S_Bind_Add 'Access, + S_Bind_ALI 'Access, S_Bind_Bind 'Access, S_Bind_Build 'Access, S_Bind_Current 'Access,