From 8bfa6c2fa3ce03a2d76028f6c2cee96653bfc26a Mon Sep 17 00:00:00 2001 From: Vincent Celier Date: Tue, 20 May 2008 14:47:03 +0200 Subject: [PATCH] 2008-05-20 Vincent Celier * 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 --- gcc/ada/gnatname.adb | 525 ++++++++++++++++++++++++++++++------------- 1 file changed, 373 insertions(+), 152 deletions(-) diff --git a/gcc/ada/gnatname.adb b/gcc/ada/gnatname.adb index 299e682bdc5..dbd7f509312 100644 --- a/gcc/ada/gnatname.adb +++ b/gcc/ada/gnatname.adb @@ -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 - - 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, @@ -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,103 +173,282 @@ 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; - 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; ----------- @@ -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; -- 2.30.2