Subversion Repositories openrisc

------------------------------------------------------------------------------

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                             G N A T N A M E                              --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

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

   Usage_Needed : Boolean := False;

   --  Set to True by -h switch

   Version_Output : Boolean := False;

   --  Set to True when version is output, to avoid multiple output

   Very_Verbose : Boolean := False;

   --  Set to True with -v -v

   Create_Project : Boolean := False;

   --  Set to True with a -P switch

   File_Path : String_Access := new String'("gnat.adc");

   --  Path name of the file specified by -c or -P switch

   File_Set : Boolean := False;

   --  Set to True by -c or -P switch.

   --  Used to detect multiple -c/-P switches.

   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 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.Arguments");

   --  Table to accumulate the foreign patterns

   package Preprocessor_Switches 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.Preprocessor_Switches");

   --  Table to store the preprocessor switches to be used in the call

   --  to the compiler.

   procedure Output_Version;

   --  Print name and version

   procedure Usage;

   --  Print usage

   procedure Scan_Args;

   --  Scan the command line arguments

   procedure Add_Source_Directory (S : String);

   --  Add S in the Source_Directories table

   procedure Get_Directories (From_File : String);

   --  Read a source directory text file

   --------------------------

   -- Add_Source_Directory --

   --------------------------

   procedure Add_Source_Directory (S : String) is

   begin

      Patterns.Append

        (Arguments.Table (Arguments.Last).Directories, new String'(S));

   end Add_Source_Directory;

   ---------------------

   -- Get_Directories --

   ---------------------

   procedure Get_Directories (From_File : String) is

      File : Ada.Text_IO.File_Type;

      Line : String (1 .. 2_000);

      Last : Natural;

   begin

      Open (File, In_File, From_File);

      while not End_Of_File (File) loop

         Get_Line (File, Line, Last);

         if Last /= 0 then

            Add_Source_Directory (Line (1 .. Last));

         end if;

      end loop;

      Close (File);

   exception

      when Name_Error =>

         Fail ("cannot open source directory file """ & From_File & '"');

   end Get_Directories;

   --------------------

   -- Output_Version --

   --------------------

   procedure Output_Version is

   begin

      if not Version_Output then

         Version_Output := True;

         Output.Write_Eol;

         Display_Version ("GNATNAME", "2001");

      end if;

   end Output_Version;

   ---------------

   -- Scan_Args --

   ---------------

   procedure Scan_Args is

      procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);

      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;

   --  Start of processing for Scan_Args

   begin

      --  First check for --version or --help

      Check_Version_And_Help ("GNATNAME", "2001");

      --  Now scan the other switches

      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;

         begin

            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;

   end Scan_Args;

   -----------

   -- Usage --

   -----------

   procedure Usage is

   begin

      if not Usage_Output then

         Usage_Needed := False;

         Usage_Output := True;

         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");

         Write_Line ("  -h           output this help message");

         Write_Line ("  -Pproj       update or create project file proj");

         Write_Line ("  -v           verbose output");

         Write_Line ("  -v -v        very verbose output");

         Write_Line ("  -xpat        exclude pattern pat");

      end if;

   end Usage;

--  Start of processing for Gnatname

begin

   --  Add the directory where gnatname is invoked in front of the

   --  path, if gnatname is invoked with directory information.

   --  Only do this if the platform is not VMS, where the notion of path

   --  does not really exist.

   if not Hostparm.OpenVMS then

      declare

         Command : constant String := Command_Name;

      begin

         for Index in reverse Command'Range loop

            if Command (Index) = Directory_Separator then

               declare

                  Absolute_Dir : constant String :=

                                   Normalize_Pathname

                                     (Command (Command'First .. Index));

                  PATH         : constant String :=

                                   Absolute_Dir &

                                   Path_Separator &

                                   Getenv ("PATH").all;

               begin

                  Setenv ("PATH", PATH);

               end;

               exit;

            end if;

         end loop;

      end;

   end if;

   --  Initialize tables

   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

   Scan_Args;

   if Opt.Verbose_Mode then

      Output_Version;

   end if;

   if Usage_Needed then

      Usage;

   end if;

   --  If no Ada or foreign pattern was specified, print the usage and return

   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 source directory was specified, use the current directory as the

   --  unique directory. Note that if a file was specified with directory

   --  information, the current directory is the directory of the specified

   --  file.

   if Patterns.Last

     (Arguments.Table (Arguments.Last).Directories) = 0

   then

      Patterns.Append

        (Arguments.Table (Arguments.Last).Directories, new String'("."));

   end if;

   --  Initialize

   declare

      Prep_Switches : Argument_List

                        (1 .. Integer (Preprocessor_Switches.Last));

   begin

      for Index in Prep_Switches'Range loop

         Prep_Switches (Index) := Preprocessor_Switches.Table (Index);

      end loop;

      Prj.Makr.Initialize

        (File_Path         => File_Path.all,

         Project_File      => Create_Project,

         Preproc_Switches  => Prep_Switches,

         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;

end Gnatname;