path: root/gcc/ada/prj-env.adb

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                              P R J . E N V                               --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                            $Revision$
--                                                                          --
--             Copyright (C) 2001 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.                                                      --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
--                                                                          --
------------------------------------------------------------------------------

with GNAT.OS_Lib; use GNAT.OS_Lib;
with Namet;       use Namet;
with Opt;
with Osint;       use Osint;
with Output;      use Output;
with Prj.Com;     use Prj.Com;
with Prj.Util;
with Snames;      use Snames;
with Stringt;     use Stringt;
with Table;

package body Prj.Env is

   type Naming_Id is new Nat;
   No_Naming : constant Naming_Id := 0;

   Ada_Path_Buffer : String_Access := new String (1 .. 1_000);
   --  A buffer where values for ADA_INCLUDE_PATH
   --  and ADA_OBJECTS_PATH are stored.

   Ada_Path_Length : Natural := 0;
   --  Index of the last valid character in Ada_Path_Buffer.

   package Namings is new Table.Table (
     Table_Component_Type => Naming_Data,
     Table_Index_Type     => Naming_Id,
     Table_Low_Bound      => 1,
     Table_Initial        => 5,
     Table_Increment      => 100,
     Table_Name           => "Prj.Env.Namings");

   Default_Naming : constant Naming_Id := Namings.First;

   Global_Configuration_Pragmas : Name_Id;
   Local_Configuration_Pragmas  : Name_Id;

   -----------------------
   -- Local Subprograms --
   -----------------------

   function Body_Path_Name_Of (Unit : Unit_Id) return String;
   --  Returns the path name of the body of a unit.
   --  Compute it first, if necessary.

   function Spec_Path_Name_Of (Unit : Unit_Id) return String;
   --  Returns the path name of the spec of a unit.
   --  Compute it first, if necessary.

   procedure Add_To_Path (Path : String);
   --  Add Path to global variable Ada_Path_Buffer
   --  Increment Ada_Path_Length

   ----------------------
   -- Ada_Include_Path --
   ----------------------

   function Ada_Include_Path (Project : Project_Id) return String_Access is

      procedure Add (Project : Project_Id);
      --  Add all the source directories of a project to the path,
      --  only if this project has not been visited.
      --  Call itself recursively for projects being modified,
      --  and imported projects.
      --  Add the project to the list Seen if this is the first time
      --  we call Add for this project.

      ---------
      -- Add --
      ---------

      procedure Add (Project : Project_Id) is
      begin
         --  If Seen is empty, then the project cannot have been
         --  visited.

         if not Projects.Table (Project).Seen then
            Projects.Table (Project).Seen := True;

            declare
               Data : Project_Data := Projects.Table (Project);
               List : Project_List := Data.Imported_Projects;

               Current : String_List_Id := Data.Source_Dirs;
               Source_Dir : String_Element;

            begin
               --  Add to path all source directories of this project

               while Current /= Nil_String loop
                  if Ada_Path_Length > 0 then
                     Add_To_Path (Path => (1 => Path_Separator));
                  end if;

                  Source_Dir := String_Elements.Table (Current);
                  String_To_Name_Buffer (Source_Dir.Value);

                  declare
                     New_Path : constant String :=
                       Name_Buffer (1 .. Name_Len);
                  begin
                     Add_To_Path (New_Path);
                  end;

                  Current := Source_Dir.Next;
               end loop;

               --  Call Add to the project being modified, if any

               if Data.Modifies /= No_Project then
                  Add (Data.Modifies);
               end if;

               --  Call Add for each imported project, if any

               while List /= Empty_Project_List loop
                  Add (Project_Lists.Table (List).Project);
                  List := Project_Lists.Table (List).Next;
               end loop;
            end;
         end if;

      end Add;

   --  Start of processing for Ada_Include_Path

   begin
      --  If it is the first time we call this function for
      --  this project, compute the source path

      if Projects.Table (Project).Include_Path = null then
         Ada_Path_Length := 0;

         for Index in 1 .. Projects.Last loop
            Projects.Table (Index).Seen := False;
         end loop;

         Add (Project);
         Projects.Table (Project).Include_Path :=
           new String'(Ada_Path_Buffer (1 .. Ada_Path_Length));
      end if;

      return Projects.Table (Project).Include_Path;
   end Ada_Include_Path;

   ----------------------
   -- Ada_Objects_Path --
   ----------------------

   function Ada_Objects_Path
     (Project             : Project_Id;
      Including_Libraries : Boolean := True)
     return String_Access is

      procedure Add (Project : Project_Id);
      --  Add all the object directory of a project to the path,
      --  only if this project has not been visited.
      --  Call itself recursively for projects being modified,
      --  and imported projects.
      --  Add the project to the list Seen if this is the first time
      --  we call Add for this project.

      ---------
      -- Add --
      ---------

      procedure Add (Project : Project_Id) is
      begin

         --  If this project has not been seen yet

         if not Projects.Table (Project).Seen then
            Projects.Table (Project).Seen := True;

            declare
               Data : Project_Data := Projects.Table (Project);
               List : Project_List := Data.Imported_Projects;

            begin
               --  Add to path the object directory of this project
               --  except if we don't include library project and
               --  this is a library project.

               if (Data.Library and then Including_Libraries)
                 or else
                 (Data.Object_Directory /= No_Name
                   and then
                   (not Including_Libraries or else not Data.Library))
               then
                  if Ada_Path_Length > 0 then
                     Add_To_Path (Path => (1 => Path_Separator));
                  end if;

                  --  For a library project, att the library directory

                  if Data.Library then
                     declare
                        New_Path : constant String :=
                          Get_Name_String (Data.Library_Dir);
                     begin
                        Add_To_Path (New_Path);
                     end;
                  else

                     --  For a non library project, add the object directory
                     declare
                        New_Path : constant String :=
                          Get_Name_String (Data.Object_Directory);
                     begin
                        Add_To_Path (New_Path);
                     end;
                  end if;
               end if;

               --  Call Add to the project being modified, if any

               if Data.Modifies /= No_Project then
                  Add (Data.Modifies);
               end if;

               --  Call Add for each imported project, if any

               while List /= Empty_Project_List loop
                  Add (Project_Lists.Table (List).Project);
                  List := Project_Lists.Table (List).Next;
               end loop;
            end;

         end if;
      end Add;

   --  Start of processing for Ada_Objects_Path

   begin
      --  If it is the first time we call this function for
      --  this project, compute the objects path

      if Projects.Table (Project).Objects_Path = null then
         Ada_Path_Length := 0;

         for Index in 1 .. Projects.Last loop
            Projects.Table (Index).Seen := False;
         end loop;

         Add (Project);
         Projects.Table (Project).Objects_Path :=
           new String'(Ada_Path_Buffer (1 .. Ada_Path_Length));
      end if;

      return Projects.Table (Project).Objects_Path;
   end Ada_Objects_Path;

   -----------------
   -- Add_To_Path --
   -----------------

   procedure Add_To_Path (Path : String) is
   begin
      --  If Ada_Path_Buffer is too small, double it

      if Ada_Path_Length + Path'Length > Ada_Path_Buffer'Last then
         declare
            New_Ada_Path_Buffer : constant String_Access :=
                                    new String
                                      (1 .. Ada_Path_Buffer'Last +
                                                 Ada_Path_Buffer'Last);

         begin
            New_Ada_Path_Buffer (1 .. Ada_Path_Length) :=
              Ada_Path_Buffer (1 .. Ada_Path_Length);
            Ada_Path_Buffer := New_Ada_Path_Buffer;
         end;
      end if;

      Ada_Path_Buffer
        (Ada_Path_Length + 1 .. Ada_Path_Length + Path'Length) := Path;
      Ada_Path_Length := Ada_Path_Length + Path'Length;
   end Add_To_Path;

   -----------------------
   -- Body_Path_Name_Of --
   -----------------------

   function Body_Path_Name_Of (Unit : Unit_Id) return String is
      Data : Unit_Data := Units.Table (Unit);

   begin
      --  If we don't know the path name of the body of this unit,
      --  we compute it, and we store it.

      if Data.File_Names (Body_Part).Path = No_Name then
         declare
            Current_Source : String_List_Id :=
              Projects.Table (Data.File_Names (Body_Part).Project).Sources;
            Path : GNAT.OS_Lib.String_Access;

         begin
            --  By default, put the file name

            Data.File_Names (Body_Part).Path :=
              Data.File_Names (Body_Part).Name;

            --  For each source directory

            while Current_Source /= Nil_String loop
               String_To_Name_Buffer
                 (String_Elements.Table (Current_Source).Value);
               Path :=
                 Locate_Regular_File
                 (Namet.Get_Name_String
                  (Data.File_Names (Body_Part).Name),
                  Name_Buffer (1 .. Name_Len));

               --  If the file is in this directory,
               --  then we store the path, and we are done.

               if Path /= null then
                  Name_Len := Path'Length;
                  Name_Buffer (1 .. Name_Len) := Path.all;
                  Data.File_Names (Body_Part).Path := Name_Enter;
                  exit;

               else
                  Current_Source :=
                    String_Elements.Table (Current_Source).Next;
               end if;
            end loop;

            Units.Table (Unit) := Data;
         end;
      end if;

      --  Returned the value stored

      return Namet.Get_Name_String (Data.File_Names (Body_Part).Path);
   end Body_Path_Name_Of;

   --------------------------------
   -- Create_Config_Pragmas_File --
   --------------------------------

   procedure Create_Config_Pragmas_File
     (For_Project  : Project_Id;
      Main_Project : Project_Id)
   is
      File_Name : Temp_File_Name;
      File      : File_Descriptor := Invalid_FD;

      The_Packages : Package_Id;
      Gnatmake     : Prj.Package_Id;
      Compiler     : Prj.Package_Id;

      Current_Unit : Unit_Id := Units.First;

      First_Project : Project_List := Empty_Project_List;

      Current_Project : Project_List;
      Current_Naming  : Naming_Id;

      Global_Attribute : Variable_Value := Nil_Variable_Value;
      Local_Attribute  : Variable_Value := Nil_Variable_Value;

      Global_Attribute_Present : Boolean := False;
      Local_Attribute_Present  : Boolean := False;

      procedure Check (Project : Project_Id);

      procedure Check_Temp_File;
      --  Check that a temporary file has been opened.
      --  If not, create one, and put its name in the project data,
      --  with the indication that it is a temporary file.

      procedure Copy_File (Name : String_Id);
      --  Copy a configuration pragmas file into the temp file.

      procedure Put
        (Unit_Name : Name_Id;
         File_Name : Name_Id;
         Unit_Kind : Spec_Or_Body);
      --  Put an SFN pragma in the temporary file.

      procedure Put (File : File_Descriptor; S : String);

      procedure Put_Line (File : File_Descriptor; S : String);

      -----------
      -- Check --
      -----------

      procedure Check (Project : Project_Id) is
         Data : constant Project_Data := Projects.Table (Project);

      begin
         if Current_Verbosity = High then
            Write_Str ("Checking project file """);
            Write_Str (Namet.Get_Name_String (Data.Name));
            Write_Str (""".");
            Write_Eol;
         end if;

         --  Is this project in the list of the visited project?

         Current_Project := First_Project;
         while Current_Project /= Empty_Project_List
           and then Project_Lists.Table (Current_Project).Project /= Project
         loop
            Current_Project := Project_Lists.Table (Current_Project).Next;
         end loop;

         --  If it is not, put it in the list, and visit it

         if Current_Project = Empty_Project_List then
            Project_Lists.Increment_Last;
            Project_Lists.Table (Project_Lists.Last) :=
              (Project => Project, Next => First_Project);
            First_Project := Project_Lists.Last;

            --  Is the naming scheme of this project one that we know?

            Current_Naming := Default_Naming;
            while Current_Naming <= Namings.Last and then
              not Same_Naming_Scheme
              (Left => Namings.Table (Current_Naming),
               Right => Data.Naming) loop
               Current_Naming := Current_Naming + 1;
            end loop;

            --  If we don't know it, add it

            if Current_Naming > Namings.Last then
               Namings.Increment_Last;
               Namings.Table (Namings.Last) := Data.Naming;

               --  We need a temporary file to be created

               Check_Temp_File;

               --  Put the SFN pragmas for the naming scheme

               --  Spec

               Put_Line
                 (File, "pragma Source_File_Name");
               Put_Line
                 (File, "  (Spec_File_Name  => ""*" &
                  Namet.Get_Name_String (Data.Naming.Current_Spec_Suffix) &
                  """,");
               Put_Line
                 (File, "   Casing          => " &
                  Image (Data.Naming.Casing) & ",");
               Put_Line
                 (File, "   Dot_Replacement => """ &
                 Namet.Get_Name_String (Data.Naming.Dot_Replacement) &
                  """);");

               --  and body

               Put_Line
                 (File, "pragma Source_File_Name");
               Put_Line
                 (File, "  (Body_File_Name  => ""*" &
                  Namet.Get_Name_String (Data.Naming.Current_Impl_Suffix) &
                  """,");
               Put_Line
                 (File, "   Casing          => " &
                  Image (Data.Naming.Casing) & ",");
               Put_Line
                 (File, "   Dot_Replacement => """ &
                  Namet.Get_Name_String (Data.Naming.Dot_Replacement) &
                  """);");

               --  and maybe separate

               if
                 Data.Naming.Current_Impl_Suffix /= Data.Naming.Separate_Suffix
               then
                  Put_Line
                    (File, "pragma Source_File_Name");
                  Put_Line
                    (File, "  (Subunit_File_Name  => ""*" &
                     Namet.Get_Name_String (Data.Naming.Separate_Suffix) &
                     """,");
                  Put_Line
                    (File, "   Casing          => " &
                     Image (Data.Naming.Casing) &
                     ",");
                  Put_Line
                    (File, "   Dot_Replacement => """ &
                     Namet.Get_Name_String (Data.Naming.Dot_Replacement) &
                     """);");
               end if;
            end if;

            if Data.Modifies /= No_Project then
               Check (Data.Modifies);
            end if;

            declare
               Current : Project_List := Data.Imported_Projects;

            begin
               while Current /= Empty_Project_List loop
                  Check (Project_Lists.Table (Current).Project);
                  Current := Project_Lists.Table (Current).Next;
               end loop;
            end;
         end if;
      end Check;

      ---------------------
      -- Check_Temp_File --
      ---------------------

      procedure Check_Temp_File is
      begin
         if File = Invalid_FD then
            GNAT.OS_Lib.Create_Temp_File (File, Name => File_Name);
            if File = Invalid_FD then
               Osint.Fail
                 ("unable to create temporary configuration pragmas file");
            elsif Opt.Verbose_Mode then
               Write_Str ("Creating temp file """);
               Write_Str (File_Name);
               Write_Line ("""");
            end if;
         end if;
      end Check_Temp_File;

      ---------------
      -- Copy_File --
      ---------------

      procedure Copy_File (Name : in String_Id) is
         Input         : File_Descriptor;
         Buffer        : String (1 .. 1_000);
         Input_Length  : Integer;
         Output_Length : Integer;

      begin
         Check_Temp_File;
         String_To_Name_Buffer (Name);

         if Opt.Verbose_Mode then
            Write_Str ("Copying config pragmas file """);
            Write_Str (Name_Buffer (1 .. Name_Len));
            Write_Line (""" into temp file");
         end if;

         declare
            Name : constant String :=
              Name_Buffer (1 .. Name_Len)  & ASCII.NUL;
         begin
            Input := Open_Read (Name'Address, Binary);
         end;

         if Input = Invalid_FD then
            Osint.Fail
              ("cannot open configuration pragmas file " &
               Name_Buffer (1 .. Name_Len));
         end if;

         loop
            Input_Length := Read (Input, Buffer'Address, Buffer'Length);
            Output_Length := Write (File, Buffer'Address, Input_Length);

            if Output_Length /= Input_Length then
               Osint.Fail ("disk full");
            end if;

            exit when Input_Length < Buffer'Length;
         end loop;

         Close (Input);

      end Copy_File;

      ---------
      -- Put --
      ---------

      procedure Put
        (Unit_Name : Name_Id;
         File_Name : Name_Id;
         Unit_Kind : Spec_Or_Body)
      is
      begin
         --  A temporary file needs to be open

         Check_Temp_File;

         --  Put the pragma SFN for the unit kind (spec or body)

         Put (File, "pragma Source_File_Name (");
         Put (File, Namet.Get_Name_String (Unit_Name));

         if Unit_Kind = Specification then
            Put (File, ", Spec_File_Name => """);
         else
            Put (File, ", Body_File_Name => """);
         end if;

         Put (File, Namet.Get_Name_String (File_Name));
         Put_Line (File, """);");
      end Put;

      procedure Put (File : File_Descriptor; S : String) is
         Last : Natural;

      begin
         Last := Write (File, S (S'First)'Address, S'Length);

         if Last /= S'Length then
            Osint.Fail ("Disk full");
         end if;

         if Current_Verbosity = High then
            Write_Str (S);
         end if;
      end Put;

      --------------
      -- Put_Line --
      --------------

      procedure Put_Line (File : File_Descriptor; S : String) is
         S0   : String (1 .. S'Length + 1);
         Last : Natural;

      begin
         --  Add an ASCII.LF to the string. As this gnat.adc
         --  is supposed to be used only by the compiler, we don't
         --  care about the characters for the end of line.
         --  The truth is we could have put a space, but it is
         --  more convenient to be able to read gnat.adc during
         --  development. And the development was done under UNIX.
         --  Hence the ASCII.LF.

         S0 (1 .. S'Length) := S;
         S0 (S0'Last) := ASCII.LF;
         Last := Write (File, S0'Address, S0'Length);

         if Last /= S'Length + 1 then
            Osint.Fail ("Disk full");
         end if;

         if Current_Verbosity = High then
            Write_Line (S);
         end if;
      end Put_Line;

   --  Start of processing for Create_Config_Pragmas_File

   begin

      if not Projects.Table (For_Project).Config_Checked then

         --  Remove any memory of processed naming schemes, if any

         Namings.Set_Last (Default_Naming);

         --  Check the naming schemes

         Check (For_Project);

         --  Visit all the units and process those that need an SFN pragma

         while Current_Unit <= Units.Last loop
            declare
               Unit : constant Unit_Data :=
                 Units.Table (Current_Unit);

            begin
               if Unit.File_Names (Specification).Needs_Pragma then
                  Put (Unit.Name,
                       Unit.File_Names (Specification).Name,
                       Specification);
               end if;

               if Unit.File_Names (Body_Part).Needs_Pragma then
                  Put (Unit.Name,
                       Unit.File_Names (Body_Part).Name,
                       Body_Part);
               end if;

               Current_Unit := Current_Unit + 1;
            end;
         end loop;

         The_Packages := Projects.Table (Main_Project).Decl.Packages;
         Gnatmake :=
           Prj.Util.Value_Of
           (Name        => Name_Builder,
            In_Packages => The_Packages);

         if Gnatmake /= No_Package then
            Global_Attribute := Prj.Util.Value_Of
              (Variable_Name => Global_Configuration_Pragmas,
               In_Variables => Packages.Table (Gnatmake).Decl.Attributes);
            Global_Attribute_Present :=
              Global_Attribute /= Nil_Variable_Value
              and then String_Length (Global_Attribute.Value) > 0;
         end if;

         The_Packages := Projects.Table (For_Project).Decl.Packages;
         Compiler :=
           Prj.Util.Value_Of
           (Name        => Name_Compiler,
            In_Packages => The_Packages);

         if Compiler /= No_Package then
            Local_Attribute := Prj.Util.Value_Of
              (Variable_Name => Local_Configuration_Pragmas,
               In_Variables => Packages.Table (Compiler).Decl.Attributes);
            Local_Attribute_Present :=
              Local_Attribute /= Nil_Variable_Value
              and then String_Length (Local_Attribute.Value) > 0;
         end if;

         if Global_Attribute_Present then

            if File /= Invalid_FD
              or else Local_Attribute_Present
            then
               Copy_File (Global_Attribute.Value);
            else
               String_To_Name_Buffer (Global_Attribute.Value);
               Projects.Table (For_Project).Config_File_Name := Name_Find;
            end if;
         end if;

         if Local_Attribute_Present then

            if File /= Invalid_FD then
               Copy_File (Local_Attribute.Value);

            else
               String_To_Name_Buffer (Local_Attribute.Value);
               Projects.Table (For_Project).Config_File_Name := Name_Find;
            end if;

         end if;

         if File /= Invalid_FD then
            GNAT.OS_Lib.Close (File);

            if Opt.Verbose_Mode then
               Write_Str ("Closing configuration file """);
               Write_Str (File_Name);
               Write_Line ("""");
            end if;

            Name_Len := File_Name'Length;
            Name_Buffer (1 .. Name_Len) := File_Name;
            Projects.Table (For_Project).Config_File_Name := Name_Find;
            Projects.Table (For_Project).Config_File_Temp := True;
         end if;

         Projects.Table (For_Project).Config_Checked := True;

      end if;

   end Create_Config_Pragmas_File;

   ------------------------------------
   -- File_Name_Of_Library_Unit_Body --
   ------------------------------------

   function File_Name_Of_Library_Unit_Body
     (Name    : String;
      Project : Project_Id)
      return    String
   is
      Data          : constant Project_Data := Projects.Table (Project);
      Original_Name : String := Name;

      Extended_Spec_Name : String :=
                             Name & Namet.Get_Name_String
                                      (Data.Naming.Current_Spec_Suffix);
      Extended_Body_Name : String :=
                             Name & Namet.Get_Name_String
                                      (Data.Naming.Current_Impl_Suffix);

      Unit : Unit_Data;

      The_Original_Name : Name_Id;
      The_Spec_Name     : Name_Id;
      The_Body_Name     : Name_Id;

   begin
      Canonical_Case_File_Name (Original_Name);
      Name_Len := Original_Name'Length;
      Name_Buffer (1 .. Name_Len) := Original_Name;
      The_Original_Name := Name_Find;

      Canonical_Case_File_Name (Extended_Spec_Name);
      Name_Len := Extended_Spec_Name'Length;
      Name_Buffer (1 .. Name_Len) := Extended_Spec_Name;
      The_Spec_Name := Name_Find;

      Canonical_Case_File_Name (Extended_Body_Name);
      Name_Len := Extended_Body_Name'Length;
      Name_Buffer (1 .. Name_Len) := Extended_Body_Name;
      The_Body_Name := Name_Find;

      if Current_Verbosity = High then
         Write_Str  ("Looking for file name of """);
         Write_Str  (Name);
         Write_Char ('"');
         Write_Eol;
         Write_Str  ("   Extended Spec Name = """);
         Write_Str  (Extended_Spec_Name);
         Write_Char ('"');
         Write_Eol;
         Write_Str  ("   Extended Body Name = """);
         Write_Str  (Extended_Body_Name);
         Write_Char ('"');
         Write_Eol;
      end if;

      --  For every unit

      for Current in reverse Units.First .. Units.Last loop
         Unit := Units.Table (Current);

         --  If it is a unit of the same project

         if Unit.File_Names (Body_Part).Project = Project then
            declare
               Current_Name : constant Name_Id :=
                                Unit.File_Names (Body_Part).Name;

            begin
               --  If there is a body

               if Current_Name /= No_Name then
                  if Current_Verbosity = High then
                     Write_Str  ("   Comparing with """);
                     Write_Str  (Get_Name_String (Current_Name));
                     Write_Char ('"');
                     Write_Eol;
                  end if;

                  --  If it has the name of the original name,
                  --  return the original name

                  if Unit.Name = The_Original_Name
                    or else Current_Name = The_Original_Name
                  then
                     if Current_Verbosity = High then
                        Write_Line ("   OK");
                     end if;

                     return Get_Name_String (Current_Name);

                  --  If it has the name of the extended body name,
                  --  return the extended body name

                  elsif Current_Name = The_Body_Name then
                     if Current_Verbosity = High then
                        Write_Line ("   OK");
                     end if;

                     return Extended_Body_Name;

                  else
                     if Current_Verbosity = High then
                        Write_Line ("   not good");
                     end if;
                  end if;
               end if;
            end;
         end if;

         --  If it is a unit of the same project

         if Units.Table (Current).File_Names (Specification).Project =
                                                                 Project
         then
            declare
               Current_Name : constant Name_Id :=
                                Unit.File_Names (Specification).Name;

            begin
               --  If there is a spec

               if Current_Name /= No_Name then
                  if Current_Verbosity = High then
                     Write_Str  ("   Comparing with """);
                     Write_Str  (Get_Name_String (Current_Name));
                     Write_Char ('"');
                     Write_Eol;
                  end if;

                  --  If it has the same name as the original name,
                  --  return the original name

                  if Unit.Name = The_Original_Name
                    or else Current_Name = The_Original_Name
                  then
                     if Current_Verbosity = High then
                        Write_Line ("   OK");
                     end if;

                     return Get_Name_String (Current_Name);

                  --  If it has the same name as the extended spec name,
                  --  return the extended spec name

                  elsif Current_Name = The_Spec_Name then
                     if Current_Verbosity = High then
                        Write_Line ("   OK");
                     end if;

                     return Extended_Spec_Name;

                  else
                     if Current_Verbosity = High then
                        Write_Line ("   not good");
                     end if;
                  end if;
               end if;
            end;
         end if;

      end loop;

      --  We don't know this file name, return an empty string

      return "";
   end File_Name_Of_Library_Unit_Body;

   -------------------------
   -- For_All_Object_Dirs --
   -------------------------

   procedure For_All_Object_Dirs (Project : Project_Id) is
      Seen : Project_List := Empty_Project_List;

      procedure Add (Project : Project_Id);
      --  Process a project. Remember the processes visited to avoid
      --  processing a project twice. Recursively process an eventual
      --  modified project, and all imported projects.

      ---------
      -- Add --
      ---------

      procedure Add (Project : Project_Id) is
         Data : constant Project_Data := Projects.Table (Project);
         List : Project_List := Data.Imported_Projects;

      begin
         --  If the list of visited project is empty, then
         --  for sure we never visited this project.

         if Seen = Empty_Project_List then
            Project_Lists.Increment_Last;
            Seen := Project_Lists.Last;
            Project_Lists.Table (Seen) :=
              (Project => Project, Next => Empty_Project_List);

         else
            --  Check if the project is in the list

            declare
               Current : Project_List := Seen;

            begin
               loop
                  --  If it is, then there is nothing else to do

                  if Project_Lists.Table (Current).Project = Project then
                     return;
                  end if;

                  exit when Project_Lists.Table (Current).Next =
                    Empty_Project_List;
                  Current := Project_Lists.Table (Current).Next;
               end loop;

               --  This project has never been visited, add it
               --  to the list.

               Project_Lists.Increment_Last;
               Project_Lists.Table (Current).Next := Project_Lists.Last;
               Project_Lists.Table (Project_Lists.Last) :=
                 (Project => Project, Next => Empty_Project_List);
            end;
         end if;

         --  If there is an object directory, call Action
         --  with its name

         if Data.Object_Directory /= No_Name then
            Get_Name_String (Data.Object_Directory);
            Action (Name_Buffer (1 .. Name_Len));
         end if;

         --  If we are modifying a project, visit it

         if Data.Modifies /= No_Project then
            Add (Data.Modifies);
         end if;

         --  And visit all imported projects

         while List /= Empty_Project_List loop
            Add (Project_Lists.Table (List).Project);
            List := Project_Lists.Table (List).Next;
         end loop;
      end Add;

   --  Start of processing for For_All_Object_Dirs

   begin
      --  Visit this project, and its imported projects,
      --  recursively

      Add (Project);
   end For_All_Object_Dirs;

   -------------------------
   -- For_All_Source_Dirs --
   -------------------------

   procedure For_All_Source_Dirs (Project : Project_Id) is
      Seen : Project_List := Empty_Project_List;

      procedure Add (Project : Project_Id);
      --  Process a project. Remember the processes visited to avoid
      --  processing a project twice. Recursively process an eventual
      --  modified project, and all imported projects.

      ---------
      -- Add --
      ---------

      procedure Add (Project : Project_Id) is
         Data : constant Project_Data := Projects.Table (Project);
         List : Project_List := Data.Imported_Projects;

      begin
         --  If the list of visited project is empty, then
         --  for sure we never visited this project.

         if Seen = Empty_Project_List then
            Project_Lists.Increment_Last;
            Seen := Project_Lists.Last;
            Project_Lists.Table (Seen) :=
              (Project => Project, Next => Empty_Project_List);

         else
            --  Check if the project is in the list

            declare
               Current : Project_List := Seen;

            begin
               loop
                  --  If it is, then there is nothing else to do

                  if Project_Lists.Table (Current).Project = Project then
                     return;
                  end if;

                  exit when Project_Lists.Table (Current).Next =
                    Empty_Project_List;
                  Current := Project_Lists.Table (Current).Next;
               end loop;

               --  This project has never been visited, add it
               --  to the list.

               Project_Lists.Increment_Last;
               Project_Lists.Table (Current).Next := Project_Lists.Last;
               Project_Lists.Table (Project_Lists.Last) :=
                 (Project => Project, Next => Empty_Project_List);
            end;
         end if;

         declare
            Current    : String_List_Id := Data.Source_Dirs;
            The_String : String_Element;

         begin
            --  Call action with the name of every source directorie

            while Current /= Nil_String loop
               The_String := String_Elements.Table (Current);
               String_To_Name_Buffer (The_String.Value);
               Action (Name_Buffer (1 .. Name_Len));
               Current := The_String.Next;
            end loop;
         end;

         --  If we are modifying a project, visit it

         if Data.Modifies /= No_Project then
            Add (Data.Modifies);
         end if;

         --  And visit all imported projects

         while List /= Empty_Project_List loop
            Add (Project_Lists.Table (List).Project);
            List := Project_Lists.Table (List).Next;
         end loop;
      end Add;

   --  Start of processing for For_All_Source_Dirs

   begin
      --  Visit this project, and its imported projects recursively

      Add (Project);
   end For_All_Source_Dirs;

   -------------------
   -- Get_Reference --
   -------------------

   procedure Get_Reference
     (Source_File_Name : String;
      Project          : out Project_Id;
      Path             : out Name_Id)
   is
   begin
      if Current_Verbosity > Default then
         Write_Str ("Getting Reference_Of (""");
         Write_Str (Source_File_Name);
         Write_Str (""") ... ");
      end if;

      declare
         Original_Name : String := Source_File_Name;
         Unit          : Unit_Data;

      begin
         Canonical_Case_File_Name (Original_Name);

         for Id in Units.First .. Units.Last loop
            Unit := Units.Table (Id);

            if (Unit.File_Names (Specification).Name /= No_Name
                 and then
                   Namet.Get_Name_String
                     (Unit.File_Names (Specification).Name) = Original_Name)
              or else (Unit.File_Names (Specification).Path /= No_Name
                         and then
                           Namet.Get_Name_String
                           (Unit.File_Names (Specification).Path) =
                                                              Original_Name)
            then
               Project := Unit.File_Names (Specification).Project;
               Path := Unit.File_Names (Specification).Path;

               if Current_Verbosity > Default then
                  Write_Str ("Done: Specification.");
                  Write_Eol;
               end if;

               return;

            elsif (Unit.File_Names (Body_Part).Name /= No_Name
                    and then
                      Namet.Get_Name_String
                        (Unit.File_Names (Body_Part).Name) = Original_Name)
              or else (Unit.File_Names (Body_Part).Path /= No_Name
                         and then Namet.Get_Name_String
                                    (Unit.File_Names (Body_Part).Path) =
                                                             Original_Name)
            then
               Project := Unit.File_Names (Body_Part).Project;
               Path := Unit.File_Names (Body_Part).Path;

               if Current_Verbosity > Default then
                  Write_Str ("Done: Body.");
                  Write_Eol;
               end if;

               return;
            end if;

         end loop;
      end;

      Project := No_Project;
      Path    := No_Name;

      if Current_Verbosity > Default then
         Write_Str ("Cannot be found.");
         Write_Eol;
      end if;
   end Get_Reference;

   ----------------
   -- Initialize --
   ----------------

   procedure Initialize is
      Global : constant String := "global_configuration_pragmas";
      Local  : constant String :=  "local_configuration_pragmas";
   begin
      --  Put the standard GNAT naming scheme in the Namings table

      Namings.Increment_Last;
      Namings.Table (Namings.Last) := Standard_Naming_Data;
      Name_Len := Global'Length;
      Name_Buffer (1 .. Name_Len) := Global;
      Global_Configuration_Pragmas := Name_Find;
      Name_Len := Local'Length;
      Name_Buffer (1 .. Name_Len) := Local;
      Local_Configuration_Pragmas := Name_Find;
   end Initialize;

   ------------------------------------
   -- Path_Name_Of_Library_Unit_Body --
   ------------------------------------

   function Path_Name_Of_Library_Unit_Body
     (Name    : String;
      Project : Project_Id)
      return String
   is
      Data : constant Project_Data := Projects.Table (Project);
      Original_Name : String := Name;

      Extended_Spec_Name : String :=
                             Name & Namet.Get_Name_String
                                     (Data.Naming.Current_Spec_Suffix);
      Extended_Body_Name : String :=
                             Name & Namet.Get_Name_String
                                     (Data.Naming.Current_Impl_Suffix);

      First   : Unit_Id := Units.First;
      Current : Unit_Id;
      Unit    : Unit_Data;

   begin
      Canonical_Case_File_Name (Original_Name);
      Canonical_Case_File_Name (Extended_Spec_Name);
      Canonical_Case_File_Name (Extended_Spec_Name);

      if Current_Verbosity = High then
         Write_Str  ("Looking for path name of """);
         Write_Str  (Name);
         Write_Char ('"');
         Write_Eol;
         Write_Str  ("   Extended Spec Name = """);
         Write_Str  (Extended_Spec_Name);
         Write_Char ('"');
         Write_Eol;
         Write_Str  ("   Extended Body Name = """);
         Write_Str  (Extended_Body_Name);
         Write_Char ('"');
         Write_Eol;
      end if;

      while First <= Units.Last
        and then Units.Table (First).File_Names (Body_Part).Project /= Project
      loop
         First := First + 1;
      end loop;

      Current := First;
      while Current <= Units.Last loop
         Unit := Units.Table (Current);

         if Unit.File_Names (Body_Part).Project = Project
           and then Unit.File_Names (Body_Part).Name /= No_Name
         then
            declare
               Current_Name : constant String :=
                 Namet.Get_Name_String (Unit.File_Names (Body_Part).Name);
            begin
               if Current_Verbosity = High then
                  Write_Str  ("   Comparing with """);
                  Write_Str  (Current_Name);
                  Write_Char ('"');
                  Write_Eol;
               end if;

               if Current_Name = Original_Name then
                  if Current_Verbosity = High then
                     Write_Line ("   OK");
                  end if;

                  return Body_Path_Name_Of (Current);

               elsif Current_Name = Extended_Body_Name then
                  if Current_Verbosity = High then
                     Write_Line ("   OK");
                  end if;

                  return Body_Path_Name_Of (Current);

               else
                  if Current_Verbosity = High then
                     Write_Line ("   not good");
                  end if;
               end if;
            end;

         elsif Unit.File_Names (Specification).Name /= No_Name then
            declare
               Current_Name : constant String :=
                                Namet.Get_Name_String
                                  (Unit.File_Names (Specification).Name);

            begin
               if Current_Verbosity = High then
                  Write_Str  ("   Comparing with """);
                  Write_Str  (Current_Name);
                  Write_Char ('"');
                  Write_Eol;
               end if;

               if Current_Name = Original_Name then
                  if Current_Verbosity = High then
                     Write_Line ("   OK");
                  end if;

                  return Spec_Path_Name_Of (Current);

               elsif Current_Name = Extended_Spec_Name then

                  if Current_Verbosity = High then
                     Write_Line ("   OK");
                  end if;

                  return Spec_Path_Name_Of (Current);

               else
                  if Current_Verbosity = High then
                     Write_Line ("   not good");
                  end if;
               end if;
            end;
         end if;
         Current := Current + 1;
      end loop;

      return "";
   end Path_Name_Of_Library_Unit_Body;

   -------------------
   -- Print_Sources --
   -------------------

   procedure Print_Sources is
      Unit : Unit_Data;

   begin
      Write_Line ("List of Sources:");

      for Id in Units.First .. Units.Last loop
         Unit := Units.Table (Id);
         Write_Str  ("   ");
         Write_Line (Namet.Get_Name_String (Unit.Name));

         if Unit.File_Names (Specification).Name /= No_Name then
            if Unit.File_Names (Specification).Project = No_Project then
               Write_Line ("   No project");

            else
               Write_Str  ("   Project: ");
               Get_Name_String
                 (Projects.Table
                   (Unit.File_Names (Specification).Project).Path_Name);
               Write_Line (Name_Buffer (1 .. Name_Len));
            end if;

            Write_Str  ("      spec: ");
            Write_Line
              (Namet.Get_Name_String
               (Unit.File_Names (Specification).Name));
         end if;

         if Unit.File_Names (Body_Part).Name /= No_Name then
            if Unit.File_Names (Body_Part).Project = No_Project then
               Write_Line ("   No project");

            else
               Write_Str  ("   Project: ");
               Get_Name_String
                 (Projects.Table
                   (Unit.File_Names (Body_Part).Project).Path_Name);
               Write_Line (Name_Buffer (1 .. Name_Len));
            end if;

            Write_Str  ("      body: ");
            Write_Line
              (Namet.Get_Name_String
               (Unit.File_Names (Body_Part).Name));
         end if;

      end loop;

      Write_Line ("end of List of Sources.");
   end Print_Sources;

   -----------------------
   -- Spec_Path_Name_Of --
   -----------------------

   function Spec_Path_Name_Of (Unit : Unit_Id) return String is
      Data : Unit_Data := Units.Table (Unit);

   begin
      if Data.File_Names (Specification).Path = No_Name then
         declare
            Current_Source : String_List_Id :=
              Projects.Table (Data.File_Names (Specification).Project).Sources;
            Path : GNAT.OS_Lib.String_Access;

         begin
            Data.File_Names (Specification).Path :=
              Data.File_Names (Specification).Name;

            while Current_Source /= Nil_String loop
               String_To_Name_Buffer
                 (String_Elements.Table (Current_Source).Value);
               Path := Locate_Regular_File
                 (Namet.Get_Name_String
                  (Data.File_Names (Specification).Name),
                  Name_Buffer (1 .. Name_Len));

               if Path /= null then
                  Name_Len := Path'Length;
                  Name_Buffer (1 .. Name_Len) := Path.all;
                  Data.File_Names (Specification).Path := Name_Enter;
                  exit;
               else
                  Current_Source :=
                    String_Elements.Table (Current_Source).Next;
               end if;
            end loop;

            Units.Table (Unit) := Data;
         end;
      end if;

      return Namet.Get_Name_String (Data.File_Names (Specification).Path);
   end Spec_Path_Name_Of;

end Prj.Env;