xr_tabls.adb   [plain text]


------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                             X R  _ T A B L S                             --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                                                                          --
--          Copyright (C) 1998-2002 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 2,  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 COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- Extensive contributions were provided by Ada Core Technologies Inc.   --
--                                                                          --
------------------------------------------------------------------------------

with Osint;
with Unchecked_Deallocation;

with Ada.IO_Exceptions;
with Ada.Strings.Fixed;
with Ada.Strings;
with Ada.Text_IO;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;

with GNAT.IO_Aux;
with GNAT.OS_Lib;               use GNAT.OS_Lib;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;

package body Xr_Tabls is

   function Base_File_Name (File : String) return String;
   --  Return the base file name for File (ie not including the directory)

   function Dir_Name (File : String; Base : String := "") return String;
   --  Return the directory name of File, or "" if there is no directory part
   --  in File.
   --  This includes the last separator at the end, and always return an
   --  absolute path name (directories are relative to Base, or the current
   --  directory if Base is "")

   Dir_Sep       : Character renames GNAT.OS_Lib.Directory_Separator;

   Files         : File_Table;
   Entities      : Entity_Table;
   Directories   : Project_File_Ptr;
   Default_Match : Boolean := False;

   ---------------------
   -- Add_Declaration --
   ---------------------

   function Add_Declaration
     (File_Ref  : File_Reference;
      Symbol    : String;
      Line      : Natural;
      Column    : Natural;
      Decl_Type : Character)
      return      Declaration_Reference
   is
      The_Entities : Declaration_Reference := Entities.Table;
      New_Decl     : Declaration_Reference;
      Result       : Compare_Result;
      Prev         : Declaration_Reference := null;

   begin
      --  Check if the identifier already exists in the table

      while The_Entities /= null loop
         Result := Compare (The_Entities, File_Ref, Line, Column, Symbol);
         exit when Result = GreaterThan;

         if Result = Equal then
            return The_Entities;
         end if;

         Prev := The_Entities;
         The_Entities  := The_Entities.Next;
      end loop;

      --  Insert the Declaration in the table

      New_Decl :=
        new Declaration_Record'
          (Symbol_Length => Symbol'Length,
           Symbol        => Symbol,
           Decl          => (File          => File_Ref,
                             Line          => Line,
                             Column        => Column,
                             Source_Line   => Null_Unbounded_String,
                             Next          => null),
           Decl_Type     => Decl_Type,
           Body_Ref      => null,
           Ref_Ref       => null,
           Modif_Ref     => null,
           Match         => Default_Match
                              or else Match (File_Ref, Line, Column),
           Par_Symbol    => null,
           Next          => null);

      if Prev = null then
         New_Decl.Next  := Entities.Table;
         Entities.Table := New_Decl;
      else
         New_Decl.Next  := Prev.Next;
         Prev.Next      := New_Decl;
      end if;

      if New_Decl.Match then
         Files.Longest_Name := Natural'Max (File_Ref.File'Length,
                                            Files.Longest_Name);
      end if;

      return New_Decl;
   end Add_Declaration;

   ----------------------
   -- Add_To_Xref_File --
   ----------------------

   procedure Add_To_Xref_File
     (File_Name       : String;
      File_Existed    : out Boolean;
      Ref             : out File_Reference;
      Visited         : Boolean := True;
      Emit_Warning    : Boolean := False;
      Gnatchop_File   : String  := "";
      Gnatchop_Offset : Integer := 0)
   is
      The_Files : File_Reference  := Files.Table;
      Base      : constant String := Base_File_Name (File_Name);
      Dir       : constant String := Xr_Tabls.Dir_Name (File_Name);
      Dir_Acc   : String_Access   := null;

   begin
      --  Do we have a directory name as well?

      if Dir /= "" then
         Dir_Acc := new String' (Dir);
      end if;

      --  Check if the file already exists in the table

      while The_Files /= null loop

         if The_Files.File = File_Name then
            File_Existed      := True;
            Ref               := The_Files;
            return;
         end if;

         The_Files := The_Files.Next;
      end loop;

      Ref := new File_Record'
        (File_Length     => Base'Length,
         File            => Base,
         Dir             => Dir_Acc,
         Lines           => null,
         Visited         => Visited,
         Emit_Warning    => Emit_Warning,
         Gnatchop_File   => new String' (Gnatchop_File),
         Gnatchop_Offset => Gnatchop_Offset,
         Next            => Files.Table);
      Files.Table := Ref;
      File_Existed := False;
   end Add_To_Xref_File;

   --------------
   -- Add_Line --
   --------------

   procedure Add_Line
     (File   : File_Reference;
      Line   : Natural;
      Column : Natural)
   is
   begin
      File.Lines := new Ref_In_File'(Line   => Line,
                                     Column => Column,
                                     Next   => File.Lines);
   end Add_Line;

   ----------------
   -- Add_Parent --
   ----------------

   procedure Add_Parent
     (Declaration : in out Declaration_Reference;
      Symbol      : String;
      Line        : Natural;
      Column      : Natural;
      File_Ref    : File_Reference)
   is
   begin
      Declaration.Par_Symbol := new Declaration_Record'
        (Symbol_Length => Symbol'Length,
         Symbol        => Symbol,
         Decl          => (File         => File_Ref,
                           Line         => Line,
                           Column       => Column,
                           Source_Line  => Null_Unbounded_String,
                           Next         => null),
         Decl_Type     => ' ',
         Body_Ref      => null,
         Ref_Ref       => null,
         Modif_Ref     => null,
         Match         => False,
         Par_Symbol    => null,
         Next          => null);
   end Add_Parent;

   -------------------
   -- Add_Reference --
   -------------------

   procedure Add_Reference
     (Declaration : Declaration_Reference;
      File_Ref    : File_Reference;
      Line        : Natural;
      Column      : Natural;
      Ref_Type    : Character)
   is
      procedure Free is new Unchecked_Deallocation
        (Reference_Record, Reference);

      Ref     : Reference;
      Prev    : Reference := null;
      Result  : Compare_Result;
      New_Ref : Reference := new Reference_Record'
        (File   => File_Ref,
         Line   => Line,
         Column => Column,
         Source_Line => Null_Unbounded_String,
         Next   => null);

   begin
      case Ref_Type is
         when 'b' | 'c' =>
            Ref := Declaration.Body_Ref;

         when 'r' | 'i' | 'l' | ' ' | 'x' =>
            Ref := Declaration.Ref_Ref;

         when 'm'       =>
            Ref := Declaration.Modif_Ref;

         when 'e' | 't' | 'p' =>
            return;

         when others    =>
            Ada.Text_IO.Put_Line ("Unknown reference type: " & Ref_Type);
            return;
      end case;

      --  Check if the reference already exists

      while Ref /= null loop
         Result := Compare (New_Ref, Ref);
         exit when Result = LessThan;

         if Result = Equal then
            Free (New_Ref);
            return;
         end if;

         Prev := Ref;
         Ref  := Ref.Next;
      end loop;

      --  Insert it in the list

      if Prev /= null then
         New_Ref.Next := Prev.Next;
         Prev.Next := New_Ref;

      else
         case Ref_Type is
            when 'b' | 'c' =>
               New_Ref.Next          := Declaration.Body_Ref;
               Declaration.Body_Ref  := New_Ref;

            when 'r' | 'i' | 'l' | ' ' | 'x' =>
               New_Ref.Next          := Declaration.Ref_Ref;
               Declaration.Ref_Ref   := New_Ref;

            when 'm' =>
               New_Ref.Next          := Declaration.Modif_Ref;
               Declaration.Modif_Ref := New_Ref;

            when others =>
               null;
         end case;
      end if;

      if not Declaration.Match then
         Declaration.Match := Match (File_Ref, Line, Column);
      end if;

      if Declaration.Match then
         Files.Longest_Name := Natural'Max (File_Ref.File'Length,
                                            Files.Longest_Name);
      end if;
   end Add_Reference;

   -------------------
   -- ALI_File_Name --
   -------------------

   function ALI_File_Name (Ada_File_Name : String) return String is
      Index : Natural := Ada.Strings.Fixed.Index
                          (Ada_File_Name, ".", Going => Ada.Strings.Backward);

   begin
      if Index /= 0 then
         return Ada_File_Name (Ada_File_Name'First .. Index)
           & "ali";
      else
         return Ada_File_Name & ".ali";
      end if;
   end ALI_File_Name;

   --------------------
   -- Base_File_Name --
   --------------------

   function Base_File_Name (File : String) return String is
   begin
      for J in reverse File'Range loop
         if File (J) = '/' or else File (J) = Dir_Sep then
            return File (J + 1 .. File'Last);
         end if;
      end loop;

      return File;
   end Base_File_Name;

   -------------
   -- Compare --
   -------------

   function Compare
     (Ref1 : Reference;
      Ref2 : Reference)
      return Compare_Result
   is
   begin
      if Ref1 = null then
         return GreaterThan;
      elsif Ref2 = null then
         return LessThan;
      end if;

      if Ref1.File.File < Ref2.File.File then
         return LessThan;

      elsif Ref1.File.File = Ref2.File.File then
         if Ref1.Line < Ref2.Line then
            return LessThan;

         elsif Ref1.Line = Ref2.Line then
            if Ref1.Column < Ref2.Column then
               return LessThan;
            elsif Ref1.Column = Ref2.Column then
               return Equal;
            else
               return GreaterThan;
            end if;

         else
            return GreaterThan;
         end if;

      else
         return GreaterThan;
      end if;
   end Compare;

   -------------
   -- Compare --
   -------------

   function Compare
     (Decl1 : Declaration_Reference;
      File2 : File_Reference;
      Line2 : Integer;
      Col2  : Integer;
      Symb2 : String)
      return  Compare_Result
   is
   begin
      if Decl1 = null then
         return GreaterThan;
      end if;

      if Decl1.Symbol < Symb2 then
         return LessThan;
      elsif Decl1.Symbol > Symb2 then
         return GreaterThan;
      end if;

      if Decl1.Decl.File.File < Get_File (File2) then
         return LessThan;

      elsif Decl1.Decl.File.File = Get_File (File2) then
         if Decl1.Decl.Line < Line2 then
            return LessThan;

         elsif Decl1.Decl.Line = Line2 then
            if Decl1.Decl.Column < Col2 then
               return LessThan;

            elsif Decl1.Decl.Column = Col2 then
               return Equal;

            else
               return GreaterThan;
            end if;

         else
            return GreaterThan;
         end if;

      else
         return GreaterThan;
      end if;
   end Compare;

   -------------------------
   -- Create_Project_File --
   -------------------------

   procedure Create_Project_File
     (Name           : String)
   is
      use Ada.Strings.Unbounded;

      Obj_Dir     : Unbounded_String := Null_Unbounded_String;
      Src_Dir     : Unbounded_String := Null_Unbounded_String;
      Build_Dir   : Unbounded_String;

      Gnatls_Src_Cache : Unbounded_String;
      Gnatls_Obj_Cache : Unbounded_String;

      F           : File_Descriptor;
      Len         : Positive;
      File_Name   : aliased String := Name & ASCII.NUL;

   begin

      --  Read the size of the file
      F := Open_Read (File_Name'Address, Text);

      --  Project file not found
      if F /= Invalid_FD then
         Len := Positive (File_Length (F));

         declare
            Buffer : String (1 .. Len);
            Index  : Positive := Buffer'First;
            Last   : Positive;
         begin
            Len := Read (F, Buffer'Address, Len);
            Close (F);

            --  First, look for Build_Dir, since all the source and object
            --  path are relative to it.

            while Index <= Buffer'Last loop

               --  find the end of line

               Last := Index;
               while Last <= Buffer'Last
                 and then Buffer (Last) /= ASCII.LF
                 and then Buffer (Last) /= ASCII.CR
               loop
                  Last := Last + 1;
               end loop;

               if Index <= Buffer'Last - 9
                 and then Buffer (Index .. Index + 9) = "build_dir="
               then
                  Index := Index + 10;
                  while Index <= Last
                    and then (Buffer (Index) = ' '
                              or else Buffer (Index) = ASCII.HT)
                  loop
                     Index := Index + 1;
                  end loop;

                  Build_Dir :=
                    To_Unbounded_String (Buffer (Index .. Last - 1));
                  if Buffer (Last - 1) /= Dir_Sep then
                     Append (Build_Dir, Dir_Sep);
                  end if;
               end if;

               Index := Last + 1;

               --  In case we had a ASCII.CR/ASCII.LF end of line, skip the
               --  remaining symbol

               if Index <= Buffer'Last
                 and then Buffer (Index) = ASCII.LF
               then
                  Index := Index + 1;
               end if;
            end loop;

            --  Now parse the source and object paths

            Index := Buffer'First;
            while Index <= Buffer'Last loop

               --  find the end of line

               Last := Index;
               while Last <= Buffer'Last
                 and then Buffer (Last) /= ASCII.LF
                 and then Buffer (Last) /= ASCII.CR
               loop
                  Last := Last + 1;
               end loop;

               if Index <= Buffer'Last - 7
                 and then Buffer (Index .. Index + 7) = "src_dir="
               then
                  declare
                     S : String := Ada.Strings.Fixed.Trim
                       (Buffer (Index + 8 .. Last - 1), Ada.Strings.Both);
                  begin
                     --  A relative directory ?
                     if S (S'First) /= Dir_Sep then
                        Append (Src_Dir, Build_Dir);
                     end if;

                     if S (S'Last) = Dir_Sep then
                        Append (Src_Dir, S & " ");
                     else
                        Append (Src_Dir, S & Dir_Sep & " ");
                     end if;
                  end;

               elsif Index <= Buffer'Last - 7
                 and then Buffer (Index .. Index + 7) = "obj_dir="
               then
                  declare
                     S : String := Ada.Strings.Fixed.Trim
                       (Buffer (Index + 8 .. Last - 1), Ada.Strings.Both);
                  begin
                     --  A relative directory ?
                     if S (S'First) /= Dir_Sep then
                        Append (Obj_Dir, Build_Dir);
                     end if;

                     if S (S'Last) = Dir_Sep then
                        Append (Obj_Dir, S & " ");
                     else
                        Append (Obj_Dir, S & Dir_Sep & " ");
                     end if;
                  end;
               end if;

               --  In case we had a ASCII.CR/ASCII.LF end of line, skip the
               --  remaining symbol
               Index := Last + 1;

               if Index <= Buffer'Last
                 and then Buffer (Index) = ASCII.LF
               then
                  Index := Index + 1;
               end if;
            end loop;
         end;
      end if;

      Parse_Gnatls (Gnatls_Src_Cache, Gnatls_Obj_Cache);

      Directories := new Project_File'
        (Src_Dir_Length     => Length (Src_Dir) + Length (Gnatls_Src_Cache),
         Obj_Dir_Length     => Length (Obj_Dir) + Length (Gnatls_Obj_Cache),
         Src_Dir            => To_String (Src_Dir & Gnatls_Src_Cache),
         Obj_Dir            => To_String (Obj_Dir & Gnatls_Obj_Cache),
         Src_Dir_Index      => 1,
         Obj_Dir_Index      => 1,
         Last_Obj_Dir_Start => 0);
   end Create_Project_File;

   ---------------------
   -- Current_Obj_Dir --
   ---------------------

   function Current_Obj_Dir return String is
   begin
      return Directories.Obj_Dir (Directories.Last_Obj_Dir_Start
                                  .. Directories.Obj_Dir_Index - 2);
   end Current_Obj_Dir;

   --------------
   -- Dir_Name --
   --------------

   function Dir_Name (File : String; Base : String := "") return String is
   begin
      for J in reverse File'Range loop
         if File (J) = '/' or else File (J) = Dir_Sep then

            --  Is this an absolute directory ?
            if File (File'First) = '/'
              or else File (File'First) = Dir_Sep
            then
               return File (File'First .. J);

            --  Else do we know the base directory ?
            elsif Base /= "" then
               return Base & File (File'First .. J);

            else
               declare
                  Max_Path : Integer;
                  pragma Import (C, Max_Path, "__gnat_max_path_len");

                  Base2 : Dir_Name_Str (1 .. Max_Path);
                  Last  : Natural;
               begin
                  Get_Current_Dir (Base2, Last);
                  return Base2 (Base2'First .. Last) & File (File'First .. J);
               end;
            end if;
         end if;
      end loop;
      return "";
   end Dir_Name;

   -------------------
   -- Find_ALI_File --
   -------------------

   function Find_ALI_File (Short_Name  : String) return String is
      use type Ada.Strings.Unbounded.String_Access;
      Old_Obj_Dir : constant Integer := Directories.Obj_Dir_Index;

   begin
      Reset_Obj_Dir;

      loop
         declare
            Obj_Dir : String := Next_Obj_Dir;
         begin
            exit when Obj_Dir'Length = 0;
            if GNAT.IO_Aux.File_Exists (Obj_Dir & Short_Name) then
               Directories.Obj_Dir_Index := Old_Obj_Dir;
               return Obj_Dir;
            end if;
         end;
      end loop;

      --  Finally look in the standard directories

      Directories.Obj_Dir_Index := Old_Obj_Dir;
      return "";
   end Find_ALI_File;

   ----------------------
   -- Find_Source_File --
   ----------------------

   function Find_Source_File (Short_Name  : String) return String is
      use type Ada.Strings.Unbounded.String_Access;

   begin
      Reset_Src_Dir;
      loop
         declare
            Src_Dir : String := Next_Src_Dir;
         begin
            exit when Src_Dir'Length = 0;

            if GNAT.IO_Aux.File_Exists (Src_Dir & Short_Name) then
               return Src_Dir;
            end if;
         end;
      end loop;

      --  Finally look in the standard directories

      return "";
   end Find_Source_File;

   ----------------
   -- First_Body --
   ----------------

   function First_Body (Decl : Declaration_Reference) return Reference is
   begin
      return Decl.Body_Ref;
   end First_Body;

   -----------------------
   -- First_Declaration --
   -----------------------

   function First_Declaration return Declaration_Reference is
   begin
      return Entities.Table;
   end First_Declaration;

   -----------------
   -- First_Modif --
   -----------------

   function First_Modif (Decl : Declaration_Reference) return Reference is
   begin
      return Decl.Modif_Ref;
   end First_Modif;

   ---------------------
   -- First_Reference --
   ---------------------

   function First_Reference (Decl : Declaration_Reference) return Reference is
   begin
      return Decl.Ref_Ref;
   end First_Reference;

   ----------------
   -- Get_Column --
   ----------------

   function Get_Column (Decl : Declaration_Reference) return String is
   begin
      return Ada.Strings.Fixed.Trim (Natural'Image (Decl.Decl.Column),
                                     Ada.Strings.Left);
   end Get_Column;

   function Get_Column (Ref : Reference) return String is
   begin
      return Ada.Strings.Fixed.Trim (Natural'Image (Ref.Column),
                                     Ada.Strings.Left);
   end Get_Column;

   ---------------------
   -- Get_Declaration --
   ---------------------

   function Get_Declaration
     (File_Ref : File_Reference;
      Line     : Natural;
      Column   : Natural)
      return     Declaration_Reference
   is
      The_Entities : Declaration_Reference := Entities.Table;
   begin
      while The_Entities /= null loop
         if The_Entities.Decl.Line = Line
           and then The_Entities.Decl.Column = Column
           and then The_Entities.Decl.File = File_Ref
         then
            return The_Entities;
         else
            The_Entities := The_Entities.Next;
         end if;
      end loop;

      return Empty_Declaration;
   end Get_Declaration;

   ----------------------
   -- Get_Emit_Warning --
   ----------------------

   function Get_Emit_Warning (File : File_Reference) return Boolean is
   begin
      return File.Emit_Warning;
   end Get_Emit_Warning;

   --------------
   -- Get_File --
   --------------

   function Get_File
     (Decl     : Declaration_Reference;
      With_Dir : Boolean := False)
      return     String
   is
   begin
      return Get_File (Decl.Decl.File, With_Dir);
   end Get_File;

   function Get_File
     (Ref      : Reference;
      With_Dir : Boolean := False)
      return     String
   is
   begin
      return Get_File (Ref.File, With_Dir);
   end Get_File;

   function Get_File
     (File     : File_Reference;
      With_Dir : in Boolean := False;
      Strip    : Natural := 0)
      return     String
   is
      function Internal_Strip (Full_Name : String) return String;
      --  Internal function to process the Strip parameter

      --------------------
      -- Internal_Strip --
      --------------------

      function Internal_Strip (Full_Name : String) return String is
         Unit_End, Extension_Start : Natural;
         S : Natural := Strip;
      begin
         if Strip = 0 then
            return Full_Name;
         end if;

         --  Isolate the file extension

         Extension_Start := Full_Name'Last;
         while Extension_Start >= Full_Name'First
           and then Full_Name (Extension_Start) /= '.'
         loop
            Extension_Start := Extension_Start - 1;
         end loop;

         --  Strip the right number of subunit_names

         Unit_End := Extension_Start - 1;
         while Unit_End >= Full_Name'First
           and then S > 0
         loop
            if Full_Name (Unit_End) = '-' then
               S := S - 1;
            end if;
            Unit_End := Unit_End - 1;
         end loop;

         if Unit_End < Full_Name'First then
            return "";
         else
            return Full_Name (Full_Name'First .. Unit_End)
              & Full_Name (Extension_Start .. Full_Name'Last);
         end if;
      end Internal_Strip;

   begin
      --  If we do not want the full path name

      if not With_Dir then
         return Internal_Strip (File.File);
      end if;

      if File.Dir = null then

         if Ada.Strings.Fixed.Tail (File.File, 3) = "ali" then
            File.Dir := new String'(Find_ALI_File (File.File));
         else
            File.Dir := new String'(Find_Source_File (File.File));
         end if;
      end if;

      return Internal_Strip (File.Dir.all & File.File);
   end Get_File;

   ------------------
   -- Get_File_Ref --
   ------------------

   function Get_File_Ref (Ref : Reference) return File_Reference is
   begin
      return Ref.File;
   end Get_File_Ref;

   -----------------------
   -- Get_Gnatchop_File --
   -----------------------

   function Get_Gnatchop_File
     (File : File_Reference; With_Dir : Boolean := False) return String is
   begin
      if File.Gnatchop_File.all = "" then
         return Get_File (File, With_Dir);
      else
         return File.Gnatchop_File.all;
      end if;
   end Get_Gnatchop_File;

   -----------------------
   -- Get_Gnatchop_File --
   -----------------------

   function Get_Gnatchop_File
     (Ref : Reference; With_Dir : Boolean := False) return String is
   begin
      return Get_Gnatchop_File (Ref.File, With_Dir);
   end Get_Gnatchop_File;

   -----------------------
   -- Get_Gnatchop_File --
   -----------------------

   function Get_Gnatchop_File
     (Decl : Declaration_Reference; With_Dir : Boolean := False) return String
   is
   begin
      return Get_Gnatchop_File (Decl.Decl.File, With_Dir);
   end Get_Gnatchop_File;

   --------------
   -- Get_Line --
   --------------

   function Get_Line (Decl : Declaration_Reference) return String is
   begin
      return Ada.Strings.Fixed.Trim (Natural'Image (Decl.Decl.Line),
                                     Ada.Strings.Left);
   end Get_Line;

   function Get_Line (Ref : Reference) return String is
   begin
      return Ada.Strings.Fixed.Trim (Natural'Image (Ref.Line),
                                     Ada.Strings.Left);
   end Get_Line;

   ----------------
   -- Get_Parent --
   ----------------

   function Get_Parent
     (Decl : Declaration_Reference)
     return Declaration_Reference is
   begin
      return Decl.Par_Symbol;
   end Get_Parent;

   ---------------------
   -- Get_Source_Line --
   ---------------------

   function Get_Source_Line (Ref : Reference) return String is
   begin
      return To_String (Ref.Source_Line);
   end Get_Source_Line;

   function Get_Source_Line (Decl : Declaration_Reference) return String is
   begin
      return To_String (Decl.Decl.Source_Line);
   end Get_Source_Line;

   ----------------
   -- Get_Symbol --
   ----------------

   function Get_Symbol (Decl : Declaration_Reference) return String is
   begin
      return Decl.Symbol;
   end Get_Symbol;

   --------------
   -- Get_Type --
   --------------

   function Get_Type (Decl : Declaration_Reference) return Character is
   begin
      return Decl.Decl_Type;
   end Get_Type;

   -----------------------
   -- Grep_Source_Files --
   -----------------------

   procedure Grep_Source_Files is
      Decl : Declaration_Reference := First_Declaration;

      type Simple_Ref;
      type Simple_Ref_Access is access Simple_Ref;
      type Simple_Ref is record
         Ref  : Reference;
         Next : Simple_Ref_Access;
      end record;
      List : Simple_Ref_Access := null;
      --  This structure is used to speed up the parsing of Ada sources:
      --  Every reference found by parsing the .ali files is inserted in this
      --  list, sorted by filename and line numbers. This allows avoiding
      --  parsing a same ada file multiple times

      procedure Free is new Unchecked_Deallocation
        (Simple_Ref, Simple_Ref_Access);
      --  Clear an element of the list

      procedure Grep_List;
      --  For each reference in the list, parse the file and find the
      --  source line

      procedure Insert_In_Order (Ref  : Reference);
      --  Insert a new reference in the list, ordered by line numbers

      procedure Insert_List_Ref (First_Ref : Reference);
      --  Process a list of references

      ---------------
      -- Grep_List --
      ---------------

      procedure Grep_List is
         Line         : String (1 .. 1024);
         Last         : Natural;
         File         : Ada.Text_IO.File_Type;
         Line_Number  : Natural;
         Pos          : Natural;
         Save_List    : Simple_Ref_Access := List;
         Current_File : File_Reference;

      begin
         while List /= null loop

            --  Makes sure we can find and read the file

            Current_File := List.Ref.File;
            Line_Number  := 0;

            begin
               Ada.Text_IO.Open (File,
                                 Ada.Text_IO.In_File,
                                 Get_File (List.Ref, True));

               --  Read the file and find every relevant lines

               while List /= null
                 and then List.Ref.File = Current_File
                 and then not Ada.Text_IO.End_Of_File (File)
               loop
                  Ada.Text_IO.Get_Line (File, Line, Last);
                  Line_Number := Line_Number + 1;

                  while List /= null
                    and then Line_Number = List.Ref.Line
                  loop

                     --  Skip the leading blanks on the line

                     Pos := 1;
                     while Line (Pos) = ' '
                       or else Line (Pos) = ASCII.HT
                     loop
                        Pos := Pos + 1;
                     end loop;

                     List.Ref.Source_Line :=
                       To_Unbounded_String (Line (Pos .. Last));

                     --  Find the next element in the list

                     List := List.Next;
                  end loop;

               end loop;

               Ada.Text_IO.Close (File);

               --  If the Current_File was not found, just skip it

            exception
               when Ada.IO_Exceptions.Name_Error =>
                  null;
            end;

            --  If the line or the file were not found

            while List /= null
              and then List.Ref.File = Current_File
            loop
               List := List.Next;
            end loop;

         end loop;

         --  Clear the list

         while Save_List /= null loop
            List      := Save_List;
            Save_List := Save_List.Next;
            Free (List);
         end loop;
      end Grep_List;

      ---------------------
      -- Insert_In_Order --
      ---------------------

      procedure Insert_In_Order (Ref : Reference) is
         Iter : Simple_Ref_Access := List;
         Prev : Simple_Ref_Access := null;

      begin
         while Iter /= null loop

            --  If we have found the file, sort by lines

            if Iter.Ref.File = Ref.File then

               while Iter /= null
                 and then Iter.Ref.File = Ref.File
               loop
                  if Iter.Ref.Line > Ref.Line then

                     if Iter = List then
                        List := new Simple_Ref'(Ref, List);
                     else
                        Prev.Next := new Simple_Ref'(Ref, Iter);
                     end if;
                     return;
                  end if;

                  Prev := Iter;
                  Iter := Iter.Next;
               end loop;

               if Iter = List then
                  List := new Simple_Ref'(Ref, List);
               else
                  Prev.Next := new Simple_Ref'(Ref, Iter);
               end if;

               return;
            end if;

            Prev := Iter;
            Iter := Iter.Next;
         end loop;

         --  The file was not already in the list, insert it

         List := new Simple_Ref'(Ref, List);
      end Insert_In_Order;

      ---------------------
      -- Insert_List_Ref --
      ---------------------

      procedure Insert_List_Ref (First_Ref : Reference) is
         Ref : Reference := First_Ref;

      begin
         while Ref /= Empty_Reference loop
            Insert_In_Order (Ref);
            Ref := Next (Ref);
         end loop;
      end Insert_List_Ref;

   --  Start of processing for Grep_Source_Files

   begin
      while Decl /= Empty_Declaration loop
         Insert_In_Order (Decl.Decl'Access);
         Insert_List_Ref (First_Body (Decl));
         Insert_List_Ref (First_Reference (Decl));
         Insert_List_Ref (First_Modif (Decl));
         Decl := Next (Decl);
      end loop;

      Grep_List;
   end Grep_Source_Files;

   -----------------------
   -- Longest_File_Name --
   -----------------------

   function Longest_File_Name return Natural is
   begin
      return Files.Longest_Name;
   end Longest_File_Name;

   -----------
   -- Match --
   -----------

   function Match
     (File   : File_Reference;
      Line   : Natural;
      Column : Natural)
      return   Boolean
   is
      Ref : Ref_In_File_Ptr := File.Lines;

   begin
      while Ref /= null loop
         if (Ref.Line = 0 or else Ref.Line = Line)
           and then (Ref.Column = 0 or else Ref.Column = Column)
         then
            return True;
         end if;

         Ref := Ref.Next;
      end loop;

      return False;
   end Match;

   -----------
   -- Match --
   -----------

   function Match (Decl : Declaration_Reference) return Boolean is
   begin
      return Decl.Match;
   end Match;

   ----------
   -- Next --
   ----------

   function Next (Decl : Declaration_Reference) return Declaration_Reference is
   begin
      return Decl.Next;
   end Next;

   ----------
   -- Next --
   ----------

   function Next (Ref : Reference) return Reference is
   begin
      return Ref.Next;
   end Next;

   ------------------
   -- Next_Obj_Dir --
   ------------------

   function Next_Obj_Dir return String is
      First : Integer := Directories.Obj_Dir_Index;
      Last  : Integer := Directories.Obj_Dir_Index;

   begin
      if Last > Directories.Obj_Dir_Length then
         return String'(1 .. 0 => ' ');
      end if;

      while Directories.Obj_Dir (Last) /= ' ' loop
         Last := Last + 1;
      end loop;

      Directories.Obj_Dir_Index := Last + 1;
      Directories.Last_Obj_Dir_Start := First;
      return Directories.Obj_Dir (First .. Last - 1);
   end Next_Obj_Dir;

   ------------------
   -- Next_Src_Dir --
   ------------------

   function Next_Src_Dir return String is
      First : Integer := Directories.Src_Dir_Index;
      Last  : Integer := Directories.Src_Dir_Index;

   begin
      if Last > Directories.Src_Dir_Length then
         return String'(1 .. 0 => ' ');
      end if;

      while Directories.Src_Dir (Last) /= ' ' loop
         Last := Last + 1;
      end loop;

      Directories.Src_Dir_Index := Last + 1;
      return Directories.Src_Dir (First .. Last - 1);
   end Next_Src_Dir;

   -------------------------
   -- Next_Unvisited_File --
   -------------------------

   function Next_Unvisited_File return File_Reference is
      The_Files : File_Reference := Files.Table;

   begin
      while The_Files /= null loop
         if not The_Files.Visited then
            The_Files.Visited := True;
            return The_Files;
         end if;

         The_Files := The_Files.Next;
      end loop;

      return Empty_File;
   end Next_Unvisited_File;

   ------------------
   -- Parse_Gnatls --
   ------------------

   procedure Parse_Gnatls
     (Gnatls_Src_Cache : out Ada.Strings.Unbounded.Unbounded_String;
      Gnatls_Obj_Cache : out Ada.Strings.Unbounded.Unbounded_String)
   is
   begin
      Osint.Add_Default_Search_Dirs;

      for J in 1 .. Osint.Nb_Dir_In_Src_Search_Path loop
         if Osint.Dir_In_Src_Search_Path (J)'Length = 0 then
            Ada.Strings.Unbounded.Append (Gnatls_Src_Cache, "./" & ' ');
         else
            Ada.Strings.Unbounded.Append
              (Gnatls_Src_Cache, Osint.Dir_In_Src_Search_Path (J).all & ' ');
         end if;
      end loop;

      for J in 1 .. Osint.Nb_Dir_In_Obj_Search_Path loop
         if Osint.Dir_In_Obj_Search_Path (J)'Length = 0 then
            Ada.Strings.Unbounded.Append (Gnatls_Obj_Cache, "./" & ' ');
         else
            Ada.Strings.Unbounded.Append
              (Gnatls_Obj_Cache, Osint.Dir_In_Obj_Search_Path (J).all & ' ');
         end if;
      end loop;
   end Parse_Gnatls;

   -------------------
   -- Reset_Obj_Dir --
   -------------------

   procedure Reset_Obj_Dir is
   begin
      Directories.Obj_Dir_Index := 1;
   end Reset_Obj_Dir;

   -------------------
   -- Reset_Src_Dir --
   -------------------

   procedure Reset_Src_Dir is
   begin
      Directories.Src_Dir_Index := 1;
   end Reset_Src_Dir;

   -----------------------
   -- Set_Default_Match --
   -----------------------

   procedure Set_Default_Match (Value : Boolean) is
   begin
      Default_Match := Value;
   end Set_Default_Match;

   -------------------
   -- Set_Directory --
   -------------------

   procedure Set_Directory
     (File : in File_Reference;
      Dir  : in String)
   is
   begin
      File.Dir := new String'(Dir);
   end Set_Directory;

   -------------------
   -- Set_Unvisited --
   -------------------

   procedure Set_Unvisited (File_Ref : in File_Reference) is
      The_Files : File_Reference := Files.Table;

   begin
      while The_Files /= null loop
         if The_Files = File_Ref then
            The_Files.Visited := False;
            return;
         end if;

         The_Files := The_Files.Next;
      end loop;
   end Set_Unvisited;

end Xr_Tabls;