Subversion Repositories openrisc

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

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

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

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--          Copyright (C) 2000-2012, 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 Err_Vars; use Err_Vars;

with Opt;      use Opt;

with Osint;    use Osint;

with Output;   use Output;

with Prj.Com;

with Prj.Env;  use Prj.Env;

with Prj.Err;  use Prj.Err;

with Prj.Tree; use Prj.Tree;

with Prj.Util; use Prj.Util;

with Sinput.P;

with Snames;   use Snames;

with Targparm; use Targparm;

with Ada;                        use Ada;

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;

with GNAT.Case_Util;            use GNAT.Case_Util;

with GNAT.Directory_Operations; use GNAT.Directory_Operations;

with GNAT.Dynamic_HTables;

with GNAT.Regexp;               use GNAT.Regexp;

with GNAT.Table;

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;

      --  Key is duplicated, so that it is known when using functions Get_First

      --  and Get_Next, as these functions only return an Element.

      Location : Source_Ptr;

      Source   : Source_Id := No_Source;

      Listed   : Boolean := False;

      Found    : Boolean := False;

   end record;

   No_Name_Location : constant Name_Location :=

                        (Name     => No_File,

                         Location => No_Location,

                         Source   => No_Source,

                         Listed   => False,

                         Found    => 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      => "=");

   --  File name information found in string list attribute (Source_Files or

   --  Source_List_File). Used to check that all referenced files were indeed

   --  found on the disk.

   type Unit_Exception is record

      Name : Name_Id;

      --  Key is duplicated, so that it is known when using functions Get_First

      --  and Get_Next, as these functions only return an Element.

      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;

      Excl_File : File_Name_Type := No_File;

      Excl_Line : Natural        := 0;

      Found     : Boolean        := False;

      Location  : Source_Ptr     := No_Location;

   end record;

   No_File_Found : constant File_Found :=

                     (No_File, No_File, 0, 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

   type Tree_Processing_Data is record

      Tree             : Project_Tree_Ref;

      Node_Tree        : Prj.Tree.Project_Node_Tree_Ref;

      Flags            : Prj.Processing_Flags;

      In_Aggregate_Lib : Boolean;

   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.

   type Lib_Data is record

      Name : Name_Id;

      Proj : Project_Id;

   end record;

   package Lib_Data_Table is new GNAT.Table

     (Table_Component_Type => Lib_Data,

      Table_Index_Type     => Natural,

      Table_Low_Bound      => 1,

      Table_Initial        => 10,

      Table_Increment      => 100);

   --  A table to record library names in order to check that two library

   --  projects do not have the same library names.

   procedure Initialize

     (Data      : out Tree_Processing_Data;

      Tree      : Project_Tree_Ref;

      Node_Tree : Prj.Tree.Project_Node_Tree_Ref;

      Flags     : Prj.Processing_Flags);

   --  Initialize Data

   procedure Free (Data : in out Tree_Processing_Data);

   --  Free the memory occupied by Data

   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.

   type Search_Type is (Search_Files, Search_Directories);

   generic

      with procedure Callback

        (Path          : Path_Information;

         Pattern_Index : Natural);

   procedure Expand_Subdirectory_Pattern

     (Project       : Project_Id;

      Data          : in out Tree_Processing_Data;

      Patterns      : String_List_Id;

      Ignore        : String_List_Id;

      Search_For    : Search_Type;

      Resolve_Links : Boolean);

   --  Search the subdirectories of Project's directory for files or

   --  directories that match the globbing patterns found in Patterns (for

   --  instance "**/*.adb"). Typically, Patterns will be the value of the

   --  Source_Dirs or Excluded_Source_Dirs attributes.

   --

   --  Every time such a file or directory is found, the callback is called.

   --  Resolve_Links indicates whether we should resolve links while

   --  normalizing names.

   --

   --  In the callback, Pattern_Index is the index within Patterns where the

   --  expanded pattern was found (1 for the first element of Patterns and

   --  all its matching directories, then 2,...).

   --

   --  We use a generic and not an access-to-subprogram because in some cases

   --  this code is compiled with the restriction No_Implicit_Dynamic_Code.

   --  An error message is raised if a pattern does not match any file.

   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    : Naming_Exception_Type := No;

      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_Abstract_Project

     (Project : Project_Id;

      Data    : in out Tree_Processing_Data);

   --  Check abstract projects attributes

   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_Package_Naming

     (Project : Project_Id;

      Data    : in out Tree_Processing_Data);

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

   --  data in the config of the various languages.

   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.

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

   --  Check that a name is a valid unit name

   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;

      Display_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.

   --

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

   --  They do not include the directory information.

   --

   --  Path and Display_Path on the other hand are the full path to the file.

   --  Path must have been normalized (canonical casing and possibly links

   --  resolved).

   --

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

     (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);

   --  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 the special naming

   --  exceptions have already been processed.

   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

     (Tree        : Project_Tree_Ref;

      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;

      Shared  : Shared_Project_Tree_Data_Access);

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

   procedure Error_Or_Warning

     (Flags    : Processing_Flags;

      Kind     : Error_Warning;

      Msg      : String;

      Location : Source_Ptr;

      Project  : Project_Id);

   --  Emits either an error or warning message (or nothing), depending on Kind

   function No_Space_Img (N : Natural) return String;

   --  Image of a Natural without the initial space

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

   -- Error_Or_Warning --

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

   procedure Error_Or_Warning

     (Flags    : Processing_Flags;

      Kind     : Error_Warning;

      Msg      : String;

      Location : Source_Ptr;

      Project  : Project_Id) is

   begin

      case Kind is

         when Error   => Error_Msg (Flags, Msg, Location, Project);

         when Warning => Error_Msg (Flags, "?" & Msg, Location, Project);

         when Silent  => null;

      end case;

   end Error_Or_Warning;

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

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

         Debug_Output (Name & " = """ & Value & '"');

      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    : Naming_Exception_Type := No;

      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 := Source_Files_Htable.Get

           (Data.Tree.Source_Files_HT, 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, or if there is no compiler for the

      --  language.

      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 Lang_Id.Config.Compiler_Driver = Empty_File 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

                  if not Source.Duplicate_Unit then

                     Error_Msg_Name_1 := Unit;

                     Error_Msg

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

                     Source.Duplicate_Unit := True;

                  end if;

                  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 and then Naming_Exception /= Inherited then

               Source_To_Replace := Source;

            end if;

         elsif Prev_Unit /= No_Unit_Index

           and then Prev_Unit.File_Names (Kind) /= null

           and then not Source.Locally_Removed

           and then not Data.In_Aggregate_Lib

         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

           and then Source.Language.Config.Kind = Unit_Based

           and then not Data.In_Aggregate_Lib

         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

         Debug_Indent;

         Write_Str ("adding source File: ");

         Write_Str (Get_Name_String (Display_File));

         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.Location            := Location;

      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;

      Id.Object              := Object_Name

                                  (File_Name, Config.Object_File_Suffix);

      Id.Switches            := Switches_Name (File_Name);

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

            if Naming_Exception /= Inherited then

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

            end if;

         end if;

         Id.Unit := UData;

         --  Note that this updates Unit information as well

         if Naming_Exception /= Inherited then

            Override_Kind (Id, Kind);

         end if;

      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;

      Id.Next_With_File_Name :=

        Source_Files_Htable.Get (Data.Tree.Source_Files_HT, File_Name);

      Source_Files_Htable.Set (Data.Tree.Source_Files_HT, File_Name, Id);

      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 (Data.Tree, Source_To_Replace, Id);

      end if;

      if Data.Tree.Replaced_Source_Number > 0

        and then

          Replaced_Source_HTable.Get

            (Data.Tree.Replaced_Sources, Id.File) /= No_File

      then

         Replaced_Source_HTable.Remove (Data.Tree.Replaced_Sources, Id.File);

         Data.Tree.Replaced_Source_Number :=

           Data.Tree.Replaced_Source_Number - 1;

      end if;

   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;

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

   -- Process_Aggregated_Projects --

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

   procedure Process_Aggregated_Projects

     (Tree      : Project_Tree_Ref;

      Project   : Project_Id;

      Node_Tree : Prj.Tree.Project_Node_Tree_Ref;