diff options
Diffstat (limited to 'gcc-4.4.0/gcc/ada/gnatname.adb')
| -rw-r--r-- | gcc-4.4.0/gcc/ada/gnatname.adb | 691 |
1 files changed, 0 insertions, 691 deletions
diff --git a/gcc-4.4.0/gcc/ada/gnatname.adb b/gcc-4.4.0/gcc/ada/gnatname.adb deleted file mode 100644 index d684551ed..000000000 --- a/gcc-4.4.0/gcc/ada/gnatname.adb +++ /dev/null @@ -1,691 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- G N A T N A M E -- --- -- --- B o d y -- --- -- --- Copyright (C) 2001-2008, 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 - - Arguments.Increment_Last; - - 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; - - -- -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:"); - - 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 - Prj.Set_Mode (Prj.Ada_Only); - - -- 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); - Arguments.Increment_Last; - 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); - 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; |