-- --
------------------------------------------------------------------------------
+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 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 => 100,
- 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 => 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,
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;
--------------------
procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
- -- Start of processing for Scan_Args
+ Project_File_Name_Expected : Boolean;
- begin
- -- First check for --version or --help
+ Pragmas_File_Expected : Boolean;
- Check_Version_And_Help ("GNATNAME", "2001");
+ Directory_Expected : Boolean;
- -- Now scan the other switches
-
- Initialize_Option_Scan;
+ Dir_File_Name_Expected : Boolean;
- -- Scan options first
+ Foreign_Pattern_Expected : Boolean;
- loop
- case Getopt
- ("-subdirs=! c: d: gnatep=! gnatep! gnateD! eL D: h P: v x: f:")
- is
- when ASCII.NUL =>
- exit;
+ Excluded_Pattern_Expected : Boolean;
- when '-' =>
- Subdirs := new String'(Parameter);
-
- when 'c' =>
- if File_Set then
- Fail ("only one -P or -c switch may be specified");
- end if;
+ procedure Check_Regular_Expression (S : String);
+ -- Compile string S into a Regexp. Fail if any error.
- File_Set := True;
- File_Path := new String'(Parameter);
- Create_Project := False;
+ -----------------------------
+ -- Check_Regular_Expression--
+ -----------------------------
- when 'd' =>
- Add_Source_Directory (Parameter);
-
- when 'D' =>
- Get_Directories (Parameter);
+ 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
- when 'e' =>
- Opt.Follow_Links_For_Files := True;
+ Check_Version_And_Help ("GNATNAME", "2001");
- when 'f' =>
- Foreign_Patterns.Increment_Last;
- Foreign_Patterns.Table (Foreign_Patterns.Last) :=
- new String'(Parameter);
+ -- Now scan the other switches
- when 'g' =>
- Preprocessor_Switches.Increment_Last;
- Preprocessor_Switches.Table (Preprocessor_Switches.Last) :=
- new String'('-' & Full_Switch & Parameter);
+ 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;
- when 'h' =>
- Usage_Needed := True;
+ begin
+ 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;
- when 'P' =>
- if File_Set then
- Fail ("only one -c or -P switch may be specified");
- end if;
+ if Next_Arg = Argument_Count then
+ Fail ("excluded pattern missing");
+ end if;
- File_Set := True;
- File_Path := new String'(Parameter);
- Create_Project := True;
+ 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);
- when 'v' =>
- if Opt.Verbose_Mode then
- Very_Verbose := True;
else
- Opt.Verbose_Mode := True;
+ Canonical_Case_File_Name (Arg);
+ Patterns.Append
+ (Arguments.Table (Arguments.Last).Name_Patterns,
+ new String'(Arg));
+ Check_Regular_Expression (Arg);
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 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:");
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");
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);
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;
projects / gcc.git / commitdiff