| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- G N A T N A M E -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 2001-2006, 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- -- |
| -- ware Foundation; either version 2, or (at your option) any later ver- -- |
| -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
| -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- |
| -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- |
| -- for more details. You should have received a copy of the GNU General -- |
| -- Public License distributed with GNAT; see file COPYING. If not, write -- |
| -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- |
| -- Boston, MA 02110-1301, USA. -- |
| -- -- |
| -- GNAT was originally developed by the GNAT team at New York University. -- |
| -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| with Gnatvsn; use Gnatvsn; |
| with Hostparm; |
| with Opt; |
| with Osint; use Osint; |
| with Output; use Output; |
| with Prj.Makr; |
| with Table; |
| |
| with Ada.Command_Line; use Ada.Command_Line; |
| with Ada.Text_IO; use Ada.Text_IO; |
| with GNAT.Command_Line; use GNAT.Command_Line; |
| with GNAT.OS_Lib; use GNAT.OS_Lib; |
| |
| procedure Gnatname is |
| |
| Usage_Output : Boolean := False; |
| -- Set to True when usage is output, to avoid multiple output |
| |
| Usage_Needed : Boolean := False; |
| -- Set to True by -h switch |
| |
| Version_Output : Boolean := False; |
| -- Set to True when version is output, to avoid multiple output |
| |
| Very_Verbose : Boolean := False; |
| -- Set to True with -v -v |
| |
| Create_Project : Boolean := False; |
| -- Set to True with a -P switch |
| |
| File_Path : String_Access := new String'("gnat.adc"); |
| -- Path name of the file specified by -c or -P switch |
| |
| File_Set : Boolean := False; |
| -- Set to True by -c or -P switch. |
| -- Used to detect multiple -c/-P switches. |
| |
| package Excluded_Patterns is new Table.Table |
| (Table_Component_Type => String_Access, |
| Table_Index_Type => Natural, |
| Table_Low_Bound => 0, |
| Table_Initial => 10, |
| Table_Increment => 10, |
| Table_Name => "Gnatname.Excluded_Patterns"); |
| -- Table to accumulate the negative patterns |
| |
| package Foreign_Patterns is new Table.Table |
| (Table_Component_Type => String_Access, |
| Table_Index_Type => Natural, |
| Table_Low_Bound => 0, |
| Table_Initial => 10, |
| Table_Increment => 10, |
| Table_Name => "Gnatname.Foreign_Patterns"); |
| -- Table to accumulate the foreign patterns |
| |
| package Patterns is new Table.Table |
| (Table_Component_Type => String_Access, |
| Table_Index_Type => Natural, |
| Table_Low_Bound => 0, |
| Table_Initial => 10, |
| Table_Increment => 10, |
| Table_Name => "Gnatname.Patterns"); |
| -- Table to accumulate the name patterns |
| |
| package Source_Directories is new Table.Table |
| (Table_Component_Type => String_Access, |
| Table_Index_Type => Natural, |
| Table_Low_Bound => 0, |
| Table_Initial => 10, |
| Table_Increment => 10, |
| Table_Name => "Gnatname.Source_Directories"); |
| -- Table to accumulate the source directories specified directly with -d |
| -- or indirectly with -D. |
| |
| package Preprocessor_Switches is new Table.Table |
| (Table_Component_Type => String_Access, |
| Table_Index_Type => Natural, |
| Table_Low_Bound => 0, |
| Table_Initial => 2, |
| Table_Increment => 50, |
| Table_Name => "Gnatname.Preprocessor_Switches"); |
| -- Table to store the preprocessor switches to be used in the call |
| -- to the compiler. |
| |
| procedure Output_Version; |
| -- Print name and version |
| |
| procedure Usage; |
| -- Print usage |
| |
| procedure Scan_Args; |
| -- Scan the command line arguments |
| |
| procedure Add_Source_Directory (S : String); |
| -- Add S in the Source_Directories table |
| |
| procedure Get_Directories (From_File : String); |
| -- Read a source directory text file |
| |
| -------------------------- |
| -- Add_Source_Directory -- |
| -------------------------- |
| |
| procedure Add_Source_Directory (S : String) is |
| begin |
| Source_Directories.Increment_Last; |
| Source_Directories.Table (Source_Directories.Last) := new String'(S); |
| end Add_Source_Directory; |
| |
| --------------------- |
| -- Get_Directories -- |
| --------------------- |
| |
| procedure Get_Directories (From_File : String) is |
| File : Ada.Text_IO.File_Type; |
| Line : String (1 .. 2_000); |
| Last : Natural; |
| |
| begin |
| Open (File, In_File, From_File); |
| |
| while not End_Of_File (File) loop |
| Get_Line (File, Line, Last); |
| |
| if Last /= 0 then |
| Add_Source_Directory (Line (1 .. Last)); |
| end if; |
| end loop; |
| |
| Close (File); |
| |
| exception |
| when Name_Error => |
| Fail ("cannot open source directory """ & From_File & '"'); |
| end Get_Directories; |
| |
| -------------------- |
| -- Output_Version -- |
| -------------------- |
| |
| procedure Output_Version is |
| begin |
| if not Version_Output then |
| Version_Output := True; |
| Output.Write_Eol; |
| Output.Write_Str ("GNATNAME "); |
| Output.Write_Line (Gnatvsn.Gnat_Version_String); |
| Output.Write_Line |
| ("Copyright 2001-" & |
| Current_Year & |
| ", Free Software Foundation, Inc."); |
| end if; |
| end Output_Version; |
| |
| --------------- |
| -- Scan_Args -- |
| --------------- |
| |
| procedure Scan_Args is |
| begin |
| Initialize_Option_Scan; |
| |
| -- Scan options first |
| |
| loop |
| case Getopt ("c: d: gnatep=! gnatep! gnateD! D: h P: v x: f:") is |
| when ASCII.NUL => |
| exit; |
| |
| when 'c' => |
| if File_Set then |
| Fail ("only one -P or -c switch may be specified"); |
| end if; |
| |
| File_Set := True; |
| File_Path := new String'(Parameter); |
| Create_Project := False; |
| |
| when 'd' => |
| Add_Source_Directory (Parameter); |
| |
| when 'D' => |
| Get_Directories (Parameter); |
| |
| when 'f' => |
| Foreign_Patterns.Increment_Last; |
| Foreign_Patterns.Table (Foreign_Patterns.Last) := |
| new String'(Parameter); |
| |
| when 'g' => |
| Preprocessor_Switches.Increment_Last; |
| Preprocessor_Switches.Table (Preprocessor_Switches.Last) := |
| new String'('-' & Full_Switch & Parameter); |
| |
| when 'h' => |
| Usage_Needed := True; |
| |
| when 'P' => |
| if File_Set then |
| Fail ("only one -c or -P switch may be specified"); |
| end if; |
| |
| File_Set := True; |
| File_Path := new String'(Parameter); |
| Create_Project := True; |
| |
| when 'v' => |
| if Opt.Verbose_Mode then |
| Very_Verbose := True; |
| else |
| Opt.Verbose_Mode := True; |
| end if; |
| |
| when 'x' => |
| Excluded_Patterns.Increment_Last; |
| Excluded_Patterns.Table (Excluded_Patterns.Last) := |
| new String'(Parameter); |
| |
| when others => |
| null; |
| end case; |
| end loop; |
| |
| -- Now, get the name patterns, if any |
| |
| loop |
| declare |
| S : String := Get_Argument (Do_Expansion => False); |
| |
| begin |
| exit when S = ""; |
| Canonical_Case_File_Name (S); |
| Patterns.Increment_Last; |
| Patterns.Table (Patterns.Last) := new String'(S); |
| end; |
| end loop; |
| |
| exception |
| when Invalid_Switch => |
| Fail ("invalid switch " & Full_Switch); |
| end Scan_Args; |
| |
| ----------- |
| -- Usage -- |
| ----------- |
| |
| procedure Usage is |
| begin |
| if not Usage_Output then |
| Usage_Needed := False; |
| Usage_Output := True; |
| Write_Str ("Usage: "); |
| Osint.Write_Program_Name; |
| Write_Line (" [switches] naming-pattern [naming-patterns]"); |
| Write_Eol; |
| Write_Line ("switches:"); |
| |
| Write_Line (" -cfile create configuration pragmas file"); |
| Write_Line (" -ddir use dir as one of the source " & |
| "directories"); |
| Write_Line (" -Dfile get source directories from file"); |
| Write_Line (" -fpat foreign pattern"); |
| Write_Line (" -gnateDsym=v preprocess with symbol definition"); |
| Write_Line (" -gnatep=data preprocess files with data file"); |
| Write_Line (" -h output this help message"); |
| Write_Line (" -Pproj update or create project file proj"); |
| Write_Line (" -v verbose output"); |
| Write_Line (" -v -v very verbose output"); |
| Write_Line (" -xpat exclude pattern pat"); |
| end if; |
| end Usage; |
| |
| -- Start of processing for Gnatname |
| |
| begin |
| -- Add the directory where gnatname is invoked in front of the |
| -- path, if gnatname is invoked with directory information. |
| -- Only do this if the platform is not VMS, where the notion of path |
| -- does not really exist. |
| |
| if not Hostparm.OpenVMS then |
| declare |
| Command : constant String := Command_Name; |
| |
| begin |
| for Index in reverse Command'Range loop |
| if Command (Index) = Directory_Separator then |
| declare |
| Absolute_Dir : constant String := |
| Normalize_Pathname |
| (Command (Command'First .. Index)); |
| |
| PATH : constant String := |
| Absolute_Dir & |
| Path_Separator & |
| Getenv ("PATH").all; |
| |
| begin |
| Setenv ("PATH", PATH); |
| end; |
| |
| exit; |
| end if; |
| end loop; |
| end; |
| end if; |
| |
| -- Initialize tables |
| |
| Excluded_Patterns.Set_Last (0); |
| Foreign_Patterns.Set_Last (0); |
| Patterns.Set_Last (0); |
| Source_Directories.Set_Last (0); |
| Preprocessor_Switches.Set_Last (0); |
| |
| -- Get the arguments |
| |
| Scan_Args; |
| |
| if Opt.Verbose_Mode then |
| Output_Version; |
| end if; |
| |
| if Usage_Needed then |
| Usage; |
| end if; |
| |
| -- If no pattern was specified, print the usage and return |
| |
| if Patterns.Last = 0 and Foreign_Patterns.Last = 0 then |
| Usage; |
| return; |
| end if; |
| |
| -- If no source directory was specified, use the current directory as the |
| -- unique directory. Note that if a file was specified with directory |
| -- information, the current directory is the directory of the specified |
| -- file. |
| |
| if Source_Directories.Last = 0 then |
| Source_Directories.Increment_Last; |
| Source_Directories.Table (Source_Directories.Last) := new String'("."); |
| end if; |
| |
| declare |
| Directories : Argument_List (1 .. Integer (Source_Directories.Last)); |
| Name_Patterns : Argument_List (1 .. Integer (Patterns.Last)); |
| Excl_Patterns : Argument_List (1 .. Integer (Excluded_Patterns.Last)); |
| Frgn_Patterns : Argument_List (1 .. Integer (Foreign_Patterns.Last)); |
| Prep_Switches : Argument_List |
| (1 .. Integer (Preprocessor_Switches.Last)); |
| |
| begin |
| -- Build the Directories and Name_Patterns arguments |
| |
| for Index in Directories'Range loop |
| Directories (Index) := Source_Directories.Table (Index); |
| end loop; |
| |
| for Index in Name_Patterns'Range loop |
| Name_Patterns (Index) := Patterns.Table (Index); |
| end loop; |
| |
| for Index in Excl_Patterns'Range loop |
| Excl_Patterns (Index) := Excluded_Patterns.Table (Index); |
| end loop; |
| |
| for Index in Frgn_Patterns'Range loop |
| Frgn_Patterns (Index) := Foreign_Patterns.Table (Index); |
| end loop; |
| |
| for Index in Prep_Switches'Range loop |
| Prep_Switches (Index) := Preprocessor_Switches.Table (Index); |
| end loop; |
| |
| -- Call Prj.Makr.Make where the real work is done |
| |
| Prj.Makr.Make |
| (File_Path => File_Path.all, |
| Project_File => Create_Project, |
| Directories => Directories, |
| Name_Patterns => Name_Patterns, |
| Excluded_Patterns => Excl_Patterns, |
| Foreign_Patterns => Frgn_Patterns, |
| Preproc_Switches => Prep_Switches, |
| Very_Verbose => Very_Verbose); |
| end; |
| |
| if Opt.Verbose_Mode then |
| Write_Eol; |
| end if; |
| end Gnatname; |
