OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

2008-05-20 Vincent Celier <celier@adacore.com>

Browse Source 
* gnatname.adb
	(Scan_Args): Rewrite to take into account new switch --and to separate
	arguments into sections.
	(Gnatname): Call Prj.Makr.Initialize, then Prj.Makr.Process for each
	section, then Finalize.

From-SVN: r135629
This commit is contained in:
Vincent Celier 2008-05-20 14:47:03 +02:00 committed by Arnaud Charlet
parent d677afa958
commit 8bfa6c2fa3
1 changed files with 378 additions and 157 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

535
gcc/ada/gnatname.adb
View File

@ -23,6 +23,12 @@
-- --
------------------------------------------------------------------------------
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;
@ -32,13 +38,12 @@ 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
@ -61,43 +66,30 @@ procedure Gnatname is
-- 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 => 100,
Table_Name => "Gnatname.Excluded_Patterns");
-- Table to accumulate the negative patterns
Table_Increment => 100);
-- Table to accumulate the patterns
package Foreign_Patterns is new Table.Table
(Table_Component_Type => String_Access,
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.Foreign_Patterns");
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 => 100,
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 => 100,
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,
@ -129,8 +121,8 @@ procedure Gnatname is
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;
---------------------
@ -157,7 +149,7 @@ procedure Gnatname is
exception
when Name_Error =>
Fail ("cannot open source directory """ & From_File & '"');
Fail ("cannot open source directory file """ & From_File & '"');
end Get_Directories;
--------------------
@ -181,8 +173,34 @@ procedure Gnatname is
procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
-- Start of processing for Scan_Args
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;
begin
-- First check for --version or --help
@ -190,94 +208,247 @@ procedure Gnatname is
-- Now scan the other switches
Initialize_Option_Scan;
-- Scan options first
loop
case Getopt
("-subdirs=! c: d: gnatep=! gnatep! gnateD! eL D: h P: v x: f:")
is
when ASCII.NUL =>
exit;
when '-' =>
Subdirs := new String'(Parameter);
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 'e' =>
Opt.Follow_Links_For_Files := True;
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
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
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
if Project_File_Name_Expected then
-- -P xxx
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;
elsif Pragmas_File_Expected then
-- -c file
File_Set := True;
File_Path := new String'(Arg);
Create_Project := False;
Pragmas_File_Expected := False;
elsif Directory_Expected then
-- -d xxx
Add_Source_Directory (Arg);
Directory_Expected := False;
elsif Dir_File_Name_Expected then
-- -D xxx
Get_Directories (Arg);
Dir_File_Name_Expected := False;
elsif Foreign_Pattern_Expected then
-- -f xxx
Patterns.Append
(Arguments.Table (Arguments.Last).Foreign_Patterns,
new String'(Arg));
Check_Regular_Expression (Arg);
Foreign_Pattern_Expected := False;
elsif Excluded_Pattern_Expected then
-- -x xxx
Patterns.Append
(Arguments.Table (Arguments.Last).Excluded_Patterns,
new String'(Arg));
Check_Regular_Expression (Arg);
Excluded_Pattern_Expected := False;
elsif Arg = "--and" then
-- There must be at least one Ada pattern or one foreign
-- pattern for the previous section.
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 another component in table Arguments and initialize
-- it.
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);
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));
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;
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;
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;
elsif Arg = "-eL" then
Opt.Follow_Links_For_Files := True;
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;
elsif Arg'Length > 7 and then
(Arg (1 .. 7) = "-gnatep" or else Arg (1 .. 7) = "-gnateD")
then
Preprocessor_Switches.Append (new String'(Arg));
elsif Arg = "-h" then
Usage_Needed := True;
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;
elsif Arg = "-v" then
if Opt.Verbose_Mode then
Very_Verbose := True;
else
Opt.Verbose_Mode := True;
end if;
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;
elsif Arg (1) = '-' then
Fail ("wrong switch: " & Arg);
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;
-----------
@ -292,12 +463,16 @@ procedure Gnatname is
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");
@ -339,8 +514,8 @@ begin
PATH : constant String :=
Absolute_Dir &
Path_Separator &
Getenv ("PATH").all;
Path_Separator &
Getenv ("PATH").all;
begin
Setenv ("PATH", PATH);
@ -354,10 +529,17 @@ begin
-- 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
@ -372,9 +554,12 @@ begin
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;
@ -384,55 +569,91 @@ begin
-- 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);
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;