aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.2.1/gcc/ada/gnatname.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.2.1/gcc/ada/gnatname.adb')
-rw-r--r--gcc-4.2.1/gcc/ada/gnatname.adb418
1 files changed, 418 insertions, 0 deletions
diff --git a/gcc-4.2.1/gcc/ada/gnatname.adb b/gcc-4.2.1/gcc/ada/gnatname.adb
new file mode 100644
index 000000000..b746ba02f
--- /dev/null
+++ b/gcc-4.2.1/gcc/ada/gnatname.adb
@@ -0,0 +1,418 @@
+------------------------------------------------------------------------------
+-- --
+-- 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;