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