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

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                              P R J . E N V                               --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 2001-2009, 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 Fmap;
with Opt;
with Osint;    use Osint;
with Output;   use Output;
with Prj.Com;  use Prj.Com;
with Tempdir;

package body Prj.Env is

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

   procedure Add_To_Path
     (Source_Dirs : String_List_Id;
      In_Tree     : Project_Tree_Ref);
   --  Add to Ada_Path_Buffer all the source directories in string list
   --  Source_Dirs, if any. Increment Ada_Path_Length.

   procedure Add_To_Path (Dir : String; In_Tree : Project_Tree_Ref);
   --  If Dir is not already in the global variable Ada_Path_Buffer, add it.
   --  Increment Ada_Path_Length.
   --  If Ada_Path_Length /= 0, prepend a Path_Separator character to
   --  Path.

   procedure Add_To_Source_Path
     (Source_Dirs : String_List_Id; In_Tree : Project_Tree_Ref);
   --  Add to Ada_Path_B all the source directories in string list
   --  Source_Dirs, if any. Increment Ada_Path_Length.

   procedure Add_To_Object_Path
     (Object_Dir : Path_Name_Type;
      In_Tree    : Project_Tree_Ref);
   --  Add Object_Dir to object path table. Make sure it is not duplicate
   --  and it is the last one in the current table.

   procedure Set_Path_File_Var (Name : String; Value : String);
   --  Call Setenv, after calling To_Host_File_Spec

   function Ultimate_Extension_Of
     (Project : Project_Id) return Project_Id;
   --  Return a project that is either Project or an extended ancestor of
   --  Project that itself is not extended.

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

   function Ada_Include_Path
     (Project : Project_Id;
      In_Tree : Project_Tree_Ref) return String_Access
   is
      procedure Add (Project : Project_Id; Dummy : in out Boolean);
      --  Add source dirs of Project to the path

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

      procedure Add (Project : Project_Id; Dummy : in out Boolean) is
         pragma Unreferenced (Dummy);
      begin
         Add_To_Path (Project.Source_Dirs, In_Tree);
      end Add;

      procedure For_All_Projects is
        new For_Every_Project_Imported (Boolean, Add);
      Dummy : Boolean := False;

   --  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 Project.Ada_Include_Path = null then
         In_Tree.Private_Part.Ada_Path_Length := 0;
         For_All_Projects (Project, Dummy);

         Project.Ada_Include_Path :=
           new String'
             (In_Tree.Private_Part.Ada_Path_Buffer
                  (1 .. In_Tree.Private_Part.Ada_Path_Length));
      end if;

      return Project.Ada_Include_Path;
   end Ada_Include_Path;

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

   function Ada_Include_Path
     (Project   : Project_Id;
      In_Tree   : Project_Tree_Ref;
      Recursive : Boolean) return String
   is
   begin
      if Recursive then
         return Ada_Include_Path (Project, In_Tree).all;
      else
         In_Tree.Private_Part.Ada_Path_Length := 0;
         Add_To_Path (Project.Source_Dirs, In_Tree);
         return
           In_Tree.Private_Part.Ada_Path_Buffer
             (1 .. In_Tree.Private_Part.Ada_Path_Length);
      end if;
   end Ada_Include_Path;

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

   function Ada_Objects_Path
     (Project             : Project_Id;
      In_Tree             : Project_Tree_Ref;
      Including_Libraries : Boolean := True) return String_Access
   is
      procedure Add (Project : Project_Id; Dummy : in out Boolean);
      --  Add all the object directories of a project to the path

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

      procedure Add (Project : Project_Id; Dummy : in out Boolean) is
         pragma Unreferenced (Dummy);
         Path : constant Path_Name_Type :=
                  Get_Object_Directory
                    (Project,
                     Including_Libraries => Including_Libraries,
                     Only_If_Ada         => False);
      begin
         if Path /= No_Path then
            Add_To_Path (Get_Name_String (Path), In_Tree);
         end if;
      end Add;

      procedure For_All_Projects is
        new For_Every_Project_Imported (Boolean, Add);
      Dummy : Boolean := False;

   --  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 Project.Ada_Objects_Path = null then
         In_Tree.Private_Part.Ada_Path_Length := 0;
         For_All_Projects (Project, Dummy);

         Project.Ada_Objects_Path :=
           new String'
             (In_Tree.Private_Part.Ada_Path_Buffer
                  (1 .. In_Tree.Private_Part.Ada_Path_Length));
      end if;

      return Project.Ada_Objects_Path;
   end Ada_Objects_Path;

   ------------------------
   -- Add_To_Object_Path --
   ------------------------

   procedure Add_To_Object_Path
     (Object_Dir : Path_Name_Type; In_Tree : Project_Tree_Ref)
   is
   begin
      --  Check if the directory is already in the table

      for Index in Object_Path_Table.First ..
                   Object_Path_Table.Last (In_Tree.Private_Part.Object_Paths)
      loop

         --  If it is, remove it, and add it as the last one

         if In_Tree.Private_Part.Object_Paths.Table (Index) = Object_Dir then
            for Index2 in Index + 1 ..
                          Object_Path_Table.Last
                            (In_Tree.Private_Part.Object_Paths)
            loop
               In_Tree.Private_Part.Object_Paths.Table (Index2 - 1) :=
                 In_Tree.Private_Part.Object_Paths.Table (Index2);
            end loop;

            In_Tree.Private_Part.Object_Paths.Table
              (Object_Path_Table.Last (In_Tree.Private_Part.Object_Paths)) :=
                 Object_Dir;
            return;
         end if;
      end loop;

      --  The directory is not already in the table, add it

      Object_Path_Table.Increment_Last (In_Tree.Private_Part.Object_Paths);
      In_Tree.Private_Part.Object_Paths.Table
        (Object_Path_Table.Last (In_Tree.Private_Part.Object_Paths)) :=
           Object_Dir;
   end Add_To_Object_Path;

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

   procedure Add_To_Path
     (Source_Dirs : String_List_Id;
      In_Tree     : Project_Tree_Ref)
   is
      Current    : String_List_Id := Source_Dirs;
      Source_Dir : String_Element;
   begin
      while Current /= Nil_String loop
         Source_Dir := In_Tree.String_Elements.Table (Current);
         Add_To_Path (Get_Name_String (Source_Dir.Display_Value), In_Tree);
         Current := Source_Dir.Next;
      end loop;
   end Add_To_Path;

   procedure Add_To_Path (Dir : String; In_Tree : Project_Tree_Ref) is
      Len        : Natural;
      New_Buffer : String_Access;
      Min_Len    : Natural;

      function Is_Present (Path : String; Dir : String) return Boolean;
      --  Return True if Dir is part of Path

      ----------------
      -- Is_Present --
      ----------------

      function Is_Present (Path : String; Dir : String) return Boolean is
         Last : constant Integer := Path'Last - Dir'Length + 1;

      begin
         for J in Path'First .. Last loop

            --  Note: the order of the conditions below is important, since
            --  it ensures a minimal number of string comparisons.

            if (J = Path'First
                or else Path (J - 1) = Path_Separator)
              and then
                (J + Dir'Length > Path'Last
                 or else Path (J + Dir'Length) = Path_Separator)
              and then Dir = Path (J .. J + Dir'Length - 1)
            then
               return True;
            end if;
         end loop;

         return False;
      end Is_Present;

   --  Start of processing for Add_To_Path

   begin
      if Is_Present (In_Tree.Private_Part.Ada_Path_Buffer
                       (1 .. In_Tree.Private_Part.Ada_Path_Length),
                     Dir)
      then

         --  Dir is already in the path, nothing to do

         return;
      end if;

      Min_Len := In_Tree.Private_Part.Ada_Path_Length + Dir'Length;

      if In_Tree.Private_Part.Ada_Path_Length > 0 then

         --  Add 1 for the Path_Separator character

         Min_Len := Min_Len + 1;
      end if;

      --  If Ada_Path_Buffer is too small, increase it

      Len := In_Tree.Private_Part.Ada_Path_Buffer'Last;

      if Len < Min_Len then
         loop
            Len := Len * 2;
            exit when Len >= Min_Len;
         end loop;

         New_Buffer := new String (1 .. Len);
         New_Buffer (1 .. In_Tree.Private_Part.Ada_Path_Length) :=
           In_Tree.Private_Part.Ada_Path_Buffer
             (1 .. In_Tree.Private_Part.Ada_Path_Length);
         Free (In_Tree.Private_Part.Ada_Path_Buffer);
         In_Tree.Private_Part.Ada_Path_Buffer := New_Buffer;
      end if;

      if In_Tree.Private_Part.Ada_Path_Length > 0 then
         In_Tree.Private_Part.Ada_Path_Length :=
           In_Tree.Private_Part.Ada_Path_Length + 1;
         In_Tree.Private_Part.Ada_Path_Buffer
           (In_Tree.Private_Part.Ada_Path_Length) := Path_Separator;
      end if;

      In_Tree.Private_Part.Ada_Path_Buffer
        (In_Tree.Private_Part.Ada_Path_Length + 1 ..
           In_Tree.Private_Part.Ada_Path_Length + Dir'Length) := Dir;
      In_Tree.Private_Part.Ada_Path_Length :=
        In_Tree.Private_Part.Ada_Path_Length + Dir'Length;
   end Add_To_Path;

   ------------------------
   -- Add_To_Source_Path --
   ------------------------

   procedure Add_To_Source_Path
     (Source_Dirs : String_List_Id; In_Tree : Project_Tree_Ref)
   is
      Current    : String_List_Id := Source_Dirs;
      Source_Dir : String_Element;
      Add_It     : Boolean;

   begin
      --  Add each source directory

      while Current /= Nil_String loop
         Source_Dir := In_Tree.String_Elements.Table (Current);
         Add_It := True;

         --  Check if the source directory is already in the table

         for Index in Source_Path_Table.First ..
                      Source_Path_Table.Last
                                          (In_Tree.Private_Part.Source_Paths)
         loop
            --  If it is already, no need to add it

            if In_Tree.Private_Part.Source_Paths.Table (Index) =
                        Source_Dir.Value
            then
               Add_It := False;
               exit;
            end if;
         end loop;

         if Add_It then
            Source_Path_Table.Increment_Last
              (In_Tree.Private_Part.Source_Paths);
            In_Tree.Private_Part.Source_Paths.Table
              (Source_Path_Table.Last (In_Tree.Private_Part.Source_Paths)) :=
              Source_Dir.Value;
         end if;

         --  Next source directory

         Current := Source_Dir.Next;
      end loop;
   end Add_To_Source_Path;

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

   procedure Create_Config_Pragmas_File
     (For_Project : Project_Id;
      In_Tree     : Project_Tree_Ref)
   is
      type Naming_Id is new Nat;
      package Naming_Table is new GNAT.Dynamic_Tables
        (Table_Component_Type => Lang_Naming_Data,
         Table_Index_Type     => Naming_Id,
         Table_Low_Bound      => 1,
         Table_Initial        => 5,
         Table_Increment      => 100);
      Default_Naming : constant Naming_Id := Naming_Table.First;
      Namings        : Naming_Table.Instance;
      --  Table storing the naming data for gnatmake/gprmake

      File_Name : Path_Name_Type  := No_Path;
      File      : File_Descriptor := Invalid_FD;

      Current_Naming  : Naming_Id;
      Iter            : Source_Iterator;
      Source          : Source_Id;

      Status : Boolean;
      --  For call to Close

      procedure Check (Project : Project_Id; State : in out Integer);
      --  Recursive procedure that put in the config pragmas file any non
      --  standard naming schemes, if it is not already in the file, then call
      --  itself for any imported project.

      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 Put (Source : Source_Id);
      --  Put an SFN pragma in the temporary file

      procedure Put (File : File_Descriptor; S : String);
      procedure Put_Line (File : File_Descriptor; S : String);
      --  Output procedures, analogous to normal Text_IO procs of same name

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

      procedure Check (Project : Project_Id; State : in out Integer) is
         pragma Unreferenced (State);
         Lang   : constant Language_Ptr :=
                    Get_Language_From_Name (Project, "ada");
         Naming : Lang_Naming_Data;

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

         if Lang = null then
            if Current_Verbosity = High then
               Write_Line ("   Languages does not contain Ada, nothing to do");
            end if;

            return;
         end if;

         Naming := Lang.Config.Naming_Data;

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

         Current_Naming := Default_Naming;
         while Current_Naming <= Naming_Table.Last (Namings)
           and then Namings.Table (Current_Naming).Dot_Replacement =
                                                    Naming.Dot_Replacement
           and then Namings.Table (Current_Naming).Casing =
                                                    Naming.Casing
           and then Namings.Table (Current_Naming).Separate_Suffix =
                                                    Naming.Separate_Suffix
         loop
            Current_Naming := Current_Naming + 1;
         end loop;

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

         if Current_Naming > Naming_Table.Last (Namings) then
            Naming_Table.Increment_Last (Namings);
            Namings.Table (Naming_Table.Last (Namings)) := 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_Project");
            Put_Line
              (File, "  (Spec_File_Name  => ""*" &
               Get_Name_String (Naming.Spec_Suffix) & """,");
            Put_Line
              (File, "   Casing          => " &
               Image (Naming.Casing) & ",");
            Put_Line
              (File, "   Dot_Replacement => """ &
               Get_Name_String (Naming.Dot_Replacement) & """);");

            --  and body

            Put_Line
              (File, "pragma Source_File_Name_Project");
            Put_Line
              (File, "  (Body_File_Name  => ""*" &
               Get_Name_String (Naming.Body_Suffix) & """,");
            Put_Line
              (File, "   Casing          => " &
               Image (Naming.Casing) & ",");
            Put_Line
              (File, "   Dot_Replacement => """ &
               Get_Name_String (Naming.Dot_Replacement) &
               """);");

            --  and maybe separate

            if Naming.Body_Suffix /= Naming.Separate_Suffix then
               Put_Line (File, "pragma Source_File_Name_Project");
               Put_Line
                 (File, "  (Subunit_File_Name  => ""*" &
                  Get_Name_String (Naming.Separate_Suffix) & """,");
               Put_Line
                 (File, "   Casing          => " &
                  Image (Naming.Casing) & ",");
               Put_Line
                 (File, "   Dot_Replacement => """ &
                  Get_Name_String (Naming.Dot_Replacement) &
                  """);");
            end if;
         end if;
      end Check;

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

      procedure Check_Temp_File is
      begin
         if File = Invalid_FD then
            Tempdir.Create_Temp_File (File, Name => File_Name);

            if File = Invalid_FD then
               Prj.Com.Fail
                 ("unable to create temporary configuration pragmas file");

            else
               Record_Temp_File (File_Name);

               if Opt.Verbose_Mode then
                  Write_Str ("Creating temp file """);
                  Write_Str (Get_Name_String (File_Name));
                  Write_Line ("""");
               end if;
            end if;
         end if;
      end Check_Temp_File;

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

      procedure Put (Source : Source_Id) 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_Project (");
         Put (File, Namet.Get_Name_String (Source.Unit.Name));

         if Source.Kind = Spec then
            Put (File, ", Spec_File_Name => """);
         else
            Put (File, ", Body_File_Name => """);
         end if;

         Put (File, Namet.Get_Name_String (Source.File));
         Put (File, """");

         if Source.Index /= 0 then
            Put (File, ", Index =>");
            Put (File, Source.Index'Img);
         end if;

         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
            Prj.Com.Fail
              ("Disk full when creating " & Get_Name_String (File_Name));
         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 config file is supposed to
         --  be used only by the compiler, we don't care about the characters
         --  for the end of line. In fact we could have put a space, but
         --  it is more convenient to be able to read gnat.adc during
         --  development, for which the ASCII.LF is fine.

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

         if Last /= S'Length + 1 then
            Prj.Com.Fail
              ("Disk full when creating " & Get_Name_String (File_Name));
         end if;

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

      procedure Check_Imported_Projects is new For_Every_Project_Imported
        (Integer, Check);
      Dummy : Integer := 0;

   --  Start of processing for Create_Config_Pragmas_File

   begin
      if not For_Project.Config_Checked then

         Naming_Table.Init (Namings);

         --  Check the naming schemes

         Check_Imported_Projects (For_Project, Dummy, Imported_First => False);

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

         Iter := For_Each_Source (In_Tree, For_Project);

         while Element (Iter) /= No_Source loop
            Source := Element (Iter);

            if Source.Index >= 1
              and then not Source.Locally_Removed
              and then Source.Unit /= null
            then
               Put (Source);
            end if;

            Next (Iter);
         end loop;

         --  If there are no non standard naming scheme, issue the GNAT
         --  standard naming scheme. This will tell the compiler that
         --  a project file is used and will forbid any pragma SFN.

         if File = Invalid_FD then
            Check_Temp_File;

            Put_Line (File, "pragma Source_File_Name_Project");
            Put_Line (File, "   (Spec_File_Name  => ""*.ads"",");
            Put_Line (File, "    Dot_Replacement => ""-"",");
            Put_Line (File, "    Casing          => lowercase);");

            Put_Line (File, "pragma Source_File_Name_Project");
            Put_Line (File, "   (Body_File_Name  => ""*.adb"",");
            Put_Line (File, "    Dot_Replacement => ""-"",");
            Put_Line (File, "    Casing          => lowercase);");
         end if;

         --  Close the temporary file

         GNAT.OS_Lib.Close (File, Status);

         if not Status then
            Prj.Com.Fail
              ("Disk full when creating " & Get_Name_String (File_Name));
         end if;

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

         For_Project.Config_File_Name := File_Name;
         For_Project.Config_File_Temp := True;
         For_Project.Config_Checked   := True;
      end if;
   end Create_Config_Pragmas_File;

   --------------------
   -- Create_Mapping --
   --------------------

   procedure Create_Mapping (In_Tree : Project_Tree_Ref) is
      Data : Source_Id;
      Iter : Source_Iterator;

   begin
      Fmap.Reset_Tables;

      Iter := For_Each_Source (In_Tree);
      loop
         Data := Element (Iter);
         exit when Data = No_Source;

         if Data.Unit /= No_Unit_Index then
            if Data.Locally_Removed then
               Fmap.Add_Forbidden_File_Name (Data.File);
            else
               Fmap.Add_To_File_Map
                 (Unit_Name => Unit_Name_Type (Data.Unit.Name),
                  File_Name => Data.File,
                  Path_Name => File_Name_Type (Data.Path.Name));
            end if;
         end if;

         Next (Iter);
      end loop;
   end Create_Mapping;

   -------------------------
   -- Create_Mapping_File --
   -------------------------

   procedure Create_Mapping_File
     (Project  : Project_Id;
      Language : Name_Id;
      In_Tree  : Project_Tree_Ref;
      Name     : out Path_Name_Type)
   is
      File   : File_Descriptor := Invalid_FD;
      Status : Boolean;

      procedure Put_Name_Buffer;
      --  Put the line contained in the Name_Buffer in the mapping file

      procedure Process (Project : Project_Id; State : in out Integer);
      --  Generate the mapping file for Project (not recursively)

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

      procedure Put_Name_Buffer is
         Last : Natural;

      begin
         Name_Len := Name_Len + 1;
         Name_Buffer (Name_Len) := ASCII.LF;
         Last := Write (File, Name_Buffer (1)'Address, Name_Len);

         if Current_Verbosity = High then
            Write_Str ("Mapping file: " & Name_Buffer (1 .. Name_Len));
         end if;

         if Last /= Name_Len then
            Prj.Com.Fail ("Disk full, cannot write mapping file");
         end if;
      end Put_Name_Buffer;

      -------------
      -- Process --
      -------------

      procedure Process (Project : Project_Id; State : in out Integer) is
         pragma Unreferenced (State);
         Source : Source_Id;
         Suffix : File_Name_Type;
         Iter   : Source_Iterator;

      begin
         Iter := For_Each_Source (In_Tree, Project, Language => Language);

         loop
            Source := Prj.Element (Iter);
            exit when Source = No_Source;

            if Source.Replaced_By = No_Source
              and then Source.Path.Name /= No_Path
              and then
                (Source.Language.Config.Kind = File_Based
                  or else Source.Unit /= No_Unit_Index)
            then
               if Source.Unit /= No_Unit_Index then
                  Get_Name_String (Source.Unit.Name);

                  if Get_Mode = Ada_Only then

                     --  ??? Mapping_Spec_Suffix could be set in the case of
                     --  gnatmake as well

                     Add_Char_To_Name_Buffer ('%');

                     if Source.Kind = Spec then
                        Add_Char_To_Name_Buffer ('s');
                     else
                        Add_Char_To_Name_Buffer ('b');
                     end if;

                  else
                     case Source.Kind is
                        when Spec =>
                           Suffix :=
                             Source.Language.Config.Mapping_Spec_Suffix;
                        when Impl | Sep =>
                           Suffix :=
                             Source.Language.Config.Mapping_Body_Suffix;
                     end case;

                     if Suffix /= No_File then
                        Add_Str_To_Name_Buffer
                          (Get_Name_String (Suffix));
                     end if;
                  end if;

                  Put_Name_Buffer;
               end if;

               Get_Name_String (Source.File);
               Put_Name_Buffer;

               if Source.Locally_Removed then
                  Name_Len := 1;
                  Name_Buffer (1) := '/';
               else
                  Get_Name_String (Source.Path.Name);
               end if;

               Put_Name_Buffer;
            end if;

            Next (Iter);
         end loop;
      end Process;

      procedure For_Every_Imported_Project is new
        For_Every_Project_Imported (State => Integer, Action => Process);

      Dummy : Integer := 0;

   --  Start of processing for Create_Mapping_File

   begin

      --  Create the temporary file

      Tempdir.Create_Temp_File (File, Name => Name);

      if File = Invalid_FD then
         Prj.Com.Fail ("unable to create temporary mapping file");

      else
         Record_Temp_File (Name);

         if Opt.Verbose_Mode then
            Write_Str ("Creating temp mapping file """);
            Write_Str (Get_Name_String (Name));
            Write_Line ("""");
         end if;
      end if;

      For_Every_Imported_Project (Project, Dummy);
      GNAT.OS_Lib.Close (File, Status);

      if not Status then

         --  We were able to create the temporary file, so there is no problem
         --  of protection. However, we are not able to close it, so there must
         --  be a capacity problem that we express using "disk full".

         Prj.Com.Fail ("disk full, could not write mapping file");
      end if;
   end Create_Mapping_File;

   --------------------------
   -- Create_New_Path_File --
   --------------------------

   procedure Create_New_Path_File
     (In_Tree   : Project_Tree_Ref;
      Path_FD   : out File_Descriptor;
      Path_Name : out Path_Name_Type)
   is
   begin
      Tempdir.Create_Temp_File (Path_FD, Path_Name);

      if Path_Name /= No_Path then
         Record_Temp_File (Path_Name);

         --  Record the name, so that the temp path file will be deleted at the
         --  end of the program.

         Path_File_Table.Increment_Last (In_Tree.Private_Part.Path_Files);
         In_Tree.Private_Part.Path_Files.Table
           (Path_File_Table.Last (In_Tree.Private_Part.Path_Files)) :=
              Path_Name;
      end if;
   end Create_New_Path_File;

   ---------------------------
   -- Delete_All_Path_Files --
   ---------------------------

   procedure Delete_All_Path_Files (In_Tree : Project_Tree_Ref) is
      Disregard : Boolean := True;
      pragma Unreferenced (Disregard);

   begin
      for Index in Path_File_Table.First ..
                   Path_File_Table.Last (In_Tree.Private_Part.Path_Files)
      loop
         if In_Tree.Private_Part.Path_Files.Table (Index) /= No_Path then
            Delete_File
              (Get_Name_String
                 (In_Tree.Private_Part.Path_Files.Table (Index)),
               Disregard);
         end if;
      end loop;

      --  If any of the environment variables ADA_PRJ_INCLUDE_FILE or
      --  ADA_PRJ_OBJECTS_FILE has been set, then reset their value to
      --  the empty string. On VMS, this has the effect of deassigning
      --  the logical names.

      if In_Tree.Private_Part.Ada_Prj_Include_File_Set then
         Setenv (Project_Include_Path_File, "");
         In_Tree.Private_Part.Ada_Prj_Include_File_Set := False;
      end if;

      if In_Tree.Private_Part.Ada_Prj_Objects_File_Set then
         Setenv (Project_Objects_Path_File, "");
         In_Tree.Private_Part.Ada_Prj_Objects_File_Set := False;
      end if;
   end Delete_All_Path_Files;

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

   function File_Name_Of_Library_Unit_Body
     (Name              : String;
      Project           : Project_Id;
      In_Tree           : Project_Tree_Ref;
      Main_Project_Only : Boolean := True;
      Full_Path         : Boolean := False) return String
   is
      The_Project   : Project_Id := Project;
      Original_Name : String := Name;

      Lang   : constant Language_Ptr :=
        Get_Language_From_Name (Project, "ada");

      Unit              : Unit_Index;
      The_Original_Name : Name_Id;
      The_Spec_Name     : Name_Id;
      The_Body_Name     : Name_Id;

   begin
      --  ??? Same block in Project_Of
      Canonical_Case_File_Name (Original_Name);
      Name_Len := Original_Name'Length;
      Name_Buffer (1 .. Name_Len) := Original_Name;
      The_Original_Name := Name_Find;

      if Lang /= null then
         declare
            Naming : constant Lang_Naming_Data := Lang.Config.Naming_Data;
            Extended_Spec_Name : String :=
                                   Name & Namet.Get_Name_String
                                            (Naming.Spec_Suffix);
            Extended_Body_Name : String :=
                                   Name & Namet.Get_Name_String
                                            (Naming.Body_Suffix);

         begin
            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;
         end;

      else
         Name_Len := Name'Length;
         Name_Buffer (1 .. Name_Len) := Name;
         Canonical_Case_File_Name (Name_Buffer);
         The_Spec_Name := Name_Find;
         The_Body_Name := The_Spec_Name;
      end if;

      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  (Get_Name_String (The_Spec_Name));
         Write_Char ('"');
         Write_Eol;
         Write_Str  ("   Extended Body Name = """);
         Write_Str  (Get_Name_String (The_Body_Name));
         Write_Char ('"');
         Write_Eol;
      end if;

      --  For extending project, search in the extended project if the source
      --  is not found. For non extending projects, this loop will be run only
      --  once.

      loop
         --  Loop through units

         Unit := Units_Htable.Get_First (In_Tree.Units_HT);
         while Unit /= null loop
            --  Check for body

            if not Main_Project_Only
              or else
                (Unit.File_Names (Impl) /= null
                 and then Unit.File_Names (Impl).Project = The_Project)
            then
               declare
                  Current_Name : File_Name_Type;
               begin
                  --  Case of a body present

                  if Unit.File_Names (Impl) /= null then
                     Current_Name := Unit.File_Names (Impl).File;

                     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 = File_Name_Type (The_Original_Name)
                     then
                        if Current_Verbosity = High then
                           Write_Line ("   OK");
                        end if;

                        if Full_Path then
                           return Get_Name_String
                             (Unit.File_Names (Impl).Path.Name);

                        else
                           return Get_Name_String (Current_Name);
                        end if;

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

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

                        if Full_Path then
                           return Get_Name_String
                             (Unit.File_Names (Impl).Path.Name);

                        else
                           return Get_Name_String (The_Body_Name);
                        end if;

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

            --  Check for spec

            if not Main_Project_Only
              or else
                (Unit.File_Names (Spec) /= null
                 and then Unit.File_Names (Spec).Project =
                   The_Project)
            then
               declare
                  Current_Name : File_Name_Type;

               begin
                  --  Case of spec present

                  if Unit.File_Names (Spec) /= null then
                     Current_Name := Unit.File_Names (Spec).File;
                     if Current_Verbosity = High then
                        Write_Str  ("   Comparing with """);
                        Write_Str  (Get_Name_String (Current_Name));
                        Write_Char ('"');
                        Write_Eol;
                     end if;

                     --  If name same as original name, return original name

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

                        if Full_Path then
                           return Get_Name_String
                             (Unit.File_Names (Spec).Path.Name);
                        else
                           return Get_Name_String (Current_Name);
                        end if;

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

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

                        if Full_Path then
                           return Get_Name_String
                             (Unit.File_Names (Spec).Path.Name);
                        else
                           return Get_Name_String (The_Spec_Name);
                        end if;

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

            Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
         end loop;

         --  If we are not in an extending project, give up

         exit when not Main_Project_Only
           or else The_Project.Extends = No_Project;

         --  Otherwise, look in the project we are extending

         The_Project := The_Project.Extends;
      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
      procedure For_Project (Prj : Project_Id; Dummy : in out Integer);
      --  Get all object directories of Prj

      -----------------
      -- For_Project --
      -----------------

      procedure For_Project (Prj : Project_Id; Dummy : in out Integer) is
         pragma Unreferenced (Dummy);
      begin
         --  ??? Set_Ada_Paths has a different behavior for library project
         --  files, should we have the same ?

         if Prj.Object_Directory /= No_Path_Information then
            Get_Name_String (Prj.Object_Directory.Display_Name);
            Action (Name_Buffer (1 .. Name_Len));
         end if;
      end For_Project;

      procedure Get_Object_Dirs is
        new For_Every_Project_Imported (Integer, For_Project);
      Dummy : Integer := 1;

   --  Start of processing for For_All_Object_Dirs

   begin
      Get_Object_Dirs (Project, Dummy);
   end For_All_Object_Dirs;

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

   procedure For_All_Source_Dirs
     (Project : Project_Id;
      In_Tree : Project_Tree_Ref)
   is
      procedure For_Project (Prj : Project_Id; Dummy : in out Integer);
      --  Get all object directories of Prj

      -----------------
      -- For_Project --
      -----------------

      procedure For_Project (Prj : Project_Id; Dummy : in out Integer) is
         pragma Unreferenced (Dummy);
         Current    : String_List_Id := Prj.Source_Dirs;
         The_String : String_Element;

      begin
         --  If there are Ada sources, call action with the name of every
         --  source directory.

         if Has_Ada_Sources (Project) then
            while Current /= Nil_String loop
               The_String := In_Tree.String_Elements.Table (Current);
               Action (Get_Name_String (The_String.Display_Value));
               Current := The_String.Next;
            end loop;
         end if;
      end For_Project;

      procedure Get_Source_Dirs is
        new For_Every_Project_Imported (Integer, For_Project);
      Dummy : Integer := 1;

   --  Start of processing for For_All_Source_Dirs

   begin
      Get_Source_Dirs (Project, Dummy);
   end For_All_Source_Dirs;

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

   procedure Get_Reference
     (Source_File_Name : String;
      In_Tree          : Project_Tree_Ref;
      Project          : out Project_Id;
      Path             : out Path_Name_Type)
   is
   begin
      --  Body below could use some comments ???

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

      begin
         Canonical_Case_File_Name (Original_Name);
         Unit := Units_Htable.Get_First (In_Tree.Units_HT);

         while Unit /= null loop
            if Unit.File_Names (Spec) /= null
              and then Unit.File_Names (Spec).File /= No_File
              and then
                (Namet.Get_Name_String
                     (Unit.File_Names (Spec).File) = Original_Name
                 or else (Unit.File_Names (Spec).Path /=
                            No_Path_Information
                          and then
                            Namet.Get_Name_String
                              (Unit.File_Names (Spec).Path.Name) =
                            Original_Name))
            then
               Project := Ultimate_Extension_Of
                          (Project => Unit.File_Names (Spec).Project);
               Path := Unit.File_Names (Spec).Path.Display_Name;

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

               return;

            elsif Unit.File_Names (Impl) /= null
              and then Unit.File_Names (Impl).File /= No_File
              and then
                (Namet.Get_Name_String
                   (Unit.File_Names (Impl).File) = Original_Name
                 or else (Unit.File_Names (Impl).Path /=
                            No_Path_Information
                          and then Namet.Get_Name_String
                            (Unit.File_Names (Impl).Path.Name) =
                            Original_Name))
            then
               Project := Ultimate_Extension_Of
                            (Project => Unit.File_Names (Impl).Project);
               Path := Unit.File_Names (Impl).Path.Display_Name;

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

               return;
            end if;

            Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
         end loop;
      end;

      Project := No_Project;
      Path    := No_Path;

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

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

   procedure Initialize (In_Tree : Project_Tree_Ref) is
   begin
      In_Tree.Private_Part.Fill_Mapping_File := True;
      In_Tree.Private_Part.Current_Source_Path_File := No_Path;
      In_Tree.Private_Part.Current_Object_Path_File := No_Path;
   end Initialize;

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

   --  Could use some comments in this body ???

   procedure Print_Sources (In_Tree : Project_Tree_Ref) is
      Unit : Unit_Index;

   begin
      Write_Line ("List of Sources:");

      Unit := Units_Htable.Get_First (In_Tree.Units_HT);

      while Unit /= No_Unit_Index loop
         Write_Str  ("   ");
         Write_Line (Namet.Get_Name_String (Unit.Name));

         if Unit.File_Names (Spec).File /= No_File then
            if Unit.File_Names (Spec).Project = No_Project then
               Write_Line ("   No project");

            else
               Write_Str  ("   Project: ");
               Get_Name_String
                 (Unit.File_Names (Spec).Project.Path.Name);
               Write_Line (Name_Buffer (1 .. Name_Len));
            end if;

            Write_Str  ("      spec: ");
            Write_Line
              (Namet.Get_Name_String
               (Unit.File_Names (Spec).File));
         end if;

         if Unit.File_Names (Impl).File /= No_File then
            if Unit.File_Names (Impl).Project = No_Project then
               Write_Line ("   No project");

            else
               Write_Str  ("   Project: ");
               Get_Name_String
                 (Unit.File_Names (Impl).Project.Path.Name);
               Write_Line (Name_Buffer (1 .. Name_Len));
            end if;

            Write_Str  ("      body: ");
            Write_Line
              (Namet.Get_Name_String (Unit.File_Names (Impl).File));
         end if;

         Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
      end loop;

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

   ----------------
   -- Project_Of --
   ----------------

   function Project_Of
     (Name         : String;
      Main_Project : Project_Id;
      In_Tree      : Project_Tree_Ref) return Project_Id
   is
      Result : Project_Id := No_Project;

      Original_Name : String := Name;

      Lang : constant Language_Ptr :=
               Get_Language_From_Name (Main_Project, "ada");

      Unit : Unit_Index;

      Current_Name      : File_Name_Type;
      The_Original_Name : File_Name_Type;
      The_Spec_Name     : File_Name_Type;
      The_Body_Name     : File_Name_Type;

   begin
      --  ??? Same block in File_Name_Of_Library_Unit_Body
      Canonical_Case_File_Name (Original_Name);
      Name_Len := Original_Name'Length;
      Name_Buffer (1 .. Name_Len) := Original_Name;
      The_Original_Name := Name_Find;

      if Lang /= null then
         declare
            Naming : Lang_Naming_Data renames Lang.Config.Naming_Data;
            Extended_Spec_Name : String :=
                                   Name & Namet.Get_Name_String
                                            (Naming.Spec_Suffix);
            Extended_Body_Name : String :=
                                   Name & Namet.Get_Name_String
                                            (Naming.Body_Suffix);

         begin
            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;
         end;

      else
         The_Spec_Name := The_Original_Name;
         The_Body_Name := The_Original_Name;
      end if;

      Unit := Units_Htable.Get_First (In_Tree.Units_HT);
      while Unit /= null loop

         --  Case of a body present

         if Unit.File_Names (Impl) /= null then
            Current_Name := Unit.File_Names (Impl).File;

            --  If it has the name of the original name or the body name,
            --  we have found the project.

            if Unit.Name = Name_Id (The_Original_Name)
              or else Current_Name = The_Original_Name
              or else Current_Name = The_Body_Name
            then
               Result := Unit.File_Names (Impl).Project;
               exit;
            end if;
         end if;

         --  Check for spec

         if Unit.File_Names (Spec) /= null then
            Current_Name := Unit.File_Names (Spec).File;

            --  If name same as the original name, or the spec name, we have
            --  found the project.

            if Unit.Name = Name_Id (The_Original_Name)
              or else Current_Name = The_Original_Name
              or else Current_Name = The_Spec_Name
            then
               Result := Unit.File_Names (Spec).Project;
               exit;
            end if;
         end if;

         Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
      end loop;

      --  Get the ultimate extending project

      if Result /= No_Project then
         while Result.Extended_By /= No_Project loop
            Result := Result.Extended_By;
         end loop;
      end if;

      return Result;
   end Project_Of;

   -------------------
   -- Set_Ada_Paths --
   -------------------

   procedure Set_Ada_Paths
     (Project             : Project_Id;
      In_Tree             : Project_Tree_Ref;
      Including_Libraries : Boolean)

   is
      Source_FD : File_Descriptor := Invalid_FD;
      Object_FD : File_Descriptor := Invalid_FD;

      Process_Source_Dirs : Boolean := False;
      Process_Object_Dirs : Boolean := False;

      Status : Boolean;
      --  For calls to Close

      Len : Natural;

      procedure Recursive_Add (Project : Project_Id; Dummy : in out Boolean);
      --  Recursive procedure to add the source/object paths of extended/
      --  imported projects.

      -------------------
      -- Recursive_Add --
      -------------------

      procedure Recursive_Add (Project : Project_Id; Dummy : in out Boolean) is
         pragma Unreferenced (Dummy);

         Path : Path_Name_Type;

      begin
         --  ??? This is almost the equivalent of For_All_Source_Dirs

         if Process_Source_Dirs then

            --  Add to path all source directories of this project if there are
            --  Ada sources.

            if Has_Ada_Sources (Project) then
               Add_To_Source_Path (Project.Source_Dirs, In_Tree);
            end if;
         end if;

         if Process_Object_Dirs then
            Path := Get_Object_Directory
              (Project,
               Including_Libraries => Including_Libraries,
               Only_If_Ada         => True);

            if Path /= No_Path then
               Add_To_Object_Path (Path, In_Tree);
            end if;
         end if;
      end Recursive_Add;

      procedure For_All_Projects is
        new For_Every_Project_Imported (Boolean, Recursive_Add);
      Dummy : Boolean := False;

   --  Start of processing for Set_Ada_Paths

   begin
      --  If it is the first time we call this procedure for this project,
      --  compute the source path and/or the object path.

      if Project.Include_Path_File = No_Path then
         Process_Source_Dirs := True;
         Create_New_Path_File
           (In_Tree, Source_FD, Project.Include_Path_File);
      end if;

      --  For the object path, we make a distinction depending on
      --  Including_Libraries.

      if Including_Libraries then
         if Project.Objects_Path_File_With_Libs = No_Path then
            Process_Object_Dirs := True;
            Create_New_Path_File
              (In_Tree, Object_FD, Project.Objects_Path_File_With_Libs);
         end if;

      else
         if Project.Objects_Path_File_Without_Libs = No_Path then
            Process_Object_Dirs := True;
            Create_New_Path_File
              (In_Tree, Object_FD, Project.Objects_Path_File_Without_Libs);
         end if;
      end if;

      --  If there is something to do, set Seen to False for all projects,
      --  then call the recursive procedure Add for Project.

      if Process_Source_Dirs or Process_Object_Dirs then
         Source_Path_Table.Set_Last (In_Tree.Private_Part.Source_Paths, 0);
         Object_Path_Table.Set_Last (In_Tree.Private_Part.Object_Paths, 0);
         For_All_Projects (Project, Dummy);
      end if;

      --  Write and close any file that has been created

      if Source_FD /= Invalid_FD then
         for Index in Source_Path_Table.First ..
                      Source_Path_Table.Last
                        (In_Tree.Private_Part.Source_Paths)
         loop
            Get_Name_String (In_Tree.Private_Part.Source_Paths.Table (Index));
            Name_Len := Name_Len + 1;
            Name_Buffer (Name_Len) := ASCII.LF;
            Len := Write (Source_FD, Name_Buffer (1)'Address, Name_Len);

            if Len /= Name_Len then
               Prj.Com.Fail ("disk full");
            end if;
         end loop;

         Close (Source_FD, Status);

         if not Status then
            Prj.Com.Fail ("disk full");
         end if;
      end if;

      if Object_FD /= Invalid_FD then
         for Index in Object_Path_Table.First ..
                      Object_Path_Table.Last
                        (In_Tree.Private_Part.Object_Paths)
         loop
            Get_Name_String (In_Tree.Private_Part.Object_Paths.Table (Index));
            Name_Len := Name_Len + 1;
            Name_Buffer (Name_Len) := ASCII.LF;
            Len := Write (Object_FD, Name_Buffer (1)'Address, Name_Len);

            if Len /= Name_Len then
               Prj.Com.Fail ("disk full");
            end if;
         end loop;

         Close (Object_FD, Status);

         if not Status then
            Prj.Com.Fail ("disk full");
         end if;
      end if;

      --  Set the env vars, if they need to be changed, and set the
      --  corresponding flags.

      if In_Tree.Private_Part.Current_Source_Path_File /=
           Project.Include_Path_File
      then
         In_Tree.Private_Part.Current_Source_Path_File :=
           Project.Include_Path_File;
         Set_Path_File_Var
           (Project_Include_Path_File,
            Get_Name_String (In_Tree.Private_Part.Current_Source_Path_File));
         In_Tree.Private_Part.Ada_Prj_Include_File_Set := True;
      end if;

      if Including_Libraries then
         if In_Tree.Private_Part.Current_Object_Path_File /=
            Project.Objects_Path_File_With_Libs
         then
            In_Tree.Private_Part.Current_Object_Path_File :=
              Project.Objects_Path_File_With_Libs;
            Set_Path_File_Var
              (Project_Objects_Path_File,
               Get_Name_String
                 (In_Tree.Private_Part.Current_Object_Path_File));
            In_Tree.Private_Part.Ada_Prj_Objects_File_Set := True;
         end if;

      else
         if In_Tree.Private_Part.Current_Object_Path_File /=
            Project.Objects_Path_File_Without_Libs
         then
            In_Tree.Private_Part.Current_Object_Path_File :=
              Project.Objects_Path_File_Without_Libs;
            Set_Path_File_Var
              (Project_Objects_Path_File,
               Get_Name_String
                 (In_Tree.Private_Part.Current_Object_Path_File));
            In_Tree.Private_Part.Ada_Prj_Objects_File_Set := True;
         end if;
      end if;
   end Set_Ada_Paths;

   ---------------------------------------------
   -- Set_Mapping_File_Initial_State_To_Empty --
   ---------------------------------------------

   procedure Set_Mapping_File_Initial_State_To_Empty
     (In_Tree : Project_Tree_Ref)
   is
   begin
      In_Tree.Private_Part.Fill_Mapping_File := False;
   end Set_Mapping_File_Initial_State_To_Empty;

   -----------------------
   -- Set_Path_File_Var --
   -----------------------

   procedure Set_Path_File_Var (Name : String; Value : String) is
      Host_Spec : String_Access := To_Host_File_Spec (Value);
   begin
      if Host_Spec = null then
         Prj.Com.Fail
           ("could not convert file name """ & Value & """ to host spec");
      else
         Setenv (Name, Host_Spec.all);
         Free (Host_Spec);
      end if;
   end Set_Path_File_Var;

   ---------------------------
   -- Ultimate_Extension_Of --
   ---------------------------

   function Ultimate_Extension_Of
     (Project : Project_Id) return Project_Id
   is
      Result : Project_Id;

   begin
      Result := Project;
      while Result.Extended_By /= No_Project loop
         Result := Result.Extended_By;
      end loop;

      return Result;
   end Ultimate_Extension_Of;

end Prj.Env;