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

	* 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

@@ -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;