path: root/gcc/ada/prj.adb

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                                  P R J                                   --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 2001-2008, Free Software Foundation, Inc.         --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license.          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Characters.Handling; use Ada.Characters.Handling;

with Debug;
with Output;   use Output;
with Osint;    use Osint;
with Prj.Attr;
with Prj.Env;
with Prj.Err;  use Prj.Err;
with Snames;   use Snames;
with Table;
with Uintp;    use Uintp;

with System.Case_Util; use System.Case_Util;
with System.HTable;

package body Prj is

   Object_Suffix : constant String := Get_Target_Object_Suffix.all;
   --  File suffix for object files

   Initial_Buffer_Size : constant := 100;
   --  Initial size for extensible buffer used in Add_To_Buffer

   Current_Mode : Mode := Ada_Only;

   Configuration_Mode : Boolean := False;

   The_Empty_String : Name_Id;

   Default_Ada_Spec_Suffix_Id : File_Name_Type;
   Default_Ada_Body_Suffix_Id : File_Name_Type;
   Slash_Id                   : Path_Name_Type;
   --  Initialized in Prj.Initialize, then never modified

   subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case;

   The_Casing_Images : constant array (Known_Casing) of String_Access :=
     (All_Lower_Case => new String'("lowercase"),
      All_Upper_Case => new String'("UPPERCASE"),
      Mixed_Case     => new String'("MixedCase"));

   Initialized : Boolean := False;

   Standard_Dot_Replacement : constant File_Name_Type :=
                                File_Name_Type
                                  (First_Name_Id + Character'Pos ('-'));

   Std_Naming_Data : constant Naming_Data :=
                       (Dot_Replacement           => Standard_Dot_Replacement,
                        Dot_Repl_Loc              => No_Location,
                        Casing                    => All_Lower_Case,
                        Spec_Suffix               => No_Array_Element,
                        Ada_Spec_Suffix_Loc       => No_Location,
                        Body_Suffix               => No_Array_Element,
                        Ada_Body_Suffix_Loc       => No_Location,
                        Separate_Suffix           => No_File,
                        Sep_Suffix_Loc            => No_Location,
                        Specs                     => No_Array_Element,
                        Bodies                    => No_Array_Element,
                        Specification_Exceptions  => No_Array_Element,
                        Implementation_Exceptions => No_Array_Element);

   Project_Empty : constant Project_Data :=
                     (Qualifier                      => Unspecified,
                      Externally_Built               => False,
                      Config                         => Default_Project_Config,
                      Languages                      => No_Name_List,
                      First_Referred_By              => No_Project,
                      Name                           => No_Name,
                      Display_Name                   => No_Name,
                      Path                           => No_Path_Information,
                      Virtual                        => False,
                      Location                       => No_Location,
                      Mains                          => Nil_String,
                      Directory                      => No_Path_Information,
                      Dir_Path                       => null,
                      Library                        => False,
                      Library_Dir                    => No_Path_Information,
                      Library_Src_Dir                => No_Path_Information,
                      Library_ALI_Dir                => No_Path_Information,
                      Library_Name                   => No_Name,
                      Library_Kind                   => Static,
                      Lib_Internal_Name              => No_Name,
                      Standalone_Library             => False,
                      Lib_Interface_ALIs             => Nil_String,
                      Lib_Auto_Init                  => False,
                      Libgnarl_Needed                => Unknown,
                      Symbol_Data                    => No_Symbols,
                      Ada_Sources_Present            => True,
                      Other_Sources_Present          => True,
                      Ada_Sources                    => Nil_String,
                      First_Source                   => No_Source,
                      Last_Source                    => No_Source,
                      Interfaces_Defined             => False,
                      Unit_Based_Language_Name       => No_Name,
                      Unit_Based_Language_Index      => No_Language_Index,
                      Imported_Directories_Switches  => null,
                      Include_Path                   => null,
                      Include_Data_Set               => False,
                      Include_Language               => No_Language_Index,
                      Source_Dirs                    => Nil_String,
                      Known_Order_Of_Source_Dirs     => True,
                      Object_Directory               => No_Path_Information,
                      Library_TS                     => Empty_Time_Stamp,
                      Exec_Directory                 => No_Path_Information,
                      Extends                        => No_Project,
                      Extended_By                    => No_Project,
                      Naming                         => Std_Naming_Data,
                      First_Language_Processing      => No_Language_Index,
                      Decl                           => No_Declarations,
                      Imported_Projects              => Empty_Project_List,
                      All_Imported_Projects          => Empty_Project_List,
                      Ada_Include_Path               => null,
                      Ada_Objects_Path               => null,
                      Objects_Path                   => null,
                      Include_Path_File              => No_Path,
                      Objects_Path_File_With_Libs    => No_Path,
                      Objects_Path_File_Without_Libs => No_Path,
                      Config_File_Name               => No_Path,
                      Config_File_Temp               => False,
                      Config_Checked                 => False,
                      Checked                        => False,
                      Seen                           => False,
                      Need_To_Build_Lib              => False,
                      Depth                          => 0,
                      Unkept_Comments                => False);

   package Temp_Files is new Table.Table
     (Table_Component_Type => Path_Name_Type,
      Table_Index_Type     => Integer,
      Table_Low_Bound      => 1,
      Table_Initial        => 20,
      Table_Increment      => 100,
      Table_Name           => "Makegpr.Temp_Files");
   --  Table to store the path name of all the created temporary files, so that
   --  they can be deleted at the end, or when the program is interrupted.

   -------------------
   -- Add_To_Buffer --
   -------------------

   procedure Add_To_Buffer
     (S    : String;
      To   : in out String_Access;
      Last : in out Natural)
   is
   begin
      if To = null then
         To := new String (1 .. Initial_Buffer_Size);
         Last := 0;
      end if;

      --  If Buffer is too small, double its size

      while Last + S'Length > To'Last loop
         declare
            New_Buffer : constant  String_Access :=
                           new String (1 .. 2 * Last);

         begin
            New_Buffer (1 .. Last) := To (1 .. Last);
            Free (To);
            To := New_Buffer;
         end;
      end loop;

      To (Last + 1 .. Last + S'Length) := S;
      Last := Last + S'Length;
   end Add_To_Buffer;

   -----------------------
   -- Body_Suffix_Id_Of --
   -----------------------

   function Body_Suffix_Id_Of
     (In_Tree  : Project_Tree_Ref;
      Language : String;
      Naming   : Naming_Data) return File_Name_Type
   is
      Language_Id : Name_Id;

   begin
      Name_Len := 0;
      Add_Str_To_Name_Buffer (Language);
      To_Lower (Name_Buffer (1 .. Name_Len));
      Language_Id := Name_Find;

      return
        Body_Suffix_Id_Of
          (In_Tree     => In_Tree,
           Language_Id => Language_Id,
           Naming      => Naming);
   end Body_Suffix_Id_Of;

   -----------------------
   -- Body_Suffix_Id_Of --
   -----------------------

   function Body_Suffix_Id_Of
     (In_Tree     : Project_Tree_Ref;
      Language_Id : Name_Id;
      Naming      : Naming_Data) return File_Name_Type
   is
      Element_Id : Array_Element_Id;
      Element    : Array_Element;
      Suffix     : File_Name_Type := No_File;
      Lang       : Language_Index;

   begin
      --  ??? This seems to be only for Ada_Only mode...
      Element_Id := Naming.Body_Suffix;
      while Element_Id /= No_Array_Element loop
         Element := In_Tree.Array_Elements.Table (Element_Id);

         if Element.Index = Language_Id then
            return File_Name_Type (Element.Value.Value);
         end if;

         Element_Id := Element.Next;
      end loop;

      if Current_Mode = Multi_Language then
         Lang := In_Tree.First_Language;
         while Lang /= No_Language_Index loop
            if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
               Suffix :=
                 In_Tree.Languages_Data.Table
                   (Lang).Config.Naming_Data.Body_Suffix;
               exit;
            end if;

            Lang := In_Tree.Languages_Data.Table (Lang).Next;
         end loop;
      end if;

      return Suffix;
   end Body_Suffix_Id_Of;

   --------------------
   -- Body_Suffix_Of --
   --------------------

   function Body_Suffix_Of
     (In_Tree  : Project_Tree_Ref;
      Language : String;
      Naming   : Naming_Data) return String
   is
      Language_Id : Name_Id;
      Element_Id  : Array_Element_Id;
      Element     : Array_Element;
      Suffix      : File_Name_Type := No_File;
      Lang        : Language_Index;

   begin
      Name_Len := 0;
      Add_Str_To_Name_Buffer (Language);
      To_Lower (Name_Buffer (1 .. Name_Len));
      Language_Id := Name_Find;

      Element_Id := Naming.Body_Suffix;
      while Element_Id /= No_Array_Element loop
         Element := In_Tree.Array_Elements.Table (Element_Id);

         if Element.Index = Language_Id then
            return Get_Name_String (Element.Value.Value);
         end if;

         Element_Id := Element.Next;
      end loop;

      if Current_Mode = Multi_Language then
         Lang := In_Tree.First_Language;
         while Lang /= No_Language_Index loop
            if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
               Suffix :=
                 File_Name_Type
                   (In_Tree.Languages_Data.Table
                        (Lang).Config.Naming_Data.Body_Suffix);
               exit;
            end if;

            Lang := In_Tree.Languages_Data.Table (Lang).Next;
         end loop;

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

      return "";
   end Body_Suffix_Of;

   -----------------------------
   -- Default_Ada_Body_Suffix --
   -----------------------------

   function Default_Ada_Body_Suffix return File_Name_Type is
   begin
      return Default_Ada_Body_Suffix_Id;
   end Default_Ada_Body_Suffix;

   -----------------------------
   -- Default_Ada_Spec_Suffix --
   -----------------------------

   function Default_Ada_Spec_Suffix return File_Name_Type is
   begin
      return Default_Ada_Spec_Suffix_Id;
   end Default_Ada_Spec_Suffix;

   ---------------------------
   -- Delete_All_Temp_Files --
   ---------------------------

   procedure Delete_All_Temp_Files is
      Dont_Care : Boolean;
      pragma Warnings (Off, Dont_Care);
   begin
      if not Debug.Debug_Flag_N then
         for Index in 1 .. Temp_Files.Last loop
            Delete_File
              (Get_Name_String (Temp_Files.Table (Index)), Dont_Care);
         end loop;
      end if;
   end Delete_All_Temp_Files;

   ---------------------
   -- Dependency_Name --
   ---------------------

   function Dependency_Name
     (Source_File_Name : File_Name_Type;
      Dependency       : Dependency_File_Kind) return File_Name_Type
   is
   begin
      case Dependency is
         when None =>
            return No_File;

         when Makefile =>
            return
              File_Name_Type
                (Extend_Name
                   (Source_File_Name, Makefile_Dependency_Suffix));

         when ALI_File =>
            return
              File_Name_Type
                (Extend_Name
                   (Source_File_Name, ALI_Dependency_Suffix));
      end case;
   end Dependency_Name;

   ---------------------------
   -- Display_Language_Name --
   ---------------------------

   procedure Display_Language_Name
     (In_Tree  : Project_Tree_Ref;
      Language : Language_Index)
   is
   begin
      Get_Name_String (In_Tree.Languages_Data.Table (Language).Display_Name);
      Write_Str (Name_Buffer (1 .. Name_Len));
   end Display_Language_Name;

   ----------------
   -- Empty_File --
   ----------------

   function Empty_File return File_Name_Type is
   begin
      return File_Name_Type (The_Empty_String);
   end Empty_File;

   -------------------
   -- Empty_Project --
   -------------------

   function Empty_Project (Tree : Project_Tree_Ref) return Project_Data is
      Value : Project_Data;

   begin
      Prj.Initialize (Tree => No_Project_Tree);
      Value := Project_Empty;
      Value.Naming := Tree.Private_Part.Default_Naming;

      return Value;
   end Empty_Project;

   ------------------
   -- Empty_String --
   ------------------

   function Empty_String return Name_Id is
   begin
      return The_Empty_String;
   end Empty_String;

   ------------
   -- Expect --
   ------------

   procedure Expect (The_Token : Token_Type; Token_Image : String) is
   begin
      if Token /= The_Token then
         Error_Msg (Token_Image & " expected", Token_Ptr);
      end if;
   end Expect;

   -----------------
   -- Extend_Name --
   -----------------

   function Extend_Name
     (File        : File_Name_Type;
      With_Suffix : String) return File_Name_Type
   is
      Last : Positive;

   begin
      Get_Name_String (File);
      Last := Name_Len + 1;

      while Name_Len /= 0 and then Name_Buffer (Name_Len) /= '.' loop
         Name_Len := Name_Len - 1;
      end loop;

      if Name_Len <= 1 then
         Name_Len := Last;
      end if;

      for J in With_Suffix'Range loop
         Name_Buffer (Name_Len) := With_Suffix (J);
         Name_Len := Name_Len + 1;
      end loop;

      Name_Len := Name_Len - 1;
      return Name_Find;

   end Extend_Name;

   --------------------------------
   -- For_Every_Project_Imported --
   --------------------------------

   procedure For_Every_Project_Imported
     (By         : Project_Id;
      In_Tree    : Project_Tree_Ref;
      With_State : in out State)
   is

      procedure Recursive_Check (Project : Project_Id);
      --  Check if a project has already been seen. If not seen, mark it as
      --  Seen, Call Action, and check all its imported projects.

      ---------------------
      -- Recursive_Check --
      ---------------------

      procedure Recursive_Check (Project : Project_Id) is
         List : Project_List;
      begin
         if not In_Tree.Projects.Table (Project).Seen then
            In_Tree.Projects.Table (Project).Seen := True;
            Action (Project, With_State);

            List := In_Tree.Projects.Table (Project).Imported_Projects;
            while List /= Empty_Project_List loop
               Recursive_Check (In_Tree.Project_Lists.Table (List).Project);
               List := In_Tree.Project_Lists.Table (List).Next;
            end loop;
         end if;
      end Recursive_Check;

   --  Start of processing for For_Every_Project_Imported

   begin
      for Project in Project_Table.First ..
                     Project_Table.Last (In_Tree.Projects)
      loop
         In_Tree.Projects.Table (Project).Seen := False;
      end loop;

      Recursive_Check (Project => By);
   end For_Every_Project_Imported;

   --------------
   -- Get_Mode --
   --------------

   function Get_Mode return Mode is
   begin
      return Current_Mode;
   end Get_Mode;

   ----------
   -- Hash --
   ----------

   function Hash is new System.HTable.Hash (Header_Num => Header_Num);
   --  Used in implementation of other functions Hash below

   function Hash (Name : File_Name_Type) return Header_Num is
   begin
      return Hash (Get_Name_String (Name));
   end Hash;

   function Hash (Name : Name_Id) return Header_Num is
   begin
      return Hash (Get_Name_String (Name));
   end Hash;

   function Hash (Name : Path_Name_Type) return Header_Num is
   begin
      return Hash (Get_Name_String (Name));
   end Hash;

   function Hash (Project : Project_Id) return Header_Num is
   begin
      return Header_Num (Project mod Max_Header_Num);
   end Hash;

   -----------
   -- Image --
   -----------

   function Image (Casing : Casing_Type) return String is
   begin
      return The_Casing_Images (Casing).all;
   end Image;

   ----------------------
   -- In_Configuration --
   ----------------------

   function In_Configuration return Boolean is
   begin
      return Configuration_Mode;
   end In_Configuration;

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

   procedure Initialize (Tree : Project_Tree_Ref) is
   begin
      if not Initialized then
         Initialized := True;
         Uintp.Initialize;
         Name_Len := 0;
         The_Empty_String := Name_Find;
         Empty_Name := The_Empty_String;
         Empty_File_Name := File_Name_Type (The_Empty_String);
         Name_Len := 4;
         Name_Buffer (1 .. 4) := ".ads";
         Default_Ada_Spec_Suffix_Id := Name_Find;
         Name_Len := 4;
         Name_Buffer (1 .. 4) := ".adb";
         Default_Ada_Body_Suffix_Id := Name_Find;
         Name_Len := 1;
         Name_Buffer (1) := '/';
         Slash_Id := Name_Find;

         Prj.Env.Initialize;
         Prj.Attr.Initialize;
         Set_Name_Table_Byte (Name_Project,  Token_Type'Pos (Tok_Project));
         Set_Name_Table_Byte (Name_Extends,  Token_Type'Pos (Tok_Extends));
         Set_Name_Table_Byte (Name_External, Token_Type'Pos (Tok_External));
      end if;

      if Tree /= No_Project_Tree then
         Reset (Tree);
      end if;
   end Initialize;

   -------------------
   -- Is_A_Language --
   -------------------

   function Is_A_Language
     (Tree          : Project_Tree_Ref;
      Data          : Project_Data;
      Language_Name : Name_Id) return Boolean
   is
   begin
      if Get_Mode = Ada_Only then
         declare
            List : Name_List_Index := Data.Languages;
         begin
            while List /= No_Name_List loop
               if Tree.Name_Lists.Table (List).Name = Language_Name then
                  return True;
               else
                  List := Tree.Name_Lists.Table (List).Next;
               end if;
            end loop;
         end;

      else
         declare
            Lang_Ind  : Language_Index := Data.First_Language_Processing;
            Lang_Data : Language_Data;

         begin
            while Lang_Ind /= No_Language_Index loop
               Lang_Data := Tree.Languages_Data.Table (Lang_Ind);

               if Lang_Data.Name = Language_Name then
                  return True;
               end if;

               Lang_Ind := Lang_Data.Next;
            end loop;
         end;
      end if;

      return False;
   end Is_A_Language;

   ------------------
   -- Is_Extending --
   ------------------

   function Is_Extending
     (Extending : Project_Id;
      Extended  : Project_Id;
      In_Tree   : Project_Tree_Ref) return Boolean
   is
      Proj : Project_Id;

   begin
      Proj := Extending;
      while Proj /= No_Project loop
         if Proj = Extended then
            return True;
         end if;

         Proj := In_Tree.Projects.Table (Proj).Extends;
      end loop;

      return False;
   end Is_Extending;

   -----------------------
   -- Objects_Exist_For --
   -----------------------

   function Objects_Exist_For
     (Language : String;
      In_Tree  : Project_Tree_Ref) return Boolean
   is
      Language_Id : Name_Id;
      Lang        : Language_Index;

   begin
      if Current_Mode = Multi_Language then
         Name_Len := 0;
         Add_Str_To_Name_Buffer (Language);
         To_Lower (Name_Buffer (1 .. Name_Len));
         Language_Id := Name_Find;

         Lang := In_Tree.First_Language;
         while Lang /= No_Language_Index loop
            if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
               return
                 In_Tree.Languages_Data.Table
                   (Lang).Config.Object_Generated;
            end if;

            Lang := In_Tree.Languages_Data.Table (Lang).Next;
         end loop;
      end if;

      return True;
   end Objects_Exist_For;

   -----------------
   -- Object_Name --
   -----------------

   function Object_Name
     (Source_File_Name : File_Name_Type)
      return File_Name_Type
   is
   begin
      return Extend_Name (Source_File_Name, Object_Suffix);
   end Object_Name;

   ----------------------
   -- Record_Temp_File --
   ----------------------

   procedure Record_Temp_File (Path : Path_Name_Type) is
   begin
      Temp_Files.Increment_Last;
      Temp_Files.Table (Temp_Files.Last) := Path;
   end Record_Temp_File;

   ------------------------------------
   -- Register_Default_Naming_Scheme --
   ------------------------------------

   procedure Register_Default_Naming_Scheme
     (Language            : Name_Id;
      Default_Spec_Suffix : File_Name_Type;
      Default_Body_Suffix : File_Name_Type;
      In_Tree             : Project_Tree_Ref)
   is
      Lang : Name_Id;
      Suffix : Array_Element_Id;
      Found : Boolean := False;
      Element : Array_Element;

   begin
      --  Get the language name in small letters

      Get_Name_String (Language);
      Name_Buffer (1 .. Name_Len) := To_Lower (Name_Buffer (1 .. Name_Len));
      Lang := Name_Find;

      --  Look for an element of the spec suffix array indexed by the language
      --  name. If one is found, put the default value.

      Suffix := In_Tree.Private_Part.Default_Naming.Spec_Suffix;
      Found := False;
      while Suffix /= No_Array_Element and then not Found loop
         Element := In_Tree.Array_Elements.Table (Suffix);

         if Element.Index = Lang then
            Found := True;
            Element.Value.Value := Name_Id (Default_Spec_Suffix);
            In_Tree.Array_Elements.Table (Suffix) := Element;

         else
            Suffix := Element.Next;
         end if;
      end loop;

      --  If none can be found, create a new one

      if not Found then
         Element :=
           (Index     => Lang,
            Src_Index => 0,
            Index_Case_Sensitive => False,
            Value => (Project  => No_Project,
                      Kind     => Single,
                      Location => No_Location,
                      Default  => False,
                      Value    => Name_Id (Default_Spec_Suffix),
                      Index    => 0),
            Next  => In_Tree.Private_Part.Default_Naming.Spec_Suffix);
         Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
         In_Tree.Array_Elements.Table
           (Array_Element_Table.Last (In_Tree.Array_Elements)) :=
            Element;
         In_Tree.Private_Part.Default_Naming.Spec_Suffix :=
           Array_Element_Table.Last (In_Tree.Array_Elements);
      end if;

      --  Look for an element of the body suffix array indexed by the language
      --  name. If one is found, put the default value.

      Suffix := In_Tree.Private_Part.Default_Naming.Body_Suffix;
      Found := False;
      while Suffix /= No_Array_Element and then not Found loop
         Element := In_Tree.Array_Elements.Table (Suffix);

         if Element.Index = Lang then
            Found := True;
            Element.Value.Value := Name_Id (Default_Body_Suffix);
            In_Tree.Array_Elements.Table (Suffix) := Element;

         else
            Suffix := Element.Next;
         end if;
      end loop;

      --  If none can be found, create a new one

      if not Found then
         Element :=
           (Index     => Lang,
            Src_Index => 0,
            Index_Case_Sensitive => False,
            Value => (Project  => No_Project,
                      Kind     => Single,
                      Location => No_Location,
                      Default  => False,
                      Value    => Name_Id (Default_Body_Suffix),
                      Index    => 0),
            Next  => In_Tree.Private_Part.Default_Naming.Body_Suffix);
         Array_Element_Table.Increment_Last
           (In_Tree.Array_Elements);
         In_Tree.Array_Elements.Table
           (Array_Element_Table.Last (In_Tree.Array_Elements))
             := Element;
         In_Tree.Private_Part.Default_Naming.Body_Suffix :=
           Array_Element_Table.Last (In_Tree.Array_Elements);
      end if;
   end Register_Default_Naming_Scheme;

   -----------
   -- Reset --
   -----------

   procedure Reset (Tree : Project_Tree_Ref) is

      --  Def_Lang : constant Name_Node :=
      --             (Name => Name_Ada,
      --              Next => No_Name_List);
      --  Why is the above commented out ???

   begin
      Prj.Env.Initialize;

      --  Visible tables

      Language_Data_Table.Init      (Tree.Languages_Data);
      Name_List_Table.Init          (Tree.Name_Lists);
      String_Element_Table.Init     (Tree.String_Elements);
      Variable_Element_Table.Init   (Tree.Variable_Elements);
      Array_Element_Table.Init      (Tree.Array_Elements);
      Array_Table.Init              (Tree.Arrays);
      Package_Table.Init            (Tree.Packages);
      Project_List_Table.Init       (Tree.Project_Lists);
      Project_Table.Init            (Tree.Projects);
      Source_Data_Table.Init        (Tree.Sources);
      Alternate_Language_Table.Init (Tree.Alt_Langs);
      Unit_Table.Init               (Tree.Units);
      Units_Htable.Reset            (Tree.Units_HT);
      Files_Htable.Reset            (Tree.Files_HT);
      Source_Paths_Htable.Reset     (Tree.Source_Paths_HT);

      --  Private part table

      Naming_Table.Init             (Tree.Private_Part.Namings);
      Naming_Table.Increment_Last   (Tree.Private_Part.Namings);
      Tree.Private_Part.Namings.Table
        (Naming_Table.Last (Tree.Private_Part.Namings)) := Std_Naming_Data;
      Path_File_Table.Init        (Tree.Private_Part.Path_Files);
      Source_Path_Table.Init      (Tree.Private_Part.Source_Paths);
      Object_Path_Table.Init      (Tree.Private_Part.Object_Paths);
      Tree.Private_Part.Default_Naming := Std_Naming_Data;

      if Current_Mode = Ada_Only then
         Register_Default_Naming_Scheme
           (Language            => Name_Ada,
            Default_Spec_Suffix => Default_Ada_Spec_Suffix,
            Default_Body_Suffix => Default_Ada_Body_Suffix,
            In_Tree             => Tree);
         Tree.Private_Part.Default_Naming.Separate_Suffix :=
           Default_Ada_Body_Suffix;
      end if;
   end Reset;

   ------------------------
   -- Same_Naming_Scheme --
   ------------------------

   function Same_Naming_Scheme
     (Left, Right : Naming_Data) return Boolean
   is
   begin
      return Left.Dot_Replacement = Right.Dot_Replacement
        and then Left.Casing = Right.Casing
        and then Left.Separate_Suffix = Right.Separate_Suffix;
   end Same_Naming_Scheme;

   ---------------------
   -- Set_Body_Suffix --
   ---------------------

   procedure Set_Body_Suffix
     (In_Tree  : Project_Tree_Ref;
      Language : String;
      Naming   : in out Naming_Data;
      Suffix   : File_Name_Type)
   is
      Language_Id : Name_Id;
      Element     : Array_Element;

   begin
      Name_Len := 0;
      Add_Str_To_Name_Buffer (Language);
      To_Lower (Name_Buffer (1 .. Name_Len));
      Language_Id := Name_Find;

      Element :=
        (Index                => Language_Id,
         Src_Index            => 0,
         Index_Case_Sensitive => False,
         Value                =>
           (Kind     => Single,
            Project  => No_Project,
            Location => No_Location,
            Default  => False,
            Value    => Name_Id (Suffix),
            Index    => 0),
         Next                 => Naming.Body_Suffix);

      Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
      Naming.Body_Suffix :=
         Array_Element_Table.Last (In_Tree.Array_Elements);
      In_Tree.Array_Elements.Table (Naming.Body_Suffix) := Element;
   end Set_Body_Suffix;

   --------------------------
   -- Set_In_Configuration --
   --------------------------

   procedure Set_In_Configuration (Value : Boolean) is
   begin
      Configuration_Mode := Value;
   end Set_In_Configuration;

   --------------
   -- Set_Mode --
   --------------

   procedure Set_Mode (New_Mode : Mode) is
   begin
      Current_Mode := New_Mode;
      case New_Mode is
         when Ada_Only =>
            Default_Language_Is_Ada := True;
            Must_Check_Configuration := False;
         when Multi_Language =>
            Default_Language_Is_Ada := False;
            Must_Check_Configuration := True;
      end case;
   end Set_Mode;

   ---------------------
   -- Set_Spec_Suffix --
   ---------------------

   procedure Set_Spec_Suffix
     (In_Tree  : Project_Tree_Ref;
      Language : String;
      Naming   : in out Naming_Data;
      Suffix   : File_Name_Type)
   is
      Language_Id : Name_Id;
      Element     : Array_Element;

   begin
      Name_Len := 0;
      Add_Str_To_Name_Buffer (Language);
      To_Lower (Name_Buffer (1 .. Name_Len));
      Language_Id := Name_Find;

      Element :=
        (Index                => Language_Id,
         Src_Index            => 0,
         Index_Case_Sensitive => False,
         Value                =>
           (Kind     => Single,
            Project  => No_Project,
            Location => No_Location,
            Default  => False,
            Value    => Name_Id (Suffix),
            Index    => 0),
         Next                 => Naming.Spec_Suffix);

      Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
      Naming.Spec_Suffix :=
        Array_Element_Table.Last (In_Tree.Array_Elements);
      In_Tree.Array_Elements.Table (Naming.Spec_Suffix) := Element;
   end Set_Spec_Suffix;

   -----------
   -- Slash --
   -----------

   function Slash return Path_Name_Type is
   begin
      return Slash_Id;
   end Slash;

   -----------------------
   -- Spec_Suffix_Id_Of --
   -----------------------

   function Spec_Suffix_Id_Of
     (In_Tree  : Project_Tree_Ref;
      Language : String;
      Naming   : Naming_Data) return File_Name_Type
   is
      Language_Id : Name_Id;

   begin
      Name_Len := 0;
      Add_Str_To_Name_Buffer (Language);
      To_Lower (Name_Buffer (1 .. Name_Len));
      Language_Id := Name_Find;

      return
        Spec_Suffix_Id_Of
          (In_Tree     => In_Tree,
           Language_Id => Language_Id,
           Naming      => Naming);
   end Spec_Suffix_Id_Of;

   -----------------------
   -- Spec_Suffix_Id_Of --
   -----------------------

   function Spec_Suffix_Id_Of
     (In_Tree     : Project_Tree_Ref;
      Language_Id : Name_Id;
      Naming      : Naming_Data) return File_Name_Type
   is
      Element_Id : Array_Element_Id;
      Element    : Array_Element;
      Suffix     : File_Name_Type := No_File;
      Lang       : Language_Index;

   begin
      Element_Id := Naming.Spec_Suffix;
      while Element_Id /= No_Array_Element loop
         Element := In_Tree.Array_Elements.Table (Element_Id);

         if Element.Index = Language_Id then
            return File_Name_Type (Element.Value.Value);
         end if;

         Element_Id := Element.Next;
      end loop;

      if Current_Mode = Multi_Language then
         Lang := In_Tree.First_Language;
         while Lang /= No_Language_Index loop
            if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
               Suffix :=
                 In_Tree.Languages_Data.Table
                   (Lang).Config.Naming_Data.Spec_Suffix;
               exit;
            end if;

            Lang := In_Tree.Languages_Data.Table (Lang).Next;
         end loop;
      end if;

      return Suffix;
   end Spec_Suffix_Id_Of;

   --------------------
   -- Spec_Suffix_Of --
   --------------------

   function Spec_Suffix_Of
     (In_Tree  : Project_Tree_Ref;
      Language : String;
      Naming   : Naming_Data) return String
   is
      Language_Id : Name_Id;
      Element_Id  : Array_Element_Id;
      Element     : Array_Element;
      Suffix      : File_Name_Type := No_File;
      Lang        : Language_Index;

   begin
      Name_Len := 0;
      Add_Str_To_Name_Buffer (Language);
      To_Lower (Name_Buffer (1 .. Name_Len));
      Language_Id := Name_Find;

      Element_Id := Naming.Spec_Suffix;
      while Element_Id /= No_Array_Element loop
         Element := In_Tree.Array_Elements.Table (Element_Id);

         if Element.Index = Language_Id then
            return Get_Name_String (Element.Value.Value);
         end if;

         Element_Id := Element.Next;
      end loop;

      if Current_Mode = Multi_Language then
         Lang := In_Tree.First_Language;
         while Lang /= No_Language_Index loop
            if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
               Suffix :=
                 File_Name_Type
                   (In_Tree.Languages_Data.Table
                      (Lang).Config.Naming_Data.Spec_Suffix);
               exit;
            end if;

            Lang := In_Tree.Languages_Data.Table (Lang).Next;
         end loop;

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

      return "";
   end Spec_Suffix_Of;

   --------------------------
   -- Standard_Naming_Data --
   --------------------------

   function Standard_Naming_Data
     (Tree : Project_Tree_Ref := No_Project_Tree) return Naming_Data
   is
   begin
      if Tree = No_Project_Tree then
         Prj.Initialize (Tree => No_Project_Tree);
         return Std_Naming_Data;
      else
         return Tree.Private_Part.Default_Naming;
      end if;
   end Standard_Naming_Data;

   -------------------
   -- Switches_Name --
   -------------------

   function Switches_Name
     (Source_File_Name : File_Name_Type) return File_Name_Type
   is
   begin
      return Extend_Name (Source_File_Name, Switches_Dependency_Suffix);
   end Switches_Name;

   -----------
   -- Value --
   -----------

   function Value (Image : String) return Casing_Type is
   begin
      for Casing in The_Casing_Images'Range loop
         if To_Lower (Image) = To_Lower (The_Casing_Images (Casing).all) then
            return Casing;
         end if;
      end loop;

      raise Constraint_Error;
   end Value;

begin
   --  Make sure that the standard config and user project file extensions are
   --  compatible with canonical case file naming.

   Canonical_Case_File_Name (Config_Project_File_Extension);
   Canonical_Case_File_Name (Project_File_Extension);
end Prj;