Subversion Repositories openrisc_2011-10-31

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

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                             P R J . N M S C                              --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--          Copyright (C) 2000-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 GNAT.Case_Util;             use GNAT.Case_Util;

with GNAT.Directory_Operations;  use GNAT.Directory_Operations;

with GNAT.Dynamic_HTables;

with Err_Vars; use Err_Vars;

with Opt;      use Opt;

with Osint;    use Osint;

with Output;   use Output;

with Prj.Err;  use Prj.Err;

with Prj.Util; use Prj.Util;

with Sinput.P;

with Snames;   use Snames;

with Targparm; use Targparm;

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

with Ada.Directories;            use Ada.Directories;

with Ada.Strings;                use Ada.Strings;

with Ada.Strings.Fixed;          use Ada.Strings.Fixed;

with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;

package body Prj.Nmsc is

   No_Continuation_String : aliased String := "";

   Continuation_String    : aliased String := "\";

   --  Used in Check_Library for continuation error messages at the same

   --  location.

   type Name_Location is record

      Name     : File_Name_Type;  --  ??? duplicates the key

      Location : Source_Ptr;

      Source   : Source_Id := No_Source;

      Found    : Boolean := False;

   end record;

   No_Name_Location : constant Name_Location :=

     (No_File, No_Location, No_Source, False);

   package Source_Names_Htable is new GNAT.Dynamic_HTables.Simple_HTable

     (Header_Num => Header_Num,

      Element    => Name_Location,

      No_Element => No_Name_Location,

      Key        => File_Name_Type,

      Hash       => Hash,

      Equal      => "=");

   --  Information about file names found in string list attribute

   --  (Source_Files or Source_List_File).

   --  Except is set to True if source is a naming exception in the project.

   --  This is used to check that all referenced files were indeed found on the

   --  disk.

   type Unit_Exception is record

      Name : Name_Id;  --  ??? duplicates the key

      Spec : File_Name_Type;

      Impl : File_Name_Type;

   end record;

   No_Unit_Exception : constant Unit_Exception := (No_Name, No_File, No_File);

   package Unit_Exceptions_Htable is new GNAT.Dynamic_HTables.Simple_HTable

     (Header_Num => Header_Num,

      Element    => Unit_Exception,

      No_Element => No_Unit_Exception,

      Key        => Name_Id,

      Hash       => Hash,

      Equal      => "=");

   --  Record special naming schemes for Ada units (name of spec file and name

   --  of implementation file). The elements in this list come from the naming

   --  exceptions specified in the project files.

   type File_Found is record

      File     : File_Name_Type  := No_File;

      Found    : Boolean         := False;

      Location : Source_Ptr      := No_Location;

   end record;

   No_File_Found : constant File_Found := (No_File, False, No_Location);

   package Excluded_Sources_Htable is new GNAT.Dynamic_HTables.Simple_HTable

     (Header_Num => Header_Num,

      Element    => File_Found,

      No_Element => No_File_Found,

      Key        => File_Name_Type,

      Hash       => Hash,

      Equal      => "=");

   --  A hash table to store the base names of excluded files, if any

   package Object_File_Names_Htable is new GNAT.Dynamic_HTables.Simple_HTable

     (Header_Num => Header_Num,

      Element    => Source_Id,

      No_Element => No_Source,

      Key        => File_Name_Type,

      Hash       => Hash,

      Equal      => "=");

   --  A hash table to store the object file names for a project, to check that

   --  two different sources have different object file names.

   type Project_Processing_Data is record

      Project         : Project_Id;

      Source_Names    : Source_Names_Htable.Instance;

      Unit_Exceptions : Unit_Exceptions_Htable.Instance;

      Excluded        : Excluded_Sources_Htable.Instance;

      Source_List_File_Location : Source_Ptr;

      --  Location of the Source_List_File attribute, for error messages

   end record;

   --  This is similar to Tree_Processing_Data, but contains project-specific

   --  information which is only useful while processing the project, and can

   --  be discarded as soon as we have finished processing the project

   package Files_Htable is new GNAT.Dynamic_HTables.Simple_HTable

     (Header_Num => Header_Num,

      Element    => Source_Id,

      No_Element => No_Source,

      Key        => File_Name_Type,

      Hash       => Hash,

      Equal      => "=");

   --  Mapping from base file names to Source_Id (containing full info about

   --  the source).

   type Tree_Processing_Data is record

      Tree           : Project_Tree_Ref;

      File_To_Source : Files_Htable.Instance;

      Flags          : Prj.Processing_Flags;

   end record;

   --  Temporary data which is needed while parsing a project. It does not need

   --  to be kept in memory once a project has been fully loaded, but is

   --  necessary while performing consistency checks (duplicate sources,...)

   --  This data must be initialized before processing any project, and the

   --  same data is used for processing all projects in the tree.

   procedure Initialize

     (Data  : out Tree_Processing_Data;

      Tree  : Project_Tree_Ref;

      Flags : Prj.Processing_Flags);

   --  Initialize Data

   procedure Free (Data : in out Tree_Processing_Data);

   --  Free the memory occupied by Data

   procedure Check

     (Project     : Project_Id;

      Data        : in out Tree_Processing_Data);

   --  Process the naming scheme for a single project

   procedure Initialize

     (Data    : in out Project_Processing_Data;

      Project : Project_Id);

   procedure Free (Data : in out Project_Processing_Data);

   --  Initialize or free memory for a project-specific data

   procedure Find_Excluded_Sources

     (Project : in out Project_Processing_Data;

      Data    : in out Tree_Processing_Data);

   --  Find the list of files that should not be considered as source files

   --  for this project. Sets the list in the Project.Excluded_Sources_Htable.

   procedure Override_Kind (Source : Source_Id; Kind : Source_Kind);

   --  Override the reference kind for a source file. This properly updates

   --  the unit data if necessary.

   procedure Load_Naming_Exceptions

     (Project : in out Project_Processing_Data;

      Data    : in out Tree_Processing_Data);

   --  All source files in Data.First_Source are considered as naming

   --  exceptions, and copied into the Source_Names and Unit_Exceptions tables

   --  as appropriate.

   procedure Add_Source

     (Id                  : out Source_Id;

      Data                : in out Tree_Processing_Data;

      Project             : Project_Id;

      Source_Dir_Rank     : Natural;

      Lang_Id             : Language_Ptr;

      Kind                : Source_Kind;

      File_Name           : File_Name_Type;

      Display_File        : File_Name_Type;

      Naming_Exception    : Boolean          := False;

      Path                : Path_Information := No_Path_Information;

      Alternate_Languages : Language_List    := null;

      Unit                : Name_Id          := No_Name;

      Index               : Int              := 0;

      Locally_Removed     : Boolean          := False;

      Location            : Source_Ptr       := No_Location);

   --  Add a new source to the different lists: list of all sources in the

   --  project tree, list of source of a project and list of sources of a

   --  language.

   --

   --  If Path is specified, the file is also added to Source_Paths_HT.

   --

   --  Location is used for error messages

   function Canonical_Case_File_Name (Name : Name_Id) return File_Name_Type;

   --  Same as Osint.Canonical_Case_File_Name but applies to Name_Id.

   --  This alters Name_Buffer

   function Suffix_Matches

     (Filename : String;

      Suffix   : File_Name_Type) return Boolean;

   --  True if the file name ends with the given suffix. Always returns False

   --  if Suffix is No_Name.

   procedure Replace_Into_Name_Buffer

     (Str         : String;

      Pattern     : String;

      Replacement : Character);

   --  Copy Str into Name_Buffer, replacing Pattern with Replacement. Str is

   --  converted to lower-case at the same time.

   procedure Check_Ada_Name (Name : String; Unit : out Name_Id);

   --  Check that a name is a valid Ada unit name

   procedure Check_Package_Naming

     (Project : Project_Id;

      Data    : in out Tree_Processing_Data;

      Bodies  : out Array_Element_Id;

      Specs   : out Array_Element_Id);

   --  Check the naming scheme part of Data, and initialize the naming scheme

   --  data in the config of the various languages. This also returns the

   --  naming scheme exceptions for unit-based languages (Bodies and Specs are

   --  associative arrays mapping individual unit names to source file names).

   procedure Check_Configuration

     (Project : Project_Id;

      Data    : in out Tree_Processing_Data);

   --  Check the configuration attributes for the project

   procedure Check_If_Externally_Built

     (Project : Project_Id;

      Data    : in out Tree_Processing_Data);

   --  Check attribute Externally_Built of project Project in project tree

   --  Data.Tree and modify its data Data if it has the value "true".

   procedure Check_Interfaces

     (Project : Project_Id;

      Data    : in out Tree_Processing_Data);

   --  If a list of sources is specified in attribute Interfaces, set

   --  In_Interfaces only for the sources specified in the list.

   procedure Check_Library_Attributes

     (Project : Project_Id;

      Data    : in out Tree_Processing_Data);

   --  Check the library attributes of project Project in project tree

   --  and modify its data Data accordingly.

   procedure Check_Programming_Languages

     (Project : Project_Id;

      Data    : in out Tree_Processing_Data);

   --  Check attribute Languages for the project with data Data in project

   --  tree Data.Tree and set the components of Data for all the programming

   --  languages indicated in attribute Languages, if any.

   procedure Check_Stand_Alone_Library

     (Project : Project_Id;

      Data    : in out Tree_Processing_Data);

   --  Check if project Project in project tree Data.Tree is a Stand-Alone

   --  Library project, and modify its data Data accordingly if it is one.

   function Compute_Directory_Last (Dir : String) return Natural;

   --  Return the index of the last significant character in Dir. This is used

   --  to avoid duplicate '/' (slash) characters at the end of directory names.

   procedure Search_Directories

     (Project         : in out Project_Processing_Data;

      Data            : in out Tree_Processing_Data;

      For_All_Sources : Boolean);

   --  Search the source directories to find the sources. If For_All_Sources is

   --  True, check each regular file name against the naming schemes of the

   --  various languages. Otherwise consider only the file names in hash table

   --  Source_Names. If Allow_Duplicate_Basenames then files with identical

   --  base names are permitted within a project for source-based languages

   --  (never for unit based languages).

   procedure Check_File

     (Project           : in out Project_Processing_Data;

      Data              : in out Tree_Processing_Data;

      Source_Dir_Rank   : Natural;

      Path              : Path_Name_Type;

      File_Name         : File_Name_Type;

      Display_File_Name : File_Name_Type;

      Locally_Removed   : Boolean;

      For_All_Sources   : Boolean);

   --  Check if file File_Name is a valid source of the project. This is used

   --  in multi-language mode only. When the file matches one of the naming

   --  schemes, it is added to various htables through Add_Source and to

   --  Source_Paths_Htable.

   --

   --  Name is the name of the candidate file. It hasn't been normalized yet

   --  and is the direct result of readdir().

   --

   --  File_Name is the same as Name, but has been normalized.

   --  Display_File_Name, however, has not been normalized.

   --

   --  Source_Directory is the directory in which the file was found. It is

   --  neither normalized nor has had links resolved, and must not end with a

   --  a directory separator, to avoid duplicates later on.

   --

   --  If For_All_Sources is True, then all possible file names are analyzed

   --  otherwise only those currently set in the Source_Names hash table.

   procedure Check_File_Naming_Schemes

     (In_Tree               : Project_Tree_Ref;

      Project               : Project_Processing_Data;

      File_Name             : File_Name_Type;

      Alternate_Languages   : out Language_List;

      Language              : out Language_Ptr;

      Display_Language_Name : out Name_Id;

      Unit                  : out Name_Id;

      Lang_Kind             : out Language_Kind;

      Kind                  : out Source_Kind);

   --  Check if the file name File_Name conforms to one of the naming schemes

   --  of the project. If the file does not match one of the naming schemes,

   --  set Language to No_Language_Index. Filename is the name of the file

   --  being investigated. It has been normalized (case-folded). File_Name is

   --  the same value.

   procedure Get_Directories

     (Project     : Project_Id;

      Data        : in out Tree_Processing_Data);

   --  Get the object directory, the exec directory and the source directories

   --  of a project.

   procedure Get_Mains

     (Project : Project_Id;

      Data    : in out Tree_Processing_Data);

   --  Get the mains of a project from attribute Main, if it exists, and put

   --  them in the project data.

   procedure Get_Sources_From_File

     (Path     : String;

      Location : Source_Ptr;

      Project  : in out Project_Processing_Data;

      Data     : in out Tree_Processing_Data);

   --  Get the list of sources from a text file and put them in hash table

   --  Source_Names.

   procedure Find_Sources

     (Project : in out Project_Processing_Data;

      Data    : in out Tree_Processing_Data);

   --  Process the Source_Files and Source_List_File attributes, and store the

   --  list of source files into the Source_Names htable. When these attributes

   --  are not defined, find all files matching the naming schemes in the

   --  source directories. If Allow_Duplicate_Basenames, then files with the

   --  same base names are authorized within a project for source-based

   --  languages (never for unit based languages)

   procedure Compute_Unit_Name

     (File_Name : File_Name_Type;

      Naming    : Lang_Naming_Data;

      Kind      : out Source_Kind;

      Unit      : out Name_Id;

      Project   : Project_Processing_Data;

      In_Tree   : Project_Tree_Ref);

   --  Check whether the file matches the naming scheme. If it does,

   --  compute its unit name. If Unit is set to No_Name on exit, none of the

   --  other out parameters are relevant.

   procedure Check_Illegal_Suffix

     (Project         : Project_Id;

      Suffix          : File_Name_Type;

      Dot_Replacement : File_Name_Type;

      Attribute_Name  : String;

      Location        : Source_Ptr;

      Data            : in out Tree_Processing_Data);

   --  Display an error message if the given suffix is illegal for some reason.

   --  The name of the attribute we are testing is specified in Attribute_Name,

   --  which is used in the error message. Location is the location where the

   --  suffix is defined.

   procedure Locate_Directory

     (Project          : Project_Id;

      Name             : File_Name_Type;

      Path             : out Path_Information;

      Dir_Exists       : out Boolean;

      Data             : in out Tree_Processing_Data;

      Create           : String := "";

      Location         : Source_Ptr := No_Location;

      Must_Exist       : Boolean := True;

      Externally_Built : Boolean := False);

   --  Locate a directory. Name is the directory name. Relative paths are

   --  resolved relative to the project's directory. If the directory does not

   --  exist and Setup_Projects is True and Create is a non null string, an

   --  attempt is made to create the directory. If the directory does not

   --  exist, it is either created if Setup_Projects is False (and then

   --  returned), or simply returned without checking for its existence (if

   --  Must_Exist is False) or No_Path_Information is returned. In all cases,

   --  Dir_Exists indicates whether the directory now exists. Create is also

   --  used for debugging traces to show which path we are computing.

   procedure Look_For_Sources

     (Project : in out Project_Processing_Data;

      Data    : in out Tree_Processing_Data);

   --  Find all the sources of project Project in project tree Data.Tree and

   --  update its Data accordingly. This assumes that Data.First_Source has

   --  been initialized with the list of excluded sources and special naming

   --  exceptions.

   function Path_Name_Of

     (File_Name : File_Name_Type;

      Directory : Path_Name_Type) return String;

   --  Returns the path name of a (non project) file. Returns an empty string

   --  if file cannot be found.

   procedure Remove_Source

     (Id          : Source_Id;

      Replaced_By : Source_Id);

   --  Remove a file from the list of sources of a project. This might be

   --  because the file is replaced by another one in an extending project,

   --  or because a file was added as a naming exception but was not found

   --  in the end.

   procedure Report_No_Sources

     (Project      : Project_Id;

      Lang_Name    : String;

      Data         : Tree_Processing_Data;

      Location     : Source_Ptr;

      Continuation : Boolean := False);

   --  Report an error or a warning depending on the value of When_No_Sources

   --  when there are no sources for language Lang_Name.

   procedure Show_Source_Dirs

     (Project : Project_Id; In_Tree : Project_Tree_Ref);

   --  List all the source directories of a project

   procedure Write_Attr (Name, Value : String);

   --  Debug print a value for a specific property. Does nothing when not in

   --  debug mode

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

   -- Replace_Into_Name_Buffer --

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

   procedure Replace_Into_Name_Buffer

     (Str         : String;

      Pattern     : String;

      Replacement : Character)

   is

      Max : constant Integer := Str'Last - Pattern'Length + 1;

      J   : Positive;

   begin

      Name_Len := 0;

      J := Str'First;

      while J <= Str'Last loop

         Name_Len := Name_Len + 1;

         if J <= Max

           and then Str (J .. J + Pattern'Length - 1) = Pattern

         then

            Name_Buffer (Name_Len) := Replacement;

            J := J + Pattern'Length;

         else

            Name_Buffer (Name_Len) := GNAT.Case_Util.To_Lower (Str (J));

            J := J + 1;

         end if;

      end loop;

   end Replace_Into_Name_Buffer;

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

   -- Suffix_Matches --

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

   function Suffix_Matches

     (Filename : String;

      Suffix   : File_Name_Type) return Boolean

   is

      Min_Prefix_Length : Natural := 0;

   begin

      if Suffix = No_File or else Suffix = Empty_File then

         return False;

      end if;

      declare

         Suf : String := Get_Name_String (Suffix);

      begin

         --  On non case-sensitive systems, use proper suffix casing

         Canonical_Case_File_Name (Suf);

         --  The file name must end with the suffix (which is not an extension)

         --  For instance a suffix "configure.in" must match a file with the

         --  same name. To avoid dummy cases, though, a suffix starting with

         --  '.' requires a file that is at least one character longer ('.cpp'

         --  should not match a file with the same name)

         if Suf (Suf'First) = '.' then

            Min_Prefix_Length := 1;

         end if;

         return Filename'Length >= Suf'Length + Min_Prefix_Length

           and then Filename

             (Filename'Last - Suf'Length + 1 .. Filename'Last) = Suf;

      end;

   end Suffix_Matches;

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

   -- Write_Attr --

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

   procedure Write_Attr (Name, Value : String) is

   begin

      if Current_Verbosity = High then

         Write_Str  ("  " & Name & " = """);

         Write_Str  (Value);

         Write_Char ('"');

         Write_Eol;

      end if;

   end Write_Attr;

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

   -- Add_Source --

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

   procedure Add_Source

     (Id                  : out Source_Id;

      Data                : in out Tree_Processing_Data;

      Project             : Project_Id;

      Source_Dir_Rank     : Natural;

      Lang_Id             : Language_Ptr;

      Kind                : Source_Kind;

      File_Name           : File_Name_Type;

      Display_File        : File_Name_Type;

      Naming_Exception    : Boolean          := False;

      Path                : Path_Information := No_Path_Information;

      Alternate_Languages : Language_List    := null;

      Unit                : Name_Id          := No_Name;

      Index               : Int              := 0;

      Locally_Removed     : Boolean          := False;

      Location            : Source_Ptr       := No_Location)

   is

      Config    : constant Language_Config := Lang_Id.Config;

      UData     : Unit_Index;

      Add_Src   : Boolean;

      Source    : Source_Id;

      Prev_Unit : Unit_Index := No_Unit_Index;

      Source_To_Replace : Source_Id := No_Source;

   begin

      --  Check if the same file name or unit is used in the prj tree

      Add_Src := True;

      if Unit /= No_Name then

         Prev_Unit := Units_Htable.Get (Data.Tree.Units_HT, Unit);

      end if;

      if Prev_Unit /= No_Unit_Index

        and then (Kind = Impl or else Kind = Spec)

        and then Prev_Unit.File_Names (Kind) /= null

      then

         --  Suspicious, we need to check later whether this is authorized

         Add_Src := False;

         Source := Prev_Unit.File_Names (Kind);

      else

         Source  := Files_Htable.Get (Data.File_To_Source, File_Name);

         if Source /= No_Source

           and then Source.Index = Index

         then

            Add_Src := False;

         end if;

      end if;

      --  Duplication of file/unit in same project is allowed if order of

      --  source directories is known.

      if Add_Src = False then

         Add_Src := True;

         if Project = Source.Project then

            if Prev_Unit = No_Unit_Index then

               if Data.Flags.Allow_Duplicate_Basenames then

                  Add_Src := True;

               elsif Source_Dir_Rank /= Source.Source_Dir_Rank then

                  Add_Src := False;

               else

                  Error_Msg_File_1 := File_Name;

                  Error_Msg

                    (Data.Flags, "duplicate source file name {",

                     Location, Project);

                  Add_Src := False;

               end if;

            else

               if Source_Dir_Rank /= Source.Source_Dir_Rank then

                  Add_Src := False;

               --  We might be seeing the same file through a different path

               --  (for instance because of symbolic links).

               elsif Source.Path.Name /= Path.Name then

                  Error_Msg_Name_1 := Unit;

                  Error_Msg

                    (Data.Flags, "duplicate unit %%", Location, Project);

                  Add_Src := False;

               end if;

            end if;

            --  Do not allow the same unit name in different projects, except

            --  if one is extending the other.

            --  For a file based language, the same file name replaces a file

            --  in a project being extended, but it is allowed to have the same

            --  file name in unrelated projects.

         elsif Is_Extending (Project, Source.Project) then

            if not Locally_Removed then

               Source_To_Replace := Source;

            end if;

         elsif Prev_Unit /= No_Unit_Index

           and then not Source.Locally_Removed

         then

            --  Path is set if this is a source we found on the disk, in which

            --  case we can provide more explicit error message. Path is unset

            --  when the source is added from one of the naming exceptions in

            --  the project.

            if Path /= No_Path_Information then

               Error_Msg_Name_1 := Unit;

               Error_Msg

                 (Data.Flags,

                  "unit %% cannot belong to several projects",

                  Location, Project);

               Error_Msg_Name_1 := Project.Name;

               Error_Msg_Name_2 := Name_Id (Path.Display_Name);

               Error_Msg

                 (Data.Flags, "\  project %%, %%", Location, Project);

               Error_Msg_Name_1 := Source.Project.Name;

               Error_Msg_Name_2 := Name_Id (Source.Path.Display_Name);

               Error_Msg

                 (Data.Flags, "\  project %%, %%", Location, Project);

            else

               Error_Msg_Name_1 := Unit;

               Error_Msg_Name_2 := Source.Project.Name;

               Error_Msg

                 (Data.Flags, "unit %% already belongs to project %%",

                  Location, Project);

            end if;

            Add_Src := False;

         elsif not Source.Locally_Removed

           and then not Data.Flags.Allow_Duplicate_Basenames

           and then Lang_Id.Config.Kind = Unit_Based

         then

            Error_Msg_File_1 := File_Name;

            Error_Msg_File_2 := File_Name_Type (Source.Project.Name);

            Error_Msg

              (Data.Flags,

               "{ is already a source of project {", Location, Project);

            --  Add the file anyway, to avoid further warnings like "language

            --  unknown".

            Add_Src := True;

         end if;

      end if;

      if not Add_Src then

         return;

      end if;

      --  Add the new file

      Id := new Source_Data;

      if Current_Verbosity = High then

         Write_Str ("Adding source File: ");

         Write_Str (Get_Name_String (File_Name));

         if Index /= 0 then

            Write_Str (" at" & Index'Img);

         end if;

         if Lang_Id.Config.Kind = Unit_Based then

            Write_Str (" Unit: ");

            --  ??? in gprclean, it seems we sometimes pass an empty Unit name

            --  (see test extended_projects).

            if Unit /= No_Name then

               Write_Str (Get_Name_String (Unit));

            end if;

            Write_Str (" Kind: ");

            Write_Str (Source_Kind'Image (Kind));

         end if;

         Write_Eol;

      end if;

      Id.Project             := Project;

      Id.Source_Dir_Rank     := Source_Dir_Rank;

      Id.Language            := Lang_Id;

      Id.Kind                := Kind;

      Id.Alternate_Languages := Alternate_Languages;

      Id.Locally_Removed     := Locally_Removed;

      Id.Index               := Index;

      Id.File                := File_Name;

      Id.Display_File        := Display_File;

      Id.Dep_Name            := Dependency_Name

                                  (File_Name, Lang_Id.Config.Dependency_Kind);

      Id.Naming_Exception    := Naming_Exception;

      --  Add the source id to the Unit_Sources_HT hash table, if the unit name

      --  is not null.

      if Unit /= No_Name then

         --  Note: we might be creating a dummy unit here, when we in fact have

         --  a separate. For instance, file file-bar.adb will initially be

         --  assumed to be the IMPL of unit "file.bar". Only later on (in

         --  Check_Object_Files) will we parse those units that only have an

         --  impl and no spec to make sure whether we have a Separate in fact

         --  (that significantly reduces the number of times we need to parse

         --  the files, since we are then only interested in those with no

         --  spec). We still need those dummy units in the table, since that's

         --  the name we find in the ALI file

         UData := Units_Htable.Get (Data.Tree.Units_HT, Unit);

         if UData = No_Unit_Index then

            UData := new Unit_Data;

            UData.Name := Unit;

            Units_Htable.Set (Data.Tree.Units_HT, Unit, UData);

         end if;

         Id.Unit := UData;

         --  Note that this updates Unit information as well

         Override_Kind (Id, Kind);

      end if;

      if Is_Compilable (Id) and then Config.Object_Generated then

         Id.Object   := Object_Name (File_Name, Config.Object_File_Suffix);

         Id.Switches := Switches_Name (File_Name);

      end if;

      if Path /= No_Path_Information then

         Id.Path := Path;

         Source_Paths_Htable.Set (Data.Tree.Source_Paths_HT, Path.Name, Id);

      end if;

      if Index /= 0 then

         Project.Has_Multi_Unit_Sources := True;

      end if;

      --  Add the source to the language list

      Id.Next_In_Lang := Lang_Id.First_Source;

      Lang_Id.First_Source := Id;

      if Source_To_Replace /= No_Source then

         Remove_Source (Source_To_Replace, Id);

      end if;

      Files_Htable.Set (Data.File_To_Source, File_Name, Id);

   end Add_Source;

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

   -- Canonical_Case_File_Name --

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

   function Canonical_Case_File_Name (Name : Name_Id) return File_Name_Type is

   begin

      if Osint.File_Names_Case_Sensitive then

         return File_Name_Type (Name);

      else

         Get_Name_String (Name);

         Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));

         return Name_Find;

      end if;

   end Canonical_Case_File_Name;

   -----------

   -- Check --

   -----------

   procedure Check

     (Project     : Project_Id;

      Data        : in out Tree_Processing_Data)

   is

      Specs     : Array_Element_Id;

      Bodies    : Array_Element_Id;

      Extending : Boolean := False;

      Prj_Data  : Project_Processing_Data;

   begin

      Initialize (Prj_Data, Project);

      Check_If_Externally_Built (Project, Data);

      --  Object, exec and source directories

      Get_Directories (Project, Data);

      --  Get the programming languages

      Check_Programming_Languages (Project, Data);

      if Project.Qualifier = Dry

        and then Project.Source_Dirs /= Nil_String

      then

         declare

            Source_Dirs      : constant Variable_Value :=

                                 Util.Value_Of

                                   (Name_Source_Dirs,

                                    Project.Decl.Attributes, Data.Tree);

            Source_Files     : constant Variable_Value :=

                                 Util.Value_Of

                                   (Name_Source_Files,

                                    Project.Decl.Attributes, Data.Tree);

            Source_List_File : constant Variable_Value :=

                                 Util.Value_Of

                                   (Name_Source_List_File,

                                    Project.Decl.Attributes, Data.Tree);

            Languages        : constant Variable_Value :=

                                 Util.Value_Of

                                   (Name_Languages,

                                    Project.Decl.Attributes, Data.Tree);

         begin

            if Source_Dirs.Values  = Nil_String

              and then Source_Files.Values = Nil_String

              and then Languages.Values = Nil_String

              and then Source_List_File.Default