| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- G N A T N A M E -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 2001-2012, 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 3, 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 COPYING3. If not, go to -- |
| -- http://www.gnu.org/licenses for a complete copy of the license. -- |
| -- -- |
| -- GNAT was originally developed by the GNAT team at New York University. -- |
| -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| with Ada.Command_Line; use Ada.Command_Line; |
| with Ada.Text_IO; use Ada.Text_IO; |
| |
| with GNAT.Dynamic_Tables; |
| with GNAT.OS_Lib; use GNAT.OS_Lib; |
| |
| with Hostparm; |
| with Opt; |
| with Osint; use Osint; |
| with Output; use Output; |
| with Prj; use Prj; |
| with Prj.Makr; |
| with Switch; use Switch; |
| with Table; |
| |
| with System.Regexp; use System.Regexp; |
| |
| procedure Gnatname is |
| |
| Subdirs_Switch : constant String := "--subdirs="; |
| |
| 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 Patterns is new GNAT.Dynamic_Tables |
| (Table_Component_Type => String_Access, |
| Table_Index_Type => Natural, |
| Table_Low_Bound => 0, |
| Table_Initial => 10, |
| Table_Increment => 100); |
| -- Table to accumulate the patterns |
| |
| type Argument_Data is record |
| Directories : Patterns.Instance; |
| Name_Patterns : Patterns.Instance; |
| Excluded_Patterns : Patterns.Instance; |
| Foreign_Patterns : Patterns.Instance; |
| end record; |
| |
| package Arguments is new Table.Table |
| (Table_Component_Type => Argument_Data, |
| Table_Index_Type => Natural, |
| Table_Low_Bound => 0, |
| Table_Initial => 10, |
| Table_Increment => 100, |
| Table_Name => "Gnatname.Arguments"); |
| -- Table to accumulate the foreign patterns |
| |
| package Preprocessor_Switches is new Table.Table |
| (Table_Component_Type => String_Access, |
| Table_Index_Type => Natural, |
| Table_Low_Bound => 0, |
| Table_Initial => 10, |
| Table_Increment => 100, |
| 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 |
| Patterns.Append |
| (Arguments.Table (Arguments.Last).Directories, 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 file """ & From_File & '"'); |
| end Get_Directories; |
| |
| -------------------- |
| -- Output_Version -- |
| -------------------- |
| |
| procedure Output_Version is |
| begin |
| if not Version_Output then |
| Version_Output := True; |
| Output.Write_Eol; |
| Display_Version ("GNATNAME", "2001"); |
| end if; |
| end Output_Version; |
| |
| --------------- |
| -- Scan_Args -- |
| --------------- |
| |
| procedure Scan_Args is |
| |
| procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage); |
| |
| Project_File_Name_Expected : Boolean; |
| |
| Pragmas_File_Expected : Boolean; |
| |
| Directory_Expected : Boolean; |
| |
| Dir_File_Name_Expected : Boolean; |
| |
| Foreign_Pattern_Expected : Boolean; |
| |
| Excluded_Pattern_Expected : Boolean; |
| |
| procedure Check_Regular_Expression (S : String); |
| -- Compile string S into a Regexp, fail if any error |
| |
| ----------------------------- |
| -- Check_Regular_Expression-- |
| ----------------------------- |
| |
| procedure Check_Regular_Expression (S : String) is |
| Dummy : Regexp; |
| pragma Warnings (Off, Dummy); |
| begin |
| Dummy := Compile (S, Glob => True); |
| exception |
| when Error_In_Regexp => |
| Fail ("invalid regular expression """ & S & """"); |
| end Check_Regular_Expression; |
| |
| -- Start of processing for Scan_Args |
| |
| begin |
| -- First check for --version or --help |
| |
| Check_Version_And_Help ("GNATNAME", "2001"); |
| |
| -- Now scan the other switches |
| |
| Project_File_Name_Expected := False; |
| Pragmas_File_Expected := False; |
| Directory_Expected := False; |
| Dir_File_Name_Expected := False; |
| Foreign_Pattern_Expected := False; |
| Excluded_Pattern_Expected := False; |
| |
| for Next_Arg in 1 .. Argument_Count loop |
| declare |
| Next_Argv : constant String := Argument (Next_Arg); |
| Arg : String (1 .. Next_Argv'Length) := Next_Argv; |
| |
| begin |
| if Arg'Length > 0 then |
| |
| -- -P xxx |
| |
| if Project_File_Name_Expected then |
| if Arg (1) = '-' then |
| Fail ("project file name missing"); |
| |
| else |
| File_Set := True; |
| File_Path := new String'(Arg); |
| Project_File_Name_Expected := False; |
| end if; |
| |
| -- -c file |
| |
| elsif Pragmas_File_Expected then |
| File_Set := True; |
| File_Path := new String'(Arg); |
| Create_Project := False; |
| Pragmas_File_Expected := False; |
| |
| -- -d xxx |
| |
| elsif Directory_Expected then |
| Add_Source_Directory (Arg); |
| Directory_Expected := False; |
| |
| -- -D xxx |
| |
| elsif Dir_File_Name_Expected then |
| Get_Directories (Arg); |
| Dir_File_Name_Expected := False; |
| |
| -- -f xxx |
| |
| elsif Foreign_Pattern_Expected then |
| Patterns.Append |
| (Arguments.Table (Arguments.Last).Foreign_Patterns, |
| new String'(Arg)); |
| Check_Regular_Expression (Arg); |
| Foreign_Pattern_Expected := False; |
| |
| -- -x xxx |
| |
| elsif Excluded_Pattern_Expected then |
| Patterns.Append |
| (Arguments.Table (Arguments.Last).Excluded_Patterns, |
| new String'(Arg)); |
| Check_Regular_Expression (Arg); |
| Excluded_Pattern_Expected := False; |
| |
| -- There must be at least one Ada pattern or one foreign |
| -- pattern for the previous section. |
| |
| -- --and |
| |
| elsif Arg = "--and" then |
| |
| if Patterns.Last |
| (Arguments.Table (Arguments.Last).Name_Patterns) = 0 |
| and then |
| Patterns.Last |
| (Arguments.Table (Arguments.Last).Foreign_Patterns) = 0 |
| then |
| Usage; |
| return; |
| end if; |
| |
| -- If no directory were specified for the previous section, |
| -- then the directory is the project directory. |
| |
| if Patterns.Last |
| (Arguments.Table (Arguments.Last).Directories) = 0 |
| then |
| Patterns.Append |
| (Arguments.Table (Arguments.Last).Directories, |
| new String'(".")); |
| end if; |
| |
| -- Add and initialize another component to Arguments table |
| |
| declare |
| New_Arguments : Argument_Data; |
| pragma Warnings (Off, New_Arguments); |
| -- Declaring this defaulted initialized object ensures |
| -- that the new allocated component of table Arguments |
| -- is correctly initialized. |
| |
| -- This is VERY ugly, Table should never be used with |
| -- data requiring default initialization. We should |
| -- find a way to avoid violating this rule ??? |
| |
| begin |
| Arguments.Append (New_Arguments); |
| end; |
| |
| Patterns.Init |
| (Arguments.Table (Arguments.Last).Directories); |
| Patterns.Set_Last |
| (Arguments.Table (Arguments.Last).Directories, 0); |
| Patterns.Init |
| (Arguments.Table (Arguments.Last).Name_Patterns); |
| Patterns.Set_Last |
| (Arguments.Table (Arguments.Last).Name_Patterns, 0); |
| Patterns.Init |
| (Arguments.Table (Arguments.Last).Excluded_Patterns); |
| Patterns.Set_Last |
| (Arguments.Table (Arguments.Last).Excluded_Patterns, 0); |
| Patterns.Init |
| (Arguments.Table (Arguments.Last).Foreign_Patterns); |
| Patterns.Set_Last |
| (Arguments.Table (Arguments.Last).Foreign_Patterns, 0); |
| |
| -- Subdirectory switch |
| |
| elsif Arg'Length > Subdirs_Switch'Length |
| and then Arg (1 .. Subdirs_Switch'Length) = Subdirs_Switch |
| then |
| Subdirs := |
| new String'(Arg (Subdirs_Switch'Length + 1 .. Arg'Last)); |
| |
| -- -c |
| |
| elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-c" then |
| if File_Set then |
| Fail ("only one -P or -c switch may be specified"); |
| end if; |
| |
| if Arg'Length = 2 then |
| Pragmas_File_Expected := True; |
| |
| if Next_Arg = Argument_Count then |
| Fail ("configuration pragmas file name missing"); |
| end if; |
| |
| else |
| File_Set := True; |
| File_Path := new String'(Arg (3 .. Arg'Last)); |
| Create_Project := False; |
| end if; |
| |
| -- -d |
| |
| elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-d" then |
| if Arg'Length = 2 then |
| Directory_Expected := True; |
| |
| if Next_Arg = Argument_Count then |
| Fail ("directory name missing"); |
| end if; |
| |
| else |
| Add_Source_Directory (Arg (3 .. Arg'Last)); |
| end if; |
| |
| -- -D |
| |
| elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-D" then |
| if Arg'Length = 2 then |
| Dir_File_Name_Expected := True; |
| |
| if Next_Arg = Argument_Count then |
| Fail ("directory list file name missing"); |
| end if; |
| |
| else |
| Get_Directories (Arg (3 .. Arg'Last)); |
| end if; |
| |
| -- -eL |
| |
| elsif Arg = "-eL" then |
| Opt.Follow_Links_For_Files := True; |
| Opt.Follow_Links_For_Dirs := True; |
| |
| -- -f |
| |
| elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-f" then |
| if Arg'Length = 2 then |
| Foreign_Pattern_Expected := True; |
| |
| if Next_Arg = Argument_Count then |
| Fail ("foreign pattern missing"); |
| end if; |
| |
| else |
| Patterns.Append |
| (Arguments.Table (Arguments.Last).Foreign_Patterns, |
| new String'(Arg (3 .. Arg'Last))); |
| Check_Regular_Expression (Arg (3 .. Arg'Last)); |
| end if; |
| |
| -- -gnatep or -gnateD |
| |
| elsif Arg'Length > 7 and then |
| (Arg (1 .. 7) = "-gnatep" or else Arg (1 .. 7) = "-gnateD") |
| then |
| Preprocessor_Switches.Append (new String'(Arg)); |
| |
| -- -h |
| |
| elsif Arg = "-h" then |
| Usage_Needed := True; |
| |
| -- -p |
| |
| elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-P" then |
| if File_Set then |
| Fail ("only one -c or -P switch may be specified"); |
| end if; |
| |
| if Arg'Length = 2 then |
| if Next_Arg = Argument_Count then |
| Fail ("project file name missing"); |
| |
| else |
| Project_File_Name_Expected := True; |
| end if; |
| |
| else |
| File_Set := True; |
| File_Path := new String'(Arg (3 .. Arg'Last)); |
| end if; |
| |
| Create_Project := True; |
| |
| -- -v |
| |
| elsif Arg = "-v" then |
| if Opt.Verbose_Mode then |
| Very_Verbose := True; |
| else |
| Opt.Verbose_Mode := True; |
| end if; |
| |
| -- -x |
| |
| elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-x" then |
| if Arg'Length = 2 then |
| Excluded_Pattern_Expected := True; |
| |
| if Next_Arg = Argument_Count then |
| Fail ("excluded pattern missing"); |
| end if; |
| |
| else |
| Patterns.Append |
| (Arguments.Table (Arguments.Last).Excluded_Patterns, |
| new String'(Arg (3 .. Arg'Last))); |
| Check_Regular_Expression (Arg (3 .. Arg'Last)); |
| end if; |
| |
| -- Junk switch starting with minus |
| |
| elsif Arg (1) = '-' then |
| Fail ("wrong switch: " & Arg); |
| |
| -- Not a recognized switch, assume file name |
| |
| else |
| Canonical_Case_File_Name (Arg); |
| Patterns.Append |
| (Arguments.Table (Arguments.Last).Name_Patterns, |
| new String'(Arg)); |
| Check_Regular_Expression (Arg); |
| end if; |
| end if; |
| end; |
| end loop; |
| 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_Line (" {--and [switches] naming-pattern [naming-patterns]}"); |
| Write_Eol; |
| Write_Line ("switches:"); |
| |
| Display_Usage_Version_And_Help; |
| |
| Write_Line (" --subdirs=dir real obj/lib/exec dirs are subdirs"); |
| Write_Eol; |
| |
| Write_Line (" --and use different patterns"); |
| Write_Eol; |
| |
| 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 (" -eL follow symbolic links when processing " & |
| "project files"); |
| 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 |
| |
| Arguments.Set_Last (0); |
| declare |
| New_Arguments : Argument_Data; |
| pragma Warnings (Off, New_Arguments); |
| -- Declaring this defaulted initialized object ensures |
| -- that the new allocated component of table Arguments |
| -- is correctly initialized. |
| begin |
| Arguments.Append (New_Arguments); |
| end; |
| Patterns.Init (Arguments.Table (1).Directories); |
| Patterns.Set_Last (Arguments.Table (1).Directories, 0); |
| Patterns.Init (Arguments.Table (1).Name_Patterns); |
| Patterns.Set_Last (Arguments.Table (1).Name_Patterns, 0); |
| Patterns.Init (Arguments.Table (1).Excluded_Patterns); |
| Patterns.Set_Last (Arguments.Table (1).Excluded_Patterns, 0); |
| Patterns.Init (Arguments.Table (1).Foreign_Patterns); |
| Patterns.Set_Last (Arguments.Table (1).Foreign_Patterns, 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 Ada or foreign pattern was specified, print the usage and return |
| |
| if Patterns.Last (Arguments.Table (Arguments.Last).Name_Patterns) = 0 |
| and then |
| Patterns.Last (Arguments.Table (Arguments.Last).Foreign_Patterns) = 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 Patterns.Last |
| (Arguments.Table (Arguments.Last).Directories) = 0 |
| then |
| Patterns.Append |
| (Arguments.Table (Arguments.Last).Directories, new String'(".")); |
| end if; |
| |
| -- Initialize |
| |
| declare |
| Prep_Switches : Argument_List |
| (1 .. Integer (Preprocessor_Switches.Last)); |
| |
| begin |
| for Index in Prep_Switches'Range loop |
| Prep_Switches (Index) := Preprocessor_Switches.Table (Index); |
| end loop; |
| |
| Prj.Makr.Initialize |
| (File_Path => File_Path.all, |
| Project_File => Create_Project, |
| Preproc_Switches => Prep_Switches, |
| Very_Verbose => Very_Verbose, |
| Flags => Gnatmake_Flags); |
| end; |
| |
| -- Process each section successively |
| |
| for J in 1 .. Arguments.Last loop |
| declare |
| Directories : Argument_List |
| (1 .. Integer |
| (Patterns.Last (Arguments.Table (J).Directories))); |
| Name_Patterns : Prj.Makr.Regexp_List |
| (1 .. Integer |
| (Patterns.Last (Arguments.Table (J).Name_Patterns))); |
| Excl_Patterns : Prj.Makr.Regexp_List |
| (1 .. Integer |
| (Patterns.Last (Arguments.Table (J).Excluded_Patterns))); |
| Frgn_Patterns : Prj.Makr.Regexp_List |
| (1 .. Integer |
| (Patterns.Last (Arguments.Table (J).Foreign_Patterns))); |
| |
| begin |
| -- Build the Directories and Patterns arguments |
| |
| for Index in Directories'Range loop |
| Directories (Index) := |
| Arguments.Table (J).Directories.Table (Index); |
| end loop; |
| |
| for Index in Name_Patterns'Range loop |
| Name_Patterns (Index) := |
| Compile |
| (Arguments.Table (J).Name_Patterns.Table (Index).all, |
| Glob => True); |
| end loop; |
| |
| for Index in Excl_Patterns'Range loop |
| Excl_Patterns (Index) := |
| Compile |
| (Arguments.Table (J).Excluded_Patterns.Table (Index).all, |
| Glob => True); |
| end loop; |
| |
| for Index in Frgn_Patterns'Range loop |
| Frgn_Patterns (Index) := |
| Compile |
| (Arguments.Table (J).Foreign_Patterns.Table (Index).all, |
| Glob => True); |
| end loop; |
| |
| -- Call Prj.Makr.Process where the real work is done |
| |
| Prj.Makr.Process |
| (Directories => Directories, |
| Name_Patterns => Name_Patterns, |
| Excluded_Patterns => Excl_Patterns, |
| Foreign_Patterns => Frgn_Patterns); |
| end; |
| end loop; |
| |
| -- Finalize |
| |
| Prj.Makr.Finalize; |
| |
| if Opt.Verbose_Mode then |
| Write_Eol; |
| end if; |
| end Gnatname; |
