-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2011, 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- --
+-- 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 COPYING. If not, write --
--- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
--- Boston, MA 02110-1301, USA. --
+-- 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 Gnatvsn; use Gnatvsn;
+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 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;
+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
-- Set to True by -c or -P switch.
-- Used to detect multiple -c/-P switches.
- package Excluded_Patterns is new Table.Table
+ 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 => 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_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 => 10,
- Table_Name => "Gnatname.Foreign_Patterns");
+ Table_Increment => 100,
+ Table_Name => "Gnatname.Arguments");
-- 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_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 Add_Source_Directory (S : String) is
begin
- Source_Directories.Increment_Last;
- Source_Directories.Table (Source_Directories.Last) := new String'(S);
+ Patterns.Append
+ (Arguments.Table (Arguments.Last).Directories, new String'(S));
end Add_Source_Directory;
---------------------
exception
when Name_Error =>
- Fail ("cannot open source directory """ & From_File & '"');
+ Fail ("cannot open source directory file """ & From_File & '"');
end Get_Directories;
--------------------
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.");
+ Display_Version ("GNATNAME", "2001");
end if;
end Output_Version;
---------------
procedure Scan_Args is
- begin
- Initialize_Option_Scan;
- -- Scan options first
+ procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
- loop
- case Getopt ("c: d: gnatep=! gnatep! gnateD! D: h P: v x: f:") is
- when ASCII.NUL =>
- exit;
+ Project_File_Name_Expected : Boolean;
- when 'c' =>
- if File_Set then
- Fail ("only one -P or -c switch may be specified");
- end if;
+ Pragmas_File_Expected : Boolean;
- File_Set := True;
- File_Path := new String'(Parameter);
- Create_Project := False;
+ Directory_Expected : Boolean;
- when 'd' =>
- Add_Source_Directory (Parameter);
+ Dir_File_Name_Expected : Boolean;
- when 'D' =>
- Get_Directories (Parameter);
+ Foreign_Pattern_Expected : Boolean;
- when 'f' =>
- Foreign_Patterns.Increment_Last;
- Foreign_Patterns.Table (Foreign_Patterns.Last) :=
- new String'(Parameter);
+ Excluded_Pattern_Expected : Boolean;
- when 'g' =>
- Preprocessor_Switches.Increment_Last;
- Preprocessor_Switches.Table (Preprocessor_Switches.Last) :=
- new String'('-' & Full_Switch & Parameter);
+ procedure Check_Regular_Expression (S : String);
+ -- Compile string S into a Regexp, fail if any error
- when 'h' =>
- Usage_Needed := True;
+ -----------------------------
+ -- Check_Regular_Expression--
+ -----------------------------
- when 'P' =>
- if File_Set then
- Fail ("only one -c or -P switch may be specified");
- end if;
+ 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;
- File_Set := True;
- File_Path := new String'(Parameter);
- Create_Project := True;
+ -- Start of processing for Scan_Args
- when 'v' =>
- if Opt.Verbose_Mode then
- Very_Verbose := True;
- else
- Opt.Verbose_Mode := True;
- end if;
+ begin
+ -- First check for --version or --help
- when 'x' =>
- Excluded_Patterns.Increment_Last;
- Excluded_Patterns.Table (Excluded_Patterns.Last) :=
- new String'(Parameter);
+ Check_Version_And_Help ("GNATNAME", "2001");
- when others =>
- null;
- end case;
- end loop;
+ -- Now scan the other switches
- -- Now, get the name patterns, if any
+ 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;
- loop
+ for Next_Arg in 1 .. Argument_Count loop
declare
- S : String := Get_Argument (Do_Expansion => False);
+ Next_Argv : constant String := Argument (Next_Arg);
+ Arg : String (1 .. Next_Argv'Length) := Next_Argv;
begin
- exit when S = "";
- Canonical_Case_File_Name (S);
- Patterns.Increment_Last;
- Patterns.Table (Patterns.Last) := new String'(S);
+ 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;
-
- exception
- when Invalid_Switch =>
- Fail ("invalid switch " & Full_Switch);
end Scan_Args;
-----------
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");
PATH : constant String :=
Absolute_Dir &
- Path_Separator &
- Getenv ("PATH").all;
+ Path_Separator &
+ Getenv ("PATH").all;
begin
Setenv ("PATH", PATH);
-- Initialize tables
- Excluded_Patterns.Set_Last (0);
- Foreign_Patterns.Set_Last (0);
- Patterns.Set_Last (0);
- Source_Directories.Set_Last (0);
+ 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
Usage;
end if;
- -- If no pattern was specified, print the usage and return
+ -- If no Ada or foreign pattern was specified, print the usage and return
- if Patterns.Last = 0 and Foreign_Patterns.Last = 0 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;
-- 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'(".");
+ if Patterns.Last
+ (Arguments.Table (Arguments.Last).Directories) = 0
+ then
+ Patterns.Append
+ (Arguments.Table (Arguments.Last).Directories, new String'("."));
end if;
+ -- Initialize
+
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
+ Prj.Makr.Initialize
(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);
+ 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;
OSDN Git Service
