URL
https://opencores.org/ocsvn/scarts/scarts/trunk
Subversion Repositories scarts
[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [ada/] [gnatname.adb] - Rev 20
Go to most recent revision | Compare with Previous | Blame | View Log
------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- G N A T N A M E -- -- -- -- B o d y -- -- -- -- Copyright (C) 2001-2005 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; 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-2005 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;
Go to most recent revision | Compare with Previous | Blame | View Log