File : prj-nmsc.adb


   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             P R J . N M S C                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2000-2016, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25 
  26 with Err_Vars; use Err_Vars;
  27 with Opt;      use Opt;
  28 with Osint;    use Osint;
  29 with Output;   use Output;
  30 with Prj.Com;
  31 with Prj.Env;  use Prj.Env;
  32 with Prj.Err;  use Prj.Err;
  33 with Prj.Tree; use Prj.Tree;
  34 with Prj.Util; use Prj.Util;
  35 with Sinput.P;
  36 with Snames;   use Snames;
  37 
  38 with Ada;                        use Ada;
  39 with Ada.Characters.Handling;    use Ada.Characters.Handling;
  40 with Ada.Directories;            use Ada.Directories;
  41 with Ada.Strings;                use Ada.Strings;
  42 with Ada.Strings.Fixed;          use Ada.Strings.Fixed;
  43 with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
  44 
  45 with GNAT.Case_Util;            use GNAT.Case_Util;
  46 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
  47 with GNAT.Dynamic_HTables;
  48 with GNAT.Regexp;               use GNAT.Regexp;
  49 with GNAT.Table;
  50 
  51 package body Prj.Nmsc is
  52 
  53    No_Continuation_String : aliased String := "";
  54    Continuation_String    : aliased String := "\";
  55    --  Used in Check_Library for continuation error messages at the same
  56    --  location.
  57 
  58    type Name_Location is record
  59       Name     : File_Name_Type;
  60       --  Key is duplicated, so that it is known when using functions Get_First
  61       --  and Get_Next, as these functions only return an Element.
  62 
  63       Location : Source_Ptr;
  64       Source   : Source_Id := No_Source;
  65       Listed   : Boolean := False;
  66       Found    : Boolean := False;
  67    end record;
  68 
  69    No_Name_Location : constant Name_Location :=
  70                         (Name     => No_File,
  71                          Location => No_Location,
  72                          Source   => No_Source,
  73                          Listed   => False,
  74                          Found    => False);
  75 
  76    package Source_Names_Htable is new GNAT.Dynamic_HTables.Simple_HTable
  77      (Header_Num => Header_Num,
  78       Element    => Name_Location,
  79       No_Element => No_Name_Location,
  80       Key        => File_Name_Type,
  81       Hash       => Hash,
  82       Equal      => "=");
  83    --  File name information found in string list attribute (Source_Files or
  84    --  Source_List_File). Used to check that all referenced files were indeed
  85    --  found on the disk.
  86 
  87    type Unit_Exception is record
  88       Name : Name_Id;
  89       --  Key is duplicated, so that it is known when using functions Get_First
  90       --  and Get_Next, as these functions only return an Element.
  91 
  92       Spec : File_Name_Type;
  93       Impl : File_Name_Type;
  94    end record;
  95 
  96    No_Unit_Exception : constant Unit_Exception := (No_Name, No_File, No_File);
  97 
  98    package Unit_Exceptions_Htable is new GNAT.Dynamic_HTables.Simple_HTable
  99      (Header_Num => Header_Num,
 100       Element    => Unit_Exception,
 101       No_Element => No_Unit_Exception,
 102       Key        => Name_Id,
 103       Hash       => Hash,
 104       Equal      => "=");
 105    --  Record special naming schemes for Ada units (name of spec file and name
 106    --  of implementation file). The elements in this list come from the naming
 107    --  exceptions specified in the project files.
 108 
 109    type File_Found is record
 110       File      : File_Name_Type := No_File;
 111       Excl_File : File_Name_Type := No_File;
 112       Excl_Line : Natural        := 0;
 113       Found     : Boolean        := False;
 114       Location  : Source_Ptr     := No_Location;
 115    end record;
 116 
 117    No_File_Found : constant File_Found :=
 118                      (No_File, No_File, 0, False, No_Location);
 119 
 120    package Excluded_Sources_Htable is new GNAT.Dynamic_HTables.Simple_HTable
 121      (Header_Num => Header_Num,
 122       Element    => File_Found,
 123       No_Element => No_File_Found,
 124       Key        => File_Name_Type,
 125       Hash       => Hash,
 126       Equal      => "=");
 127    --  A hash table to store the base names of excluded files, if any
 128 
 129    package Object_File_Names_Htable is new GNAT.Dynamic_HTables.Simple_HTable
 130      (Header_Num => Header_Num,
 131       Element    => Source_Id,
 132       No_Element => No_Source,
 133       Key        => File_Name_Type,
 134       Hash       => Hash,
 135       Equal      => "=");
 136    --  A hash table to store the object file names for a project, to check that
 137    --  two different sources have different object file names.
 138 
 139    type Project_Processing_Data is record
 140       Project         : Project_Id;
 141       Source_Names    : Source_Names_Htable.Instance;
 142       Unit_Exceptions : Unit_Exceptions_Htable.Instance;
 143       Excluded        : Excluded_Sources_Htable.Instance;
 144 
 145       Source_List_File_Location : Source_Ptr;
 146       --  Location of the Source_List_File attribute, for error messages
 147    end record;
 148    --  This is similar to Tree_Processing_Data, but contains project-specific
 149    --  information which is only useful while processing the project, and can
 150    --  be discarded as soon as we have finished processing the project
 151 
 152    type Tree_Processing_Data is record
 153       Tree             : Project_Tree_Ref;
 154       Node_Tree        : Prj.Tree.Project_Node_Tree_Ref;
 155       Flags            : Prj.Processing_Flags;
 156       In_Aggregate_Lib : Boolean;
 157    end record;
 158    --  Temporary data which is needed while parsing a project. It does not need
 159    --  to be kept in memory once a project has been fully loaded, but is
 160    --  necessary while performing consistency checks (duplicate sources,...)
 161    --  This data must be initialized before processing any project, and the
 162    --  same data is used for processing all projects in the tree.
 163 
 164    type Lib_Data is record
 165       Name : Name_Id;
 166       Proj : Project_Id;
 167       Tree : Project_Tree_Ref;
 168    end record;
 169 
 170    package Lib_Data_Table is new GNAT.Table
 171      (Table_Component_Type => Lib_Data,
 172       Table_Index_Type     => Natural,
 173       Table_Low_Bound      => 1,
 174       Table_Initial        => 10,
 175       Table_Increment      => 100);
 176    --  A table to record library names in order to check that two library
 177    --  projects do not have the same library names.
 178 
 179    procedure Initialize
 180      (Data      : out Tree_Processing_Data;
 181       Tree      : Project_Tree_Ref;
 182       Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
 183       Flags     : Prj.Processing_Flags);
 184    --  Initialize Data
 185 
 186    procedure Free (Data : in out Tree_Processing_Data);
 187    --  Free the memory occupied by Data
 188 
 189    procedure Initialize
 190      (Data    : in out Project_Processing_Data;
 191       Project : Project_Id);
 192    procedure Free (Data : in out Project_Processing_Data);
 193    --  Initialize or free memory for a project-specific data
 194 
 195    procedure Find_Excluded_Sources
 196      (Project : in out Project_Processing_Data;
 197       Data    : in out Tree_Processing_Data);
 198    --  Find the list of files that should not be considered as source files
 199    --  for this project. Sets the list in the Project.Excluded_Sources_Htable.
 200 
 201    procedure Override_Kind (Source : Source_Id; Kind : Source_Kind);
 202    --  Override the reference kind for a source file. This properly updates
 203    --  the unit data if necessary.
 204 
 205    procedure Load_Naming_Exceptions
 206      (Project : in out Project_Processing_Data;
 207       Data    : in out Tree_Processing_Data);
 208    --  All source files in Data.First_Source are considered as naming
 209    --  exceptions, and copied into the Source_Names and Unit_Exceptions tables
 210    --  as appropriate.
 211 
 212    type Search_Type is (Search_Files, Search_Directories);
 213 
 214    generic
 215       with procedure Callback
 216         (Path          : Path_Information;
 217          Pattern_Index : Natural);
 218    procedure Expand_Subdirectory_Pattern
 219      (Project       : Project_Id;
 220       Data          : in out Tree_Processing_Data;
 221       Patterns      : String_List_Id;
 222       Ignore        : String_List_Id;
 223       Search_For    : Search_Type;
 224       Resolve_Links : Boolean);
 225    --  Search the subdirectories of Project's directory for files or
 226    --  directories that match the globbing patterns found in Patterns (for
 227    --  instance "**/*.adb"). Typically, Patterns will be the value of the
 228    --  Source_Dirs or Excluded_Source_Dirs attributes.
 229    --
 230    --  Every time such a file or directory is found, the callback is called.
 231    --  Resolve_Links indicates whether we should resolve links while
 232    --  normalizing names.
 233    --
 234    --  In the callback, Pattern_Index is the index within Patterns where the
 235    --  expanded pattern was found (1 for the first element of Patterns and
 236    --  all its matching directories, then 2,...).
 237    --
 238    --  We use a generic and not an access-to-subprogram because in some cases
 239    --  this code is compiled with the restriction No_Implicit_Dynamic_Code.
 240    --  An error message is raised if a pattern does not match any file.
 241 
 242    procedure Add_Source
 243      (Id                  : out Source_Id;
 244       Data                : in out Tree_Processing_Data;
 245       Project             : Project_Id;
 246       Source_Dir_Rank     : Natural;
 247       Lang_Id             : Language_Ptr;
 248       Kind                : Source_Kind;
 249       File_Name           : File_Name_Type;
 250       Display_File        : File_Name_Type;
 251       Naming_Exception    : Naming_Exception_Type := No;
 252       Path                : Path_Information      := No_Path_Information;
 253       Alternate_Languages : Language_List         := null;
 254       Unit                : Name_Id               := No_Name;
 255       Index               : Int                   := 0;
 256       Locally_Removed     : Boolean               := False;
 257       Location            : Source_Ptr            := No_Location);
 258    --  Add a new source to the different lists: list of all sources in the
 259    --  project tree, list of source of a project and list of sources of a
 260    --  language. If Path is specified, the file is also added to
 261    --  Source_Paths_HT. Location is used for error messages
 262 
 263    function Canonical_Case_File_Name (Name : Name_Id) return File_Name_Type;
 264    --  Same as Osint.Canonical_Case_File_Name but applies to Name_Id.
 265    --  This alters Name_Buffer.
 266 
 267    function Suffix_Matches
 268      (Filename : String;
 269       Suffix   : File_Name_Type) return Boolean;
 270    --  True if the file name ends with the given suffix. Always returns False
 271    --  if Suffix is No_Name.
 272 
 273    procedure Replace_Into_Name_Buffer
 274      (Str         : String;
 275       Pattern     : String;
 276       Replacement : Character);
 277    --  Copy Str into Name_Buffer, replacing Pattern with Replacement. Str is
 278    --  converted to lower-case at the same time.
 279 
 280    procedure Check_Abstract_Project
 281      (Project : Project_Id;
 282       Data    : in out Tree_Processing_Data);
 283    --  Check abstract projects attributes
 284 
 285    procedure Check_Configuration
 286      (Project : Project_Id;
 287       Data    : in out Tree_Processing_Data);
 288    --  Check the configuration attributes for the project
 289 
 290    procedure Check_If_Externally_Built
 291      (Project : Project_Id;
 292       Data    : in out Tree_Processing_Data);
 293    --  Check attribute Externally_Built of project Project in project tree
 294    --  Data.Tree and modify its data Data if it has the value "true".
 295 
 296    procedure Check_Interfaces
 297      (Project : Project_Id;
 298       Data    : in out Tree_Processing_Data);
 299    --  If a list of sources is specified in attribute Interfaces, set
 300    --  In_Interfaces only for the sources specified in the list.
 301 
 302    procedure Check_Library_Attributes
 303      (Project : Project_Id;
 304       Data    : in out Tree_Processing_Data);
 305    --  Check the library attributes of project Project in project tree
 306    --  and modify its data Data accordingly.
 307 
 308    procedure Check_Package_Naming
 309      (Project : Project_Id;
 310       Data    : in out Tree_Processing_Data);
 311    --  Check the naming scheme part of Data, and initialize the naming scheme
 312    --  data in the config of the various languages.
 313 
 314    procedure Check_Programming_Languages
 315      (Project : Project_Id;
 316       Data    : in out Tree_Processing_Data);
 317    --  Check attribute Languages for the project with data Data in project
 318    --  tree Data.Tree and set the components of Data for all the programming
 319    --  languages indicated in attribute Languages, if any.
 320 
 321    procedure Check_Stand_Alone_Library
 322      (Project : Project_Id;
 323       Data    : in out Tree_Processing_Data);
 324    --  Check if project Project in project tree Data.Tree is a Stand-Alone
 325    --  Library project, and modify its data Data accordingly if it is one.
 326 
 327    procedure Check_Unit_Name (Name : String; Unit : out Name_Id);
 328    --  Check that a name is a valid unit name
 329 
 330    function Compute_Directory_Last (Dir : String) return Natural;
 331    --  Return the index of the last significant character in Dir. This is used
 332    --  to avoid duplicate '/' (slash) characters at the end of directory names.
 333 
 334    procedure Search_Directories
 335      (Project         : in out Project_Processing_Data;
 336       Data            : in out Tree_Processing_Data;
 337       For_All_Sources : Boolean);
 338    --  Search the source directories to find the sources. If For_All_Sources is
 339    --  True, check each regular file name against the naming schemes of the
 340    --  various languages. Otherwise consider only the file names in hash table
 341    --  Source_Names. If Allow_Duplicate_Basenames then files with identical
 342    --  base names are permitted within a project for source-based languages
 343    --  (never for unit based languages).
 344 
 345    procedure Check_File
 346      (Project           : in out Project_Processing_Data;
 347       Data              : in out Tree_Processing_Data;
 348       Source_Dir_Rank   : Natural;
 349       Path              : Path_Name_Type;
 350       Display_Path      : Path_Name_Type;
 351       File_Name         : File_Name_Type;
 352       Display_File_Name : File_Name_Type;
 353       Locally_Removed   : Boolean;
 354       For_All_Sources   : Boolean);
 355    --  Check if file File_Name is a valid source of the project. This is used
 356    --  in multi-language mode only. When the file matches one of the naming
 357    --  schemes, it is added to various htables through Add_Source and to
 358    --  Source_Paths_Htable.
 359    --
 360    --  File_Name is the same as Display_File_Name, but has been normalized.
 361    --  They do not include the directory information.
 362    --
 363    --  Path and Display_Path on the other hand are the full path to the file.
 364    --  Path must have been normalized (canonical casing and possibly links
 365    --  resolved).
 366    --
 367    --  Source_Directory is the directory in which the file was found. It is
 368    --  neither normalized nor has had links resolved, and must not end with a
 369    --  a directory separator, to avoid duplicates later on.
 370    --
 371    --  If For_All_Sources is True, then all possible file names are analyzed
 372    --  otherwise only those currently set in the Source_Names hash table.
 373 
 374    procedure Check_File_Naming_Schemes
 375      (Project               : Project_Processing_Data;
 376       File_Name             : File_Name_Type;
 377       Alternate_Languages   : out Language_List;
 378       Language              : out Language_Ptr;
 379       Display_Language_Name : out Name_Id;
 380       Unit                  : out Name_Id;
 381       Lang_Kind             : out Language_Kind;
 382       Kind                  : out Source_Kind);
 383    --  Check if the file name File_Name conforms to one of the naming schemes
 384    --  of the project. If the file does not match one of the naming schemes,
 385    --  set Language to No_Language_Index. Filename is the name of the file
 386    --  being investigated. It has been normalized (case-folded). File_Name is
 387    --  the same value.
 388 
 389    procedure Get_Directories
 390      (Project : Project_Id;
 391       Data    : in out Tree_Processing_Data);
 392    --  Get the object directory, the exec directory and the source directories
 393    --  of a project.
 394 
 395    procedure Get_Mains
 396      (Project : Project_Id;
 397       Data    : in out Tree_Processing_Data);
 398    --  Get the mains of a project from attribute Main, if it exists, and put
 399    --  them in the project data.
 400 
 401    procedure Get_Sources_From_File
 402      (Path     : String;
 403       Location : Source_Ptr;
 404       Project  : in out Project_Processing_Data;
 405       Data     : in out Tree_Processing_Data);
 406    --  Get the list of sources from a text file and put them in hash table
 407    --  Source_Names.
 408 
 409    procedure Find_Sources
 410      (Project : in out Project_Processing_Data;
 411       Data    : in out Tree_Processing_Data);
 412    --  Process the Source_Files and Source_List_File attributes, and store the
 413    --  list of source files into the Source_Names htable. When these attributes
 414    --  are not defined, find all files matching the naming schemes in the
 415    --  source directories. If Allow_Duplicate_Basenames, then files with the
 416    --  same base names are authorized within a project for source-based
 417    --  languages (never for unit based languages)
 418 
 419    procedure Compute_Unit_Name
 420      (File_Name : File_Name_Type;
 421       Naming    : Lang_Naming_Data;
 422       Kind      : out Source_Kind;
 423       Unit      : out Name_Id;
 424       Project   : Project_Processing_Data);
 425    --  Check whether the file matches the naming scheme. If it does,
 426    --  compute its unit name. If Unit is set to No_Name on exit, none of the
 427    --  other out parameters are relevant.
 428 
 429    procedure Check_Illegal_Suffix
 430      (Project         : Project_Id;
 431       Suffix          : File_Name_Type;
 432       Dot_Replacement : File_Name_Type;
 433       Attribute_Name  : String;
 434       Location        : Source_Ptr;
 435       Data            : in out Tree_Processing_Data);
 436    --  Display an error message if the given suffix is illegal for some reason.
 437    --  The name of the attribute we are testing is specified in Attribute_Name,
 438    --  which is used in the error message. Location is the location where the
 439    --  suffix is defined.
 440 
 441    procedure Locate_Directory
 442      (Project          : Project_Id;
 443       Name             : File_Name_Type;
 444       Path             : out Path_Information;
 445       Dir_Exists       : out Boolean;
 446       Data             : in out Tree_Processing_Data;
 447       Create           : String := "";
 448       Location         : Source_Ptr := No_Location;
 449       Must_Exist       : Boolean := True;
 450       Externally_Built : Boolean := False);
 451    --  Locate a directory. Name is the directory name. Relative paths are
 452    --  resolved relative to the project's directory. If the directory does not
 453    --  exist and Setup_Projects is True and Create is a non null string, an
 454    --  attempt is made to create the directory. If the directory does not
 455    --  exist, it is either created if Setup_Projects is False (and then
 456    --  returned), or simply returned without checking for its existence (if
 457    --  Must_Exist is False) or No_Path_Information is returned. In all cases,
 458    --  Dir_Exists indicates whether the directory now exists. Create is also
 459    --  used for debugging traces to show which path we are computing.
 460 
 461    procedure Look_For_Sources
 462      (Project : in out Project_Processing_Data;
 463       Data    : in out Tree_Processing_Data);
 464    --  Find all the sources of project Project in project tree Data.Tree and
 465    --  update its Data accordingly. This assumes that the special naming
 466    --  exceptions have already been processed.
 467 
 468    function Path_Name_Of
 469      (File_Name : File_Name_Type;
 470       Directory : Path_Name_Type) return String;
 471    --  Returns the path name of a (non project) file. Returns an empty string
 472    --  if file cannot be found.
 473 
 474    procedure Remove_Source
 475      (Tree        : Project_Tree_Ref;
 476       Id          : Source_Id;
 477       Replaced_By : Source_Id);
 478    --  Remove a file from the list of sources of a project. This might be
 479    --  because the file is replaced by another one in an extending project,
 480    --  or because a file was added as a naming exception but was not found
 481    --  in the end.
 482 
 483    procedure Report_No_Sources
 484      (Project      : Project_Id;
 485       Lang_Name    : String;
 486       Data         : Tree_Processing_Data;
 487       Location     : Source_Ptr;
 488       Continuation : Boolean := False);
 489    --  Report an error or a warning depending on the value of When_No_Sources
 490    --  when there are no sources for language Lang_Name.
 491 
 492    procedure Show_Source_Dirs
 493      (Project : Project_Id;
 494       Shared  : Shared_Project_Tree_Data_Access);
 495    --  List all the source directories of a project
 496 
 497    procedure Write_Attr (Name, Value : String);
 498    --  Debug print a value for a specific property. Does nothing when not in
 499    --  debug mode
 500 
 501    procedure Error_Or_Warning
 502      (Flags    : Processing_Flags;
 503       Kind     : Error_Warning;
 504       Msg      : String;
 505       Location : Source_Ptr;
 506       Project  : Project_Id);
 507    --  Emits either an error or warning message (or nothing), depending on Kind
 508 
 509    function No_Space_Img (N : Natural) return String;
 510    --  Image of a Natural without the initial space
 511 
 512    ----------------------
 513    -- Error_Or_Warning --
 514    ----------------------
 515 
 516    procedure Error_Or_Warning
 517      (Flags    : Processing_Flags;
 518       Kind     : Error_Warning;
 519       Msg      : String;
 520       Location : Source_Ptr;
 521       Project  : Project_Id) is
 522    begin
 523       case Kind is
 524          when Error   => Error_Msg (Flags, Msg, Location, Project);
 525          when Warning => Error_Msg (Flags, "?" & Msg, Location, Project);
 526          when Silent  => null;
 527       end case;
 528    end Error_Or_Warning;
 529 
 530    ------------------------------
 531    -- Replace_Into_Name_Buffer --
 532    ------------------------------
 533 
 534    procedure Replace_Into_Name_Buffer
 535      (Str         : String;
 536       Pattern     : String;
 537       Replacement : Character)
 538    is
 539       Max : constant Integer := Str'Last - Pattern'Length + 1;
 540       J   : Positive;
 541 
 542    begin
 543       Name_Len := 0;
 544 
 545       J := Str'First;
 546       while J <= Str'Last loop
 547          Name_Len := Name_Len + 1;
 548 
 549          if J <= Max and then Str (J .. J + Pattern'Length - 1) = Pattern then
 550             Name_Buffer (Name_Len) := Replacement;
 551             J := J + Pattern'Length;
 552          else
 553             Name_Buffer (Name_Len) := GNAT.Case_Util.To_Lower (Str (J));
 554             J := J + 1;
 555          end if;
 556       end loop;
 557    end Replace_Into_Name_Buffer;
 558 
 559    --------------------
 560    -- Suffix_Matches --
 561    --------------------
 562 
 563    function Suffix_Matches
 564      (Filename : String;
 565       Suffix   : File_Name_Type) return Boolean
 566    is
 567       Min_Prefix_Length : Natural := 0;
 568 
 569    begin
 570       if Suffix = No_File or else Suffix = Empty_File then
 571          return False;
 572       end if;
 573 
 574       declare
 575          Suf : String := Get_Name_String (Suffix);
 576 
 577       begin
 578          --  On non case-sensitive systems, use proper suffix casing
 579 
 580          Canonical_Case_File_Name (Suf);
 581 
 582          --  The file name must end with the suffix (which is not an extension)
 583          --  For instance a suffix "configure.in" must match a file with the
 584          --  same name. To avoid dummy cases, though, a suffix starting with
 585          --  '.' requires a file that is at least one character longer ('.cpp'
 586          --  should not match a file with the same name).
 587 
 588          if Suf (Suf'First) = '.' then
 589             Min_Prefix_Length := 1;
 590          end if;
 591 
 592          return Filename'Length >= Suf'Length + Min_Prefix_Length
 593            and then
 594              Filename (Filename'Last - Suf'Length + 1 .. Filename'Last) = Suf;
 595       end;
 596    end Suffix_Matches;
 597 
 598    ----------------
 599    -- Write_Attr --
 600    ----------------
 601 
 602    procedure Write_Attr (Name, Value : String) is
 603    begin
 604       if Current_Verbosity = High then
 605          Debug_Output (Name & " = """ & Value & '"');
 606       end if;
 607    end Write_Attr;
 608 
 609    ----------------
 610    -- Add_Source --
 611    ----------------
 612 
 613    procedure Add_Source
 614      (Id                  : out Source_Id;
 615       Data                : in out Tree_Processing_Data;
 616       Project             : Project_Id;
 617       Source_Dir_Rank     : Natural;
 618       Lang_Id             : Language_Ptr;
 619       Kind                : Source_Kind;
 620       File_Name           : File_Name_Type;
 621       Display_File        : File_Name_Type;
 622       Naming_Exception    : Naming_Exception_Type := No;
 623       Path                : Path_Information      := No_Path_Information;
 624       Alternate_Languages : Language_List         := null;
 625       Unit                : Name_Id               := No_Name;
 626       Index               : Int                   := 0;
 627       Locally_Removed     : Boolean               := False;
 628       Location            : Source_Ptr            := No_Location)
 629    is
 630       Config            : constant Language_Config := Lang_Id.Config;
 631       UData             : Unit_Index;
 632       Add_Src           : Boolean;
 633       Source            : Source_Id;
 634       Prev_Unit         : Unit_Index := No_Unit_Index;
 635       Source_To_Replace : Source_Id := No_Source;
 636 
 637    begin
 638       --  Check if the same file name or unit is used in the prj tree
 639 
 640       Add_Src := True;
 641 
 642       if Unit /= No_Name then
 643          Prev_Unit := Units_Htable.Get (Data.Tree.Units_HT, Unit);
 644       end if;
 645 
 646       if Prev_Unit /= No_Unit_Index
 647         and then (Kind = Impl or else Kind = Spec)
 648         and then Prev_Unit.File_Names (Kind) /= null
 649       then
 650          --  Suspicious, we need to check later whether this is authorized
 651 
 652          Add_Src := False;
 653          Source := Prev_Unit.File_Names (Kind);
 654 
 655       else
 656          Source := Source_Files_Htable.Get
 657            (Data.Tree.Source_Files_HT, File_Name);
 658 
 659          if Source /= No_Source and then Source.Index = Index then
 660             Add_Src := False;
 661          end if;
 662       end if;
 663 
 664       --  Always add the source if it is locally removed, to avoid incorrect
 665       --  duplicate checks.
 666 
 667       if Locally_Removed then
 668          Add_Src := True;
 669 
 670          --  A locally removed source may first replace a source in a project
 671          --  being extended.
 672 
 673          if Source /= No_Source
 674            and then Is_Extending (Project, Source.Project)
 675            and then Naming_Exception /= Inherited
 676          then
 677             Source_To_Replace := Source;
 678          end if;
 679 
 680       else
 681          --  Duplication of file/unit in same project is allowed if order of
 682          --  source directories is known, or if there is no compiler for the
 683          --  language.
 684 
 685          if Add_Src = False then
 686             Add_Src := True;
 687 
 688             if Project = Source.Project then
 689                if Prev_Unit = No_Unit_Index then
 690                   if Data.Flags.Allow_Duplicate_Basenames then
 691                      Add_Src := True;
 692 
 693                   elsif Lang_Id.Config.Compiler_Driver = Empty_File then
 694                      Add_Src := True;
 695 
 696                   elsif Source_Dir_Rank /= Source.Source_Dir_Rank then
 697                      Add_Src := False;
 698 
 699                   else
 700                      Error_Msg_File_1 := File_Name;
 701                      Error_Msg
 702                        (Data.Flags, "duplicate source file name {",
 703                         Location, Project);
 704                      Add_Src := False;
 705                   end if;
 706 
 707                else
 708                   if Source_Dir_Rank /= Source.Source_Dir_Rank then
 709                      Add_Src := False;
 710 
 711                      --  We might be seeing the same file through a different
 712                      --  path (for instance because of symbolic links).
 713 
 714                   elsif Source.Path.Name /= Path.Name then
 715                      if not Source.Duplicate_Unit then
 716                         Error_Msg_Name_1 := Unit;
 717                         Error_Msg
 718                           (Data.Flags,
 719                            "\duplicate unit %%",
 720                            Location,
 721                            Project);
 722                         Source.Duplicate_Unit := True;
 723                      end if;
 724 
 725                      Add_Src := False;
 726                   end if;
 727                end if;
 728 
 729                --  Do not allow the same unit name in different projects,
 730                --  except if one is extending the other.
 731 
 732                --  For a file based language, the same file name replaces a
 733                --  file in a project being extended, but it is allowed to have
 734                --  the same file name in unrelated projects.
 735 
 736             elsif Is_Extending (Project, Source.Project) then
 737                if not Locally_Removed and then Naming_Exception /= Inherited
 738                then
 739                   Source_To_Replace := Source;
 740                end if;
 741 
 742             elsif Prev_Unit /= No_Unit_Index
 743               and then Prev_Unit.File_Names (Kind) /= null
 744               and then not Source.Locally_Removed
 745               and then Source.Replaced_By = No_Source
 746               and then not Data.In_Aggregate_Lib
 747             then
 748                --  Path is set if this is a source we found on the disk, in
 749                --  which case we can provide more explicit error message. Path
 750                --  is unset when the source is added from one of the naming
 751                --  exceptions in the project.
 752 
 753                if Path /= No_Path_Information then
 754                   Error_Msg_Name_1 := Unit;
 755                   Error_Msg
 756                     (Data.Flags,
 757                      "unit %% cannot belong to several projects",
 758                      Location, Project);
 759 
 760                   Error_Msg_Name_1 := Project.Name;
 761                   Error_Msg_Name_2 := Name_Id (Path.Display_Name);
 762                   Error_Msg
 763                     (Data.Flags, "\  project %%, %%", Location, Project);
 764 
 765                   Error_Msg_Name_1 := Source.Project.Name;
 766                   Error_Msg_Name_2 := Name_Id (Source.Path.Display_Name);
 767                   Error_Msg
 768                     (Data.Flags, "\  project %%, %%", Location, Project);
 769 
 770                else
 771                   Error_Msg_Name_1 := Unit;
 772                   Error_Msg_Name_2 := Source.Project.Name;
 773                   Error_Msg
 774                     (Data.Flags, "unit %% already belongs to project %%",
 775                      Location, Project);
 776                end if;
 777 
 778                Add_Src := False;
 779 
 780             elsif not Source.Locally_Removed
 781               and then Source.Replaced_By /= No_Source
 782               and then not Data.Flags.Allow_Duplicate_Basenames
 783               and then Lang_Id.Config.Kind = Unit_Based
 784               and then Source.Language.Config.Kind = Unit_Based
 785               and then not Data.In_Aggregate_Lib
 786             then
 787                Error_Msg_File_1 := File_Name;
 788                Error_Msg_File_2 := File_Name_Type (Source.Project.Name);
 789                Error_Msg
 790                  (Data.Flags,
 791                   "{ is already a source of project {", Location, Project);
 792 
 793                --  Add the file anyway, to avoid further warnings like
 794                --  "language unknown".
 795 
 796                Add_Src := True;
 797             end if;
 798          end if;
 799       end if;
 800 
 801       if not Add_Src then
 802          return;
 803       end if;
 804 
 805       --  Add the new file
 806 
 807       Id := new Source_Data;
 808 
 809       if Current_Verbosity = High then
 810          Debug_Indent;
 811          Write_Str ("adding source File: ");
 812          Write_Str (Get_Name_String (Display_File));
 813 
 814          if Index /= 0 then
 815             Write_Str (" at" & Index'Img);
 816          end if;
 817 
 818          if Lang_Id.Config.Kind = Unit_Based then
 819             Write_Str (" Unit: ");
 820 
 821             --  ??? in gprclean, it seems we sometimes pass an empty Unit name
 822             --  (see test extended_projects).
 823 
 824             if Unit /= No_Name then
 825                Write_Str (Get_Name_String (Unit));
 826             end if;
 827 
 828             Write_Str (" Kind: ");
 829             Write_Str (Source_Kind'Image (Kind));
 830          end if;
 831 
 832          Write_Eol;
 833       end if;
 834 
 835       Id.Project             := Project;
 836       Id.Location            := Location;
 837       Id.Source_Dir_Rank     := Source_Dir_Rank;
 838       Id.Language            := Lang_Id;
 839       Id.Kind                := Kind;
 840       Id.Alternate_Languages := Alternate_Languages;
 841       Id.Locally_Removed     := Locally_Removed;
 842       Id.Index               := Index;
 843       Id.File                := File_Name;
 844       Id.Display_File        := Display_File;
 845       Id.Dep_Name            := Dependency_Name
 846                                   (File_Name, Lang_Id.Config.Dependency_Kind);
 847       Id.Naming_Exception    := Naming_Exception;
 848       Id.Object              := Object_Name
 849                                   (File_Name, Config.Object_File_Suffix);
 850       Id.Switches            := Switches_Name (File_Name);
 851 
 852       --  Add the source id to the Unit_Sources_HT hash table, if the unit name
 853       --  is not null.
 854 
 855       if Unit /= No_Name then
 856 
 857          --  Note: we might be creating a dummy unit here, when we in fact have
 858          --  a separate. For instance, file file-bar.adb will initially be
 859          --  assumed to be the IMPL of unit "file.bar". Only later on (in
 860          --  Check_Object_Files) will we parse those units that only have an
 861          --  impl and no spec to make sure whether we have a Separate in fact
 862          --  (that significantly reduces the number of times we need to parse
 863          --  the files, since we are then only interested in those with no
 864          --  spec). We still need those dummy units in the table, since that's
 865          --  the name we find in the ALI file
 866 
 867          UData := Units_Htable.Get (Data.Tree.Units_HT, Unit);
 868 
 869          if UData = No_Unit_Index then
 870             UData := new Unit_Data;
 871             UData.Name := Unit;
 872 
 873             if Naming_Exception /= Inherited then
 874                Units_Htable.Set (Data.Tree.Units_HT, Unit, UData);
 875             end if;
 876          end if;
 877 
 878          Id.Unit := UData;
 879 
 880          --  Note that this updates Unit information as well
 881 
 882          if Naming_Exception /= Inherited and then not Locally_Removed then
 883             Override_Kind (Id, Kind);
 884          end if;
 885       end if;
 886 
 887       if Path /= No_Path_Information then
 888          Id.Path := Path;
 889          Source_Paths_Htable.Set (Data.Tree.Source_Paths_HT, Path.Name, Id);
 890       end if;
 891 
 892       Id.Next_With_File_Name :=
 893         Source_Files_Htable.Get (Data.Tree.Source_Files_HT, File_Name);
 894       Source_Files_Htable.Set (Data.Tree.Source_Files_HT, File_Name, Id);
 895 
 896       if Index /= 0 then
 897          Project.Has_Multi_Unit_Sources := True;
 898       end if;
 899 
 900       --  Add the source to the language list
 901 
 902       Id.Next_In_Lang := Lang_Id.First_Source;
 903       Lang_Id.First_Source := Id;
 904 
 905       if Source_To_Replace /= No_Source then
 906          Remove_Source (Data.Tree, Source_To_Replace, Id);
 907       end if;
 908 
 909       if Data.Tree.Replaced_Source_Number > 0
 910         and then
 911           Replaced_Source_HTable.Get
 912             (Data.Tree.Replaced_Sources, Id.File) /= No_File
 913       then
 914          Replaced_Source_HTable.Remove (Data.Tree.Replaced_Sources, Id.File);
 915          Data.Tree.Replaced_Source_Number :=
 916            Data.Tree.Replaced_Source_Number - 1;
 917       end if;
 918    end Add_Source;
 919 
 920    ------------------------------
 921    -- Canonical_Case_File_Name --
 922    ------------------------------
 923 
 924    function Canonical_Case_File_Name (Name : Name_Id) return File_Name_Type is
 925    begin
 926       if Osint.File_Names_Case_Sensitive then
 927          return File_Name_Type (Name);
 928       else
 929          Get_Name_String (Name);
 930          Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
 931          return Name_Find;
 932       end if;
 933    end Canonical_Case_File_Name;
 934 
 935    ---------------------------------
 936    -- Process_Aggregated_Projects --
 937    ---------------------------------
 938 
 939    procedure Process_Aggregated_Projects
 940      (Tree      : Project_Tree_Ref;
 941       Project   : Project_Id;
 942       Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
 943       Flags     : Processing_Flags)
 944    is
 945       Data : Tree_Processing_Data :=
 946                (Tree             => Tree,
 947                 Node_Tree        => Node_Tree,
 948                 Flags            => Flags,
 949                 In_Aggregate_Lib => False);
 950 
 951       Project_Files : constant Prj.Variable_Value :=
 952                         Prj.Util.Value_Of
 953                           (Snames.Name_Project_Files,
 954                            Project.Decl.Attributes,
 955                            Tree.Shared);
 956 
 957       Project_Path_For_Aggregate : Prj.Env.Project_Search_Path;
 958 
 959       procedure Found_Project_File (Path : Path_Information; Rank : Natural);
 960       --  Called for each project file aggregated by Project
 961 
 962       procedure Expand_Project_Files is
 963         new Expand_Subdirectory_Pattern (Callback => Found_Project_File);
 964       --  Search for all project files referenced by the patterns given in
 965       --  parameter. Calls Found_Project_File for each of them.
 966 
 967       ------------------------
 968       -- Found_Project_File --
 969       ------------------------
 970 
 971       procedure Found_Project_File (Path : Path_Information; Rank : Natural) is
 972          pragma Unreferenced (Rank);
 973 
 974       begin
 975          if Path.Name /= Project.Path.Name then
 976             Debug_Output ("aggregates: ", Name_Id (Path.Display_Name));
 977 
 978             --  For usual "with" statement, this phase will have been done when
 979             --  parsing the project itself. However, for aggregate projects, we
 980             --  can only do this when processing the aggregate project, since
 981             --  the exact list of project files or project directories can
 982             --  depend on scenario variables.
 983             --
 984             --  We only load the projects explicitly here, but do not process
 985             --  them. For the processing, Prj.Proc will take care of processing
 986             --  them, within the same call to Recursive_Process (thus avoiding
 987             --  the processing of a given project multiple times).
 988             --
 989             --  ??? We might already have loaded the project
 990 
 991             Add_Aggregated_Project (Project, Path => Path.Name);
 992 
 993          else
 994             Debug_Output ("pattern returned the aggregate itself, ignored");
 995          end if;
 996       end Found_Project_File;
 997 
 998    --  Start of processing for Check_Aggregate_Project
 999 
1000    begin
1001       pragma Assert (Project.Qualifier in Aggregate_Project);
1002 
1003       if Project_Files.Default then
1004          Error_Msg_Name_1 := Snames.Name_Project_Files;
1005          Error_Msg
1006            (Flags,
1007             "Attribute %% must be specified in aggregate project",
1008             Project.Location, Project);
1009          return;
1010       end if;
1011 
1012       --  The aggregated projects are only searched relative to the directory
1013       --  of the aggregate project, not in the default project path.
1014 
1015       Initialize_Empty (Project_Path_For_Aggregate);
1016 
1017       Free (Project.Aggregated_Projects);
1018 
1019       --  Look for aggregated projects. For similarity with source files and
1020       --  dirs, the aggregated project files are not searched for on the
1021       --  project path, and are only found through the path specified in
1022       --  the Project_Files attribute.
1023 
1024       Expand_Project_Files
1025         (Project       => Project,
1026          Data          => Data,
1027          Patterns      => Project_Files.Values,
1028          Ignore        => Nil_String,
1029          Search_For    => Search_Files,
1030          Resolve_Links => Opt.Follow_Links_For_Files);
1031 
1032       Free (Project_Path_For_Aggregate);
1033    end Process_Aggregated_Projects;
1034 
1035    ----------------------------
1036    -- Check_Abstract_Project --
1037    ----------------------------
1038 
1039    procedure Check_Abstract_Project
1040      (Project : Project_Id;
1041       Data    : in out Tree_Processing_Data)
1042    is
1043       Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
1044 
1045       Source_Dirs      : constant Variable_Value :=
1046                            Util.Value_Of
1047                              (Name_Source_Dirs,
1048                               Project.Decl.Attributes, Shared);
1049       Source_Files     : constant Variable_Value :=
1050                            Util.Value_Of
1051                              (Name_Source_Files,
1052                               Project.Decl.Attributes, Shared);
1053       Source_List_File : constant Variable_Value :=
1054                            Util.Value_Of
1055                              (Name_Source_List_File,
1056                               Project.Decl.Attributes, Shared);
1057       Languages        : constant Variable_Value :=
1058                            Util.Value_Of
1059                              (Name_Languages,
1060                               Project.Decl.Attributes, Shared);
1061 
1062    begin
1063       if Project.Source_Dirs /= Nil_String then
1064          if Source_Dirs.Values  = Nil_String
1065            and then Source_Files.Values = Nil_String
1066            and then Languages.Values = Nil_String
1067            and then Source_List_File.Default
1068          then
1069             Project.Source_Dirs := Nil_String;
1070 
1071          else
1072             Error_Msg
1073               (Data.Flags,
1074                "at least one of Source_Files, Source_Dirs or Languages "
1075                & "must be declared empty for an abstract project",
1076                Project.Location, Project);
1077          end if;
1078       end if;
1079    end Check_Abstract_Project;
1080 
1081    -------------------------
1082    -- Check_Configuration --
1083    -------------------------
1084 
1085    procedure Check_Configuration
1086      (Project : Project_Id;
1087       Data    : in out Tree_Processing_Data)
1088    is
1089       Shared          : constant Shared_Project_Tree_Data_Access :=
1090                           Data.Tree.Shared;
1091 
1092       Dot_Replacement : File_Name_Type := No_File;
1093       Casing          : Casing_Type    := All_Lower_Case;
1094       Separate_Suffix : File_Name_Type := No_File;
1095 
1096       Lang_Index : Language_Ptr := No_Language_Index;
1097       --  The index of the language data being checked
1098 
1099       Prev_Index : Language_Ptr := No_Language_Index;
1100       --  The index of the previous language
1101 
1102       procedure Process_Project_Level_Simple_Attributes;
1103       --  Process the simple attributes at the project level
1104 
1105       procedure Process_Project_Level_Array_Attributes;
1106       --  Process the associate array attributes at the project level
1107 
1108       procedure Process_Packages;
1109       --  Read the packages of the project
1110 
1111       ----------------------
1112       -- Process_Packages --
1113       ----------------------
1114 
1115       procedure Process_Packages is
1116          Packages : Package_Id;
1117          Element  : Package_Element;
1118 
1119          procedure Process_Binder (Arrays : Array_Id);
1120          --  Process the associated array attributes of package Binder
1121 
1122          procedure Process_Builder (Attributes : Variable_Id);
1123          --  Process the simple attributes of package Builder
1124 
1125          procedure Process_Clean (Attributes : Variable_Id);
1126          --  Process the simple attributes of package Clean
1127 
1128          procedure Process_Clean  (Arrays : Array_Id);
1129          --  Process the associated array attributes of package Clean
1130 
1131          procedure Process_Compiler (Arrays : Array_Id);
1132          --  Process the associated array attributes of package Compiler
1133 
1134          procedure Process_Naming (Attributes : Variable_Id);
1135          --  Process the simple attributes of package Naming
1136 
1137          procedure Process_Naming (Arrays : Array_Id);
1138          --  Process the associated array attributes of package Naming
1139 
1140          procedure Process_Linker (Attributes : Variable_Id);
1141          --  Process the simple attributes of package Linker of a
1142          --  configuration project.
1143 
1144          --------------------
1145          -- Process_Binder --
1146          --------------------
1147 
1148          procedure Process_Binder (Arrays : Array_Id) is
1149             Current_Array_Id : Array_Id;
1150             Current_Array    : Array_Data;
1151             Element_Id       : Array_Element_Id;
1152             Element          : Array_Element;
1153 
1154          begin
1155             --  Process the associative array attribute of package Binder
1156 
1157             Current_Array_Id := Arrays;
1158             while Current_Array_Id /= No_Array loop
1159                Current_Array := Shared.Arrays.Table (Current_Array_Id);
1160 
1161                Element_Id := Current_Array.Value;
1162                while Element_Id /= No_Array_Element loop
1163                   Element := Shared.Array_Elements.Table (Element_Id);
1164 
1165                   if Element.Index /= All_Other_Names then
1166 
1167                      --  Get the name of the language
1168 
1169                      Lang_Index :=
1170                        Get_Language_From_Name
1171                          (Project, Get_Name_String (Element.Index));
1172 
1173                      if Lang_Index /= No_Language_Index then
1174                         case Current_Array.Name is
1175                            when Name_Driver =>
1176 
1177                               --  Attribute Driver (<language>)
1178 
1179                               Lang_Index.Config.Binder_Driver :=
1180                                 File_Name_Type (Element.Value.Value);
1181 
1182                            when Name_Required_Switches =>
1183                               Put
1184                                 (Into_List =>
1185                                    Lang_Index.Config.Binder_Required_Switches,
1186                                  From_List => Element.Value.Values,
1187                                  In_Tree   => Data.Tree);
1188 
1189                            when Name_Prefix =>
1190 
1191                               --  Attribute Prefix (<language>)
1192 
1193                               Lang_Index.Config.Binder_Prefix :=
1194                                 Element.Value.Value;
1195 
1196                            when Name_Objects_Path =>
1197 
1198                               --  Attribute Objects_Path (<language>)
1199 
1200                               Lang_Index.Config.Objects_Path :=
1201                                 Element.Value.Value;
1202 
1203                            when Name_Objects_Path_File =>
1204 
1205                               --  Attribute Objects_Path (<language>)
1206 
1207                               Lang_Index.Config.Objects_Path_File :=
1208                                 Element.Value.Value;
1209 
1210                            when others =>
1211                               null;
1212                         end case;
1213                      end if;
1214                   end if;
1215 
1216                   Element_Id := Element.Next;
1217                end loop;
1218 
1219                Current_Array_Id := Current_Array.Next;
1220             end loop;
1221          end Process_Binder;
1222 
1223          ---------------------
1224          -- Process_Builder --
1225          ---------------------
1226 
1227          procedure Process_Builder (Attributes : Variable_Id) is
1228             Attribute_Id : Variable_Id;
1229             Attribute    : Variable;
1230 
1231          begin
1232             --  Process non associated array attribute from package Builder
1233 
1234             Attribute_Id := Attributes;
1235             while Attribute_Id /= No_Variable loop
1236                Attribute := Shared.Variable_Elements.Table (Attribute_Id);
1237 
1238                if not Attribute.Value.Default then
1239                   if Attribute.Name = Name_Executable_Suffix then
1240 
1241                      --  Attribute Executable_Suffix: the suffix of the
1242                      --  executables.
1243 
1244                      Project.Config.Executable_Suffix :=
1245                        Attribute.Value.Value;
1246                   end if;
1247                end if;
1248 
1249                Attribute_Id := Attribute.Next;
1250             end loop;
1251          end Process_Builder;
1252 
1253          -------------------
1254          -- Process_Clean --
1255          -------------------
1256 
1257          procedure Process_Clean (Attributes : Variable_Id) is
1258             Attribute_Id : Variable_Id;
1259             Attribute    : Variable;
1260             List         : String_List_Id;
1261 
1262          begin
1263             --  Process non associated array attributes from package Clean
1264 
1265             Attribute_Id := Attributes;
1266             while Attribute_Id /= No_Variable loop
1267                Attribute := Shared.Variable_Elements.Table (Attribute_Id);
1268 
1269                if not Attribute.Value.Default then
1270                   if Attribute.Name = Name_Artifacts_In_Exec_Dir then
1271 
1272                      --  Attribute Artifacts_In_Exec_Dir: the list of file
1273                      --  names to be cleaned in the exec dir of the main
1274                      --  project.
1275 
1276                      List := Attribute.Value.Values;
1277 
1278                      if List /= Nil_String then
1279                         Put (Into_List =>
1280                                Project.Config.Artifacts_In_Exec_Dir,
1281                              From_List => List,
1282                              In_Tree   => Data.Tree);
1283                      end if;
1284 
1285                   elsif Attribute.Name = Name_Artifacts_In_Object_Dir then
1286 
1287                      --  Attribute Artifacts_In_Exec_Dir: the list of file
1288                      --  names to be cleaned in the object dir of every
1289                      --  project.
1290 
1291                      List := Attribute.Value.Values;
1292 
1293                      if List /= Nil_String then
1294                         Put (Into_List =>
1295                                Project.Config.Artifacts_In_Object_Dir,
1296                              From_List => List,
1297                              In_Tree   => Data.Tree);
1298                      end if;
1299                   end if;
1300                end if;
1301 
1302                Attribute_Id := Attribute.Next;
1303             end loop;
1304          end Process_Clean;
1305 
1306          procedure Process_Clean  (Arrays : Array_Id) is
1307             Current_Array_Id : Array_Id;
1308             Current_Array    : Array_Data;
1309             Element_Id       : Array_Element_Id;
1310             Element          : Array_Element;
1311             List             : String_List_Id;
1312 
1313          begin
1314             --  Process the associated array attributes of package Clean
1315 
1316             Current_Array_Id := Arrays;
1317             while Current_Array_Id /= No_Array loop
1318                Current_Array := Shared.Arrays.Table (Current_Array_Id);
1319 
1320                Element_Id := Current_Array.Value;
1321                while Element_Id /= No_Array_Element loop
1322                   Element := Shared.Array_Elements.Table (Element_Id);
1323 
1324                   --  Get the name of the language
1325 
1326                   Lang_Index :=
1327                     Get_Language_From_Name
1328                       (Project, Get_Name_String (Element.Index));
1329 
1330                   if Lang_Index /= No_Language_Index then
1331                      case Current_Array.Name is
1332 
1333                         --  Attribute Object_Artifact_Extensions (<language>)
1334 
1335                         when Name_Object_Artifact_Extensions =>
1336                            List := Element.Value.Values;
1337 
1338                            if List /= Nil_String then
1339                               Put (Into_List =>
1340                                      Lang_Index.Config.Clean_Object_Artifacts,
1341                                    From_List => List,
1342                                    In_Tree   => Data.Tree);
1343                            end if;
1344 
1345                         --  Attribute Source_Artifact_Extensions (<language>)
1346 
1347                         when Name_Source_Artifact_Extensions =>
1348                            List := Element.Value.Values;
1349 
1350                            if List /= Nil_String then
1351                               Put (Into_List =>
1352                                      Lang_Index.Config.Clean_Source_Artifacts,
1353                                    From_List => List,
1354                                    In_Tree   => Data.Tree);
1355                            end if;
1356 
1357                         when others =>
1358                            null;
1359                      end case;
1360                   end if;
1361 
1362                   Element_Id := Element.Next;
1363                end loop;
1364 
1365                Current_Array_Id := Current_Array.Next;
1366             end loop;
1367          end Process_Clean;
1368 
1369          ----------------------
1370          -- Process_Compiler --
1371          ----------------------
1372 
1373          procedure Process_Compiler (Arrays : Array_Id) is
1374             Current_Array_Id : Array_Id;
1375             Current_Array    : Array_Data;
1376             Element_Id       : Array_Element_Id;
1377             Element          : Array_Element;
1378             List             : String_List_Id;
1379 
1380          begin
1381             --  Process the associative array attribute of package Compiler
1382 
1383             Current_Array_Id := Arrays;
1384             while Current_Array_Id /= No_Array loop
1385                Current_Array := Shared.Arrays.Table (Current_Array_Id);
1386 
1387                Element_Id := Current_Array.Value;
1388                while Element_Id /= No_Array_Element loop
1389                   Element := Shared.Array_Elements.Table (Element_Id);
1390 
1391                   if Element.Index /= All_Other_Names then
1392 
1393                      --  Get the name of the language
1394 
1395                      Lang_Index := Get_Language_From_Name
1396                        (Project, Get_Name_String (Element.Index));
1397 
1398                      if Lang_Index /= No_Language_Index then
1399                         case Current_Array.Name is
1400 
1401                         --  Attribute Dependency_Kind (<language>)
1402 
1403                         when Name_Dependency_Kind =>
1404                            Get_Name_String (Element.Value.Value);
1405 
1406                            begin
1407                               Lang_Index.Config.Dependency_Kind :=
1408                                 Dependency_File_Kind'Value
1409                                   (Name_Buffer (1 .. Name_Len));
1410 
1411                            exception
1412                               when Constraint_Error =>
1413                                  Error_Msg
1414                                    (Data.Flags,
1415                                     "illegal value for Dependency_Kind",
1416                                     Element.Value.Location,
1417                                     Project);
1418                            end;
1419 
1420                         --  Attribute Dependency_Switches (<language>)
1421 
1422                         when Name_Dependency_Switches =>
1423                            if Lang_Index.Config.Dependency_Kind = None then
1424                               Lang_Index.Config.Dependency_Kind := Makefile;
1425                            end if;
1426 
1427                            List := Element.Value.Values;
1428 
1429                            if List /= Nil_String then
1430                               Put (Into_List =>
1431                                      Lang_Index.Config.Dependency_Option,
1432                                    From_List => List,
1433                                    In_Tree   => Data.Tree);
1434                            end if;
1435 
1436                         --  Attribute Dependency_Driver (<language>)
1437 
1438                         when Name_Dependency_Driver =>
1439                            if Lang_Index.Config.Dependency_Kind = None then
1440                               Lang_Index.Config.Dependency_Kind := Makefile;
1441                            end if;
1442 
1443                            List := Element.Value.Values;
1444 
1445                            if List /= Nil_String then
1446                               Put (Into_List =>
1447                                      Lang_Index.Config.Compute_Dependency,
1448                                    From_List => List,
1449                                    In_Tree   => Data.Tree);
1450                            end if;
1451 
1452                         --  Attribute Language_Kind (<language>)
1453 
1454                         when Name_Language_Kind =>
1455                            Get_Name_String (Element.Value.Value);
1456 
1457                            begin
1458                               Lang_Index.Config.Kind :=
1459                                 Language_Kind'Value
1460                                   (Name_Buffer (1 .. Name_Len));
1461 
1462                            exception
1463                               when Constraint_Error =>
1464                                  Error_Msg
1465                                    (Data.Flags,
1466                                     "illegal value for Language_Kind",
1467                                     Element.Value.Location,
1468                                     Project);
1469                            end;
1470 
1471                         --  Attribute Include_Switches (<language>)
1472 
1473                         when Name_Include_Switches =>
1474                            List := Element.Value.Values;
1475 
1476                            if List = Nil_String then
1477                               Error_Msg
1478                                 (Data.Flags, "include option cannot be null",
1479                                  Element.Value.Location, Project);
1480                            end if;
1481 
1482                            Put (Into_List => Lang_Index.Config.Include_Option,
1483                                 From_List => List,
1484                                 In_Tree   => Data.Tree);
1485 
1486                         --  Attribute Include_Path (<language>)
1487 
1488                         when Name_Include_Path =>
1489                            Lang_Index.Config.Include_Path :=
1490                              Element.Value.Value;
1491 
1492                         --  Attribute Include_Path_File (<language>)
1493 
1494                         when Name_Include_Path_File =>
1495                            Lang_Index.Config.Include_Path_File :=
1496                              Element.Value.Value;
1497 
1498                         --  Attribute Driver (<language>)
1499 
1500                         when Name_Driver =>
1501                            Lang_Index.Config.Compiler_Driver :=
1502                              File_Name_Type (Element.Value.Value);
1503 
1504                         when Name_Required_Switches
1505                            | Name_Leading_Required_Switches
1506                            =>
1507                            Put (Into_List =>
1508                                   Lang_Index.Config.
1509                                     Compiler_Leading_Required_Switches,
1510                                 From_List => Element.Value.Values,
1511                                 In_Tree   => Data.Tree);
1512 
1513                         when Name_Trailing_Required_Switches =>
1514                            Put (Into_List =>
1515                                   Lang_Index.Config.
1516                                     Compiler_Trailing_Required_Switches,
1517                                 From_List => Element.Value.Values,
1518                                 In_Tree   => Data.Tree);
1519 
1520                         when Name_Multi_Unit_Switches =>
1521                            Put (Into_List =>
1522                                   Lang_Index.Config.Multi_Unit_Switches,
1523                                 From_List => Element.Value.Values,
1524                                 In_Tree   => Data.Tree);
1525 
1526                         when Name_Multi_Unit_Object_Separator =>
1527                            Get_Name_String (Element.Value.Value);
1528 
1529                            if Name_Len /= 1 then
1530                               Error_Msg
1531                                 (Data.Flags,
1532                                  "multi-unit object separator must have " &
1533                                  "a single character",
1534                                  Element.Value.Location, Project);
1535 
1536                            elsif Name_Buffer (1) = ' ' then
1537                               Error_Msg
1538                                 (Data.Flags,
1539                                  "multi-unit object separator cannot be " &
1540                                  "a space",
1541                                  Element.Value.Location, Project);
1542 
1543                            else
1544                               Lang_Index.Config.Multi_Unit_Object_Separator :=
1545                                 Name_Buffer (1);
1546                            end if;
1547 
1548                         when Name_Path_Syntax =>
1549                            begin
1550                               Lang_Index.Config.Path_Syntax :=
1551                                   Path_Syntax_Kind'Value
1552                                     (Get_Name_String (Element.Value.Value));
1553 
1554                            exception
1555                               when Constraint_Error =>
1556                                  Error_Msg
1557                                    (Data.Flags,
1558                                     "invalid value for Path_Syntax",
1559                                     Element.Value.Location, Project);
1560                            end;
1561 
1562                         when Name_Source_File_Switches =>
1563                            Put (Into_List =>
1564                                   Lang_Index.Config.Source_File_Switches,
1565                                 From_List => Element.Value.Values,
1566                                 In_Tree   => Data.Tree);
1567 
1568                         when Name_Object_File_Suffix =>
1569                            if Get_Name_String (Element.Value.Value) = "" then
1570                               Error_Msg
1571                                 (Data.Flags,
1572                                  "object file suffix cannot be empty",
1573                                  Element.Value.Location, Project);
1574 
1575                            else
1576                               Lang_Index.Config.Object_File_Suffix :=
1577                                 Element.Value.Value;
1578                            end if;
1579 
1580                         when Name_Object_File_Switches =>
1581                            Put (Into_List =>
1582                                   Lang_Index.Config.Object_File_Switches,
1583                                 From_List => Element.Value.Values,
1584                                 In_Tree   => Data.Tree);
1585 
1586                         when Name_Object_Path_Switches =>
1587                            Put (Into_List =>
1588                                   Lang_Index.Config.Object_Path_Switches,
1589                                 From_List => Element.Value.Values,
1590                                 In_Tree   => Data.Tree);
1591 
1592                         --  Attribute Compiler_Pic_Option (<language>)
1593 
1594                         when Name_Pic_Option =>
1595                            List := Element.Value.Values;
1596 
1597                            if List = Nil_String then
1598                               Error_Msg
1599                                 (Data.Flags,
1600                                  "compiler PIC option cannot be null",
1601                                  Element.Value.Location, Project);
1602                            end if;
1603 
1604                            Put (Into_List =>
1605                                   Lang_Index.Config.Compilation_PIC_Option,
1606                                 From_List => List,
1607                                 In_Tree   => Data.Tree);
1608 
1609                         --  Attribute Mapping_File_Switches (<language>)
1610 
1611                         when Name_Mapping_File_Switches =>
1612                            List := Element.Value.Values;
1613 
1614                            if List = Nil_String then
1615                               Error_Msg
1616                                 (Data.Flags,
1617                                  "mapping file switches cannot be null",
1618                                  Element.Value.Location, Project);
1619                            end if;
1620 
1621                            Put (Into_List =>
1622                                 Lang_Index.Config.Mapping_File_Switches,
1623                                 From_List => List,
1624                                 In_Tree   => Data.Tree);
1625 
1626                         --  Attribute Mapping_Spec_Suffix (<language>)
1627 
1628                         when Name_Mapping_Spec_Suffix =>
1629                            Lang_Index.Config.Mapping_Spec_Suffix :=
1630                              File_Name_Type (Element.Value.Value);
1631 
1632                         --  Attribute Mapping_Body_Suffix (<language>)
1633 
1634                         when Name_Mapping_Body_Suffix =>
1635                            Lang_Index.Config.Mapping_Body_Suffix :=
1636                              File_Name_Type (Element.Value.Value);
1637 
1638                         --  Attribute Config_File_Switches (<language>)
1639 
1640                         when Name_Config_File_Switches =>
1641                            List := Element.Value.Values;
1642 
1643                            if List = Nil_String then
1644                               Error_Msg
1645                                 (Data.Flags,
1646                                  "config file switches cannot be null",
1647                                  Element.Value.Location, Project);
1648                            end if;
1649 
1650                            Put (Into_List =>
1651                                   Lang_Index.Config.Config_File_Switches,
1652                                 From_List => List,
1653                                 In_Tree   => Data.Tree);
1654 
1655                         --  Attribute Objects_Path (<language>)
1656 
1657                         when Name_Objects_Path =>
1658                            Lang_Index.Config.Objects_Path :=
1659                              Element.Value.Value;
1660 
1661                         --  Attribute Objects_Path_File (<language>)
1662 
1663                         when Name_Objects_Path_File =>
1664                            Lang_Index.Config.Objects_Path_File :=
1665                              Element.Value.Value;
1666 
1667                         --  Attribute Config_Body_File_Name (<language>)
1668 
1669                         when Name_Config_Body_File_Name =>
1670                            Lang_Index.Config.Config_Body :=
1671                              Element.Value.Value;
1672 
1673                         --  Attribute Config_Body_File_Name_Index (< Language>)
1674 
1675                         when Name_Config_Body_File_Name_Index =>
1676                            Lang_Index.Config.Config_Body_Index :=
1677                              Element.Value.Value;
1678 
1679                         --  Attribute Config_Body_File_Name_Pattern(<language>)
1680 
1681                         when Name_Config_Body_File_Name_Pattern =>
1682                            Lang_Index.Config.Config_Body_Pattern :=
1683                              Element.Value.Value;
1684 
1685                            --  Attribute Config_Spec_File_Name (<language>)
1686 
1687                         when Name_Config_Spec_File_Name =>
1688                            Lang_Index.Config.Config_Spec :=
1689                              Element.Value.Value;
1690 
1691                         --  Attribute Config_Spec_File_Name_Index (<language>)
1692 
1693                         when Name_Config_Spec_File_Name_Index =>
1694                            Lang_Index.Config.Config_Spec_Index :=
1695                              Element.Value.Value;
1696 
1697                         --  Attribute Config_Spec_File_Name_Pattern(<language>)
1698 
1699                         when Name_Config_Spec_File_Name_Pattern =>
1700                            Lang_Index.Config.Config_Spec_Pattern :=
1701                              Element.Value.Value;
1702 
1703                         --  Attribute Config_File_Unique (<language>)
1704 
1705                         when Name_Config_File_Unique =>
1706                            begin
1707                               Lang_Index.Config.Config_File_Unique :=
1708                                 Boolean'Value
1709                                   (Get_Name_String (Element.Value.Value));
1710                            exception
1711                               when Constraint_Error =>
1712                                  Error_Msg
1713                                    (Data.Flags,
1714                                     "illegal value for Config_File_Unique",
1715                                     Element.Value.Location, Project);
1716                            end;
1717 
1718                         when others =>
1719                            null;
1720                         end case;
1721                      end if;
1722                   end if;
1723 
1724                   Element_Id := Element.Next;
1725                end loop;
1726 
1727                Current_Array_Id := Current_Array.Next;
1728             end loop;
1729          end Process_Compiler;
1730 
1731          --------------------
1732          -- Process_Naming --
1733          --------------------
1734 
1735          procedure Process_Naming (Attributes : Variable_Id) is
1736             Attribute_Id : Variable_Id;
1737             Attribute    : Variable;
1738 
1739          begin
1740             --  Process non associated array attribute from package Naming
1741 
1742             Attribute_Id := Attributes;
1743             while Attribute_Id /= No_Variable loop
1744                Attribute := Shared.Variable_Elements.Table (Attribute_Id);
1745 
1746                if not Attribute.Value.Default then
1747                   if Attribute.Name = Name_Separate_Suffix then
1748 
1749                      --  Attribute Separate_Suffix
1750 
1751                      Get_Name_String (Attribute.Value.Value);
1752                      Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1753                      Separate_Suffix := Name_Find;
1754 
1755                   elsif Attribute.Name = Name_Casing then
1756 
1757                      --  Attribute Casing
1758 
1759                      begin
1760                         Casing :=
1761                           Value (Get_Name_String (Attribute.Value.Value));
1762 
1763                      exception
1764                         when Constraint_Error =>
1765                            Error_Msg
1766                              (Data.Flags,
1767                               "invalid value for Casing",
1768                               Attribute.Value.Location, Project);
1769                      end;
1770 
1771                   elsif Attribute.Name = Name_Dot_Replacement then
1772 
1773                      --  Attribute Dot_Replacement
1774 
1775                      Dot_Replacement := File_Name_Type (Attribute.Value.Value);
1776 
1777                   end if;
1778                end if;
1779 
1780                Attribute_Id := Attribute.Next;
1781             end loop;
1782          end Process_Naming;
1783 
1784          procedure Process_Naming (Arrays : Array_Id) is
1785             Current_Array_Id : Array_Id;
1786             Current_Array    : Array_Data;
1787             Element_Id       : Array_Element_Id;
1788             Element          : Array_Element;
1789 
1790          begin
1791             --  Process the associative array attribute of package Naming
1792 
1793             Current_Array_Id := Arrays;
1794             while Current_Array_Id /= No_Array loop
1795                Current_Array := Shared.Arrays.Table (Current_Array_Id);
1796 
1797                Element_Id := Current_Array.Value;
1798                while Element_Id /= No_Array_Element loop
1799                   Element := Shared.Array_Elements.Table (Element_Id);
1800 
1801                   --  Get the name of the language
1802 
1803                   Lang_Index := Get_Language_From_Name
1804                     (Project, Get_Name_String (Element.Index));
1805 
1806                   if Lang_Index /= No_Language_Index
1807                     and then Element.Value.Kind = Single
1808                     and then Element.Value.Value /= No_Name
1809                   then
1810                      case Current_Array.Name is
1811                         when Name_Spec_Suffix | Name_Specification_Suffix =>
1812 
1813                            --  Attribute Spec_Suffix (<language>)
1814 
1815                            Get_Name_String (Element.Value.Value);
1816                            Canonical_Case_File_Name
1817                              (Name_Buffer (1 .. Name_Len));
1818                            Lang_Index.Config.Naming_Data.Spec_Suffix :=
1819                              Name_Find;
1820 
1821                         when Name_Implementation_Suffix | Name_Body_Suffix =>
1822 
1823                            Get_Name_String (Element.Value.Value);
1824                            Canonical_Case_File_Name
1825                              (Name_Buffer (1 .. Name_Len));
1826 
1827                            --  Attribute Body_Suffix (<language>)
1828 
1829                            Lang_Index.Config.Naming_Data.Body_Suffix :=
1830                              Name_Find;
1831                            Lang_Index.Config.Naming_Data.Separate_Suffix :=
1832                              Lang_Index.Config.Naming_Data.Body_Suffix;
1833 
1834                         when others =>
1835                            null;
1836                      end case;
1837                   end if;
1838 
1839                   Element_Id := Element.Next;
1840                end loop;
1841 
1842                Current_Array_Id := Current_Array.Next;
1843             end loop;
1844          end Process_Naming;
1845 
1846          --------------------
1847          -- Process_Linker --
1848          --------------------
1849 
1850          procedure Process_Linker (Attributes : Variable_Id) is
1851             Attribute_Id : Variable_Id;
1852             Attribute    : Variable;
1853 
1854          begin
1855             --  Process non associated array attribute from package Linker
1856 
1857             Attribute_Id := Attributes;
1858             while Attribute_Id /= No_Variable loop
1859                Attribute := Shared.Variable_Elements.Table (Attribute_Id);
1860 
1861                if not Attribute.Value.Default then
1862                   if Attribute.Name = Name_Driver then
1863 
1864                      --  Attribute Linker'Driver: the default linker to use
1865 
1866                      Project.Config.Linker :=
1867                        Path_Name_Type (Attribute.Value.Value);
1868 
1869                      --  Linker'Driver is also used to link shared libraries
1870                      --  if the obsolescent attribute Library_GCC has not been
1871                      --  specified.
1872 
1873                      if Project.Config.Shared_Lib_Driver = No_File then
1874                         Project.Config.Shared_Lib_Driver :=
1875                           File_Name_Type (Attribute.Value.Value);
1876                      end if;
1877 
1878                   elsif Attribute.Name = Name_Required_Switches then
1879 
1880                      --  Attribute Required_Switches: the minimum trailing
1881                      --  options to use when invoking the linker
1882 
1883                      Put (Into_List =>
1884                             Project.Config.Trailing_Linker_Required_Switches,
1885                           From_List => Attribute.Value.Values,
1886                           In_Tree   => Data.Tree);
1887 
1888                   elsif Attribute.Name = Name_Map_File_Option then
1889                      Project.Config.Map_File_Option := Attribute.Value.Value;
1890 
1891                   elsif Attribute.Name = Name_Max_Command_Line_Length then
1892                      begin
1893                         Project.Config.Max_Command_Line_Length :=
1894                           Natural'Value (Get_Name_String
1895                                          (Attribute.Value.Value));
1896 
1897                      exception
1898                         when Constraint_Error =>
1899                            Error_Msg
1900                              (Data.Flags,
1901                               "value must be positive or equal to 0",
1902                               Attribute.Value.Location, Project);
1903                      end;
1904 
1905                   elsif Attribute.Name = Name_Response_File_Format then
1906                      declare
1907                         Name  : Name_Id;
1908 
1909                      begin
1910                         Get_Name_String (Attribute.Value.Value);
1911                         To_Lower (Name_Buffer (1 .. Name_Len));
1912                         Name := Name_Find;
1913 
1914                         if Name = Name_None then
1915                            Project.Config.Resp_File_Format := None;
1916 
1917                         elsif Name = Name_Gnu then
1918                            Project.Config.Resp_File_Format := GNU;
1919 
1920                         elsif Name = Name_Object_List then
1921                            Project.Config.Resp_File_Format := Object_List;
1922 
1923                         elsif Name = Name_Option_List then
1924                            Project.Config.Resp_File_Format := Option_List;
1925 
1926                         elsif Name_Buffer (1 .. Name_Len) = "gcc" then
1927                            Project.Config.Resp_File_Format := GCC;
1928 
1929                         elsif Name_Buffer (1 .. Name_Len) = "gcc_gnu" then
1930                            Project.Config.Resp_File_Format := GCC_GNU;
1931 
1932                         elsif
1933                           Name_Buffer (1 .. Name_Len) = "gcc_option_list"
1934                         then
1935                            Project.Config.Resp_File_Format := GCC_Option_List;
1936 
1937                         elsif
1938                           Name_Buffer (1 .. Name_Len) = "gcc_object_list"
1939                         then
1940                            Project.Config.Resp_File_Format := GCC_Object_List;
1941 
1942                         else
1943                            Error_Msg
1944                              (Data.Flags,
1945                               "illegal response file format",
1946                               Attribute.Value.Location, Project);
1947                         end if;
1948                      end;
1949 
1950                   elsif Attribute.Name = Name_Response_File_Switches then
1951                      Put (Into_List => Project.Config.Resp_File_Options,
1952                           From_List => Attribute.Value.Values,
1953                           In_Tree   => Data.Tree);
1954                   end if;
1955                end if;
1956 
1957                Attribute_Id := Attribute.Next;
1958             end loop;
1959          end Process_Linker;
1960 
1961       --  Start of processing for Process_Packages
1962 
1963       begin
1964          Packages := Project.Decl.Packages;
1965          while Packages /= No_Package loop
1966             Element := Shared.Packages.Table (Packages);
1967 
1968             case Element.Name is
1969                when Name_Binder =>
1970 
1971                   --  Process attributes of package Binder
1972 
1973                   Process_Binder (Element.Decl.Arrays);
1974 
1975                when Name_Builder =>
1976 
1977                   --  Process attributes of package Builder
1978 
1979                   Process_Builder (Element.Decl.Attributes);
1980 
1981                when Name_Clean =>
1982 
1983                   --  Process attributes of package Clean
1984 
1985                   Process_Clean (Element.Decl.Attributes);
1986                   Process_Clean (Element.Decl.Arrays);
1987 
1988                when Name_Compiler =>
1989 
1990                   --  Process attributes of package Compiler
1991 
1992                   Process_Compiler (Element.Decl.Arrays);
1993 
1994                when Name_Linker =>
1995 
1996                   --  Process attributes of package Linker
1997 
1998                   Process_Linker (Element.Decl.Attributes);
1999 
2000                when Name_Naming =>
2001 
2002                   --  Process attributes of package Naming
2003 
2004                   Process_Naming (Element.Decl.Attributes);
2005                   Process_Naming (Element.Decl.Arrays);
2006 
2007                when others =>
2008                   null;
2009             end case;
2010 
2011             Packages := Element.Next;
2012          end loop;
2013       end Process_Packages;
2014 
2015       ---------------------------------------------
2016       -- Process_Project_Level_Simple_Attributes --
2017       ---------------------------------------------
2018 
2019       procedure Process_Project_Level_Simple_Attributes is
2020          Attribute_Id : Variable_Id;
2021          Attribute    : Variable;
2022          List         : String_List_Id;
2023 
2024       begin
2025          --  Process non associated array attribute at project level
2026 
2027          Attribute_Id := Project.Decl.Attributes;
2028          while Attribute_Id /= No_Variable loop
2029             Attribute := Shared.Variable_Elements.Table (Attribute_Id);
2030 
2031             if not Attribute.Value.Default then
2032                if Attribute.Name = Name_Target then
2033 
2034                   --  Attribute Target: the target specified
2035 
2036                   Project.Config.Target := Attribute.Value.Value;
2037 
2038                elsif Attribute.Name = Name_Library_Builder then
2039 
2040                   --  Attribute Library_Builder: the application to invoke
2041                   --  to build libraries.
2042 
2043                   Project.Config.Library_Builder :=
2044                     Path_Name_Type (Attribute.Value.Value);
2045 
2046                elsif Attribute.Name = Name_Archive_Builder then
2047 
2048                   --  Attribute Archive_Builder: the archive builder
2049                   --  (usually "ar") and its minimum options (usually "cr").
2050 
2051                   List := Attribute.Value.Values;
2052 
2053                   if List = Nil_String then
2054                      Error_Msg
2055                        (Data.Flags,
2056                         "archive builder cannot be null",
2057                         Attribute.Value.Location, Project);
2058                   end if;
2059 
2060                   Put (Into_List => Project.Config.Archive_Builder,
2061                        From_List => List,
2062                        In_Tree   => Data.Tree);
2063 
2064                elsif Attribute.Name = Name_Archive_Builder_Append_Option then
2065 
2066                   --  Attribute Archive_Builder: the archive builder
2067                   --  (usually "ar") and its minimum options (usually "cr").
2068 
2069                   List := Attribute.Value.Values;
2070 
2071                   if List /= Nil_String then
2072                      Put
2073                        (Into_List =>
2074                           Project.Config.Archive_Builder_Append_Option,
2075                         From_List => List,
2076                         In_Tree   => Data.Tree);
2077                   end if;
2078 
2079                elsif Attribute.Name = Name_Archive_Indexer then
2080 
2081                   --  Attribute Archive_Indexer: the optional archive
2082                   --  indexer (usually "ranlib") with its minimum options
2083                   --  (usually none).
2084 
2085                   List := Attribute.Value.Values;
2086 
2087                   if List = Nil_String then
2088                      Error_Msg
2089                        (Data.Flags,
2090                         "archive indexer cannot be null",
2091                         Attribute.Value.Location, Project);
2092                   end if;
2093 
2094                   Put (Into_List => Project.Config.Archive_Indexer,
2095                        From_List => List,
2096                        In_Tree   => Data.Tree);
2097 
2098                elsif Attribute.Name = Name_Library_Partial_Linker then
2099 
2100                   --  Attribute Library_Partial_Linker: the optional linker
2101                   --  driver with its minimum options, to partially link
2102                   --  archives.
2103 
2104                   List := Attribute.Value.Values;
2105 
2106                   if List = Nil_String then
2107                      Error_Msg
2108                        (Data.Flags,
2109                         "partial linker cannot be null",
2110                         Attribute.Value.Location, Project);
2111                   end if;
2112 
2113                   Put (Into_List => Project.Config.Lib_Partial_Linker,
2114                        From_List => List,
2115                        In_Tree   => Data.Tree);
2116 
2117                elsif Attribute.Name = Name_Library_GCC then
2118                   Project.Config.Shared_Lib_Driver :=
2119                     File_Name_Type (Attribute.Value.Value);
2120                   Error_Msg
2121                     (Data.Flags,
2122                      "?Library_'G'C'C is an obsolescent attribute, " &
2123                      "use Linker''Driver instead",
2124                      Attribute.Value.Location, Project);
2125 
2126                elsif Attribute.Name = Name_Archive_Suffix then
2127                   Project.Config.Archive_Suffix :=
2128                     File_Name_Type (Attribute.Value.Value);
2129 
2130                elsif Attribute.Name = Name_Linker_Executable_Option then
2131 
2132                   --  Attribute Linker_Executable_Option: optional options
2133                   --  to specify an executable name. Defaults to "-o".
2134 
2135                   List := Attribute.Value.Values;
2136 
2137                   if List = Nil_String then
2138                      Error_Msg
2139                        (Data.Flags,
2140                         "linker executable option cannot be null",
2141                         Attribute.Value.Location, Project);
2142                   end if;
2143 
2144                   Put (Into_List => Project.Config.Linker_Executable_Option,
2145                        From_List => List,
2146                        In_Tree   => Data.Tree);
2147 
2148                elsif Attribute.Name = Name_Linker_Lib_Dir_Option then
2149 
2150                   --  Attribute Linker_Lib_Dir_Option: optional options
2151                   --  to specify a library search directory. Defaults to
2152                   --  "-L".
2153 
2154                   Get_Name_String (Attribute.Value.Value);
2155 
2156                   if Name_Len = 0 then
2157                      Error_Msg
2158                        (Data.Flags,
2159                         "linker library directory option cannot be empty",
2160                         Attribute.Value.Location, Project);
2161                   end if;
2162 
2163                   Project.Config.Linker_Lib_Dir_Option :=
2164                     Attribute.Value.Value;
2165 
2166                elsif Attribute.Name = Name_Linker_Lib_Name_Option then
2167 
2168                   --  Attribute Linker_Lib_Name_Option: optional options
2169                   --  to specify the name of a library to be linked in.
2170                   --  Defaults to "-l".
2171 
2172                   Get_Name_String (Attribute.Value.Value);
2173 
2174                   if Name_Len = 0 then
2175                      Error_Msg
2176                        (Data.Flags,
2177                         "linker library name option cannot be empty",
2178                         Attribute.Value.Location, Project);
2179                   end if;
2180 
2181                   Project.Config.Linker_Lib_Name_Option :=
2182                     Attribute.Value.Value;
2183 
2184                elsif Attribute.Name = Name_Run_Path_Option then
2185 
2186                   --  Attribute Run_Path_Option: optional options to
2187                   --  specify a path for libraries.
2188 
2189                   List := Attribute.Value.Values;
2190 
2191                   if List /= Nil_String then
2192                      Put (Into_List => Project.Config.Run_Path_Option,
2193                           From_List => List,
2194                           In_Tree   => Data.Tree);
2195                   end if;
2196 
2197                elsif Attribute.Name = Name_Run_Path_Origin then
2198                   Get_Name_String (Attribute.Value.Value);
2199 
2200                   if Name_Len = 0 then
2201                      Error_Msg
2202                        (Data.Flags,
2203                         "run path origin cannot be empty",
2204                         Attribute.Value.Location, Project);
2205                   end if;
2206 
2207                   Project.Config.Run_Path_Origin := Attribute.Value.Value;
2208 
2209                elsif Attribute.Name = Name_Library_Install_Name_Option then
2210                   Project.Config.Library_Install_Name_Option :=
2211                     Attribute.Value.Value;
2212 
2213                elsif Attribute.Name = Name_Separate_Run_Path_Options then
2214                   declare
2215                      pragma Unsuppress (All_Checks);
2216                   begin
2217                      Project.Config.Separate_Run_Path_Options :=
2218                        Boolean'Value (Get_Name_String (Attribute.Value.Value));
2219                   exception
2220                      when Constraint_Error =>
2221                         Error_Msg
2222                           (Data.Flags,
2223                            "invalid value """ &
2224                            Get_Name_String (Attribute.Value.Value) &
2225                            """ for Separate_Run_Path_Options",
2226                            Attribute.Value.Location, Project);
2227                   end;
2228 
2229                elsif Attribute.Name = Name_Library_Support then
2230                   declare
2231                      pragma Unsuppress (All_Checks);
2232                   begin
2233                      Project.Config.Lib_Support :=
2234                        Library_Support'Value (Get_Name_String
2235                                               (Attribute.Value.Value));
2236                   exception
2237                      when Constraint_Error =>
2238                         Error_Msg
2239                           (Data.Flags,
2240                            "invalid value """ &
2241                            Get_Name_String (Attribute.Value.Value) &
2242                            """ for Library_Support",
2243                            Attribute.Value.Location, Project);
2244                   end;
2245 
2246                elsif
2247                  Attribute.Name = Name_Library_Encapsulated_Supported
2248                then
2249                   declare
2250                      pragma Unsuppress (All_Checks);
2251                   begin
2252                      Project.Config.Lib_Encapsulated_Supported :=
2253                        Boolean'Value (Get_Name_String (Attribute.Value.Value));
2254                   exception
2255                      when Constraint_Error =>
2256                         Error_Msg
2257                           (Data.Flags,
2258                            "invalid value """
2259                              & Get_Name_String (Attribute.Value.Value)
2260                              & """ for Library_Encapsulated_Supported",
2261                            Attribute.Value.Location, Project);
2262                   end;
2263 
2264                elsif Attribute.Name = Name_Shared_Library_Prefix then
2265                   Project.Config.Shared_Lib_Prefix :=
2266                     File_Name_Type (Attribute.Value.Value);
2267 
2268                elsif Attribute.Name = Name_Shared_Library_Suffix then
2269                   Project.Config.Shared_Lib_Suffix :=
2270                     File_Name_Type (Attribute.Value.Value);
2271 
2272                elsif Attribute.Name = Name_Symbolic_Link_Supported then
2273                   declare
2274                      pragma Unsuppress (All_Checks);
2275                   begin
2276                      Project.Config.Symbolic_Link_Supported :=
2277                        Boolean'Value (Get_Name_String
2278                                       (Attribute.Value.Value));
2279                   exception
2280                      when Constraint_Error =>
2281                         Error_Msg
2282                           (Data.Flags,
2283                            "invalid value """
2284                              & Get_Name_String (Attribute.Value.Value)
2285                              & """ for Symbolic_Link_Supported",
2286                            Attribute.Value.Location, Project);
2287                   end;
2288 
2289                elsif
2290                  Attribute.Name = Name_Library_Major_Minor_Id_Supported
2291                then
2292                   declare
2293                      pragma Unsuppress (All_Checks);
2294                   begin
2295                      Project.Config.Lib_Maj_Min_Id_Supported :=
2296                        Boolean'Value (Get_Name_String
2297                                       (Attribute.Value.Value));
2298                   exception
2299                      when Constraint_Error =>
2300                         Error_Msg
2301                           (Data.Flags,
2302                            "invalid value """ &
2303                            Get_Name_String (Attribute.Value.Value) &
2304                            """ for Library_Major_Minor_Id_Supported",
2305                            Attribute.Value.Location, Project);
2306                   end;
2307 
2308                elsif Attribute.Name = Name_Library_Auto_Init_Supported then
2309                   declare
2310                      pragma Unsuppress (All_Checks);
2311                   begin
2312                      Project.Config.Auto_Init_Supported :=
2313                        Boolean'Value (Get_Name_String (Attribute.Value.Value));
2314                   exception
2315                      when Constraint_Error =>
2316                         Error_Msg
2317                           (Data.Flags,
2318                            "invalid value """
2319                              & Get_Name_String (Attribute.Value.Value)
2320                              & """ for Library_Auto_Init_Supported",
2321                            Attribute.Value.Location, Project);
2322                   end;
2323 
2324                elsif Attribute.Name = Name_Shared_Library_Minimum_Switches then
2325                   List := Attribute.Value.Values;
2326 
2327                   if List /= Nil_String then
2328                      Put (Into_List => Project.Config.Shared_Lib_Min_Options,
2329                           From_List => List,
2330                           In_Tree   => Data.Tree);
2331                   end if;
2332 
2333                elsif Attribute.Name = Name_Library_Version_Switches then
2334                   List := Attribute.Value.Values;
2335 
2336                   if List /= Nil_String then
2337                      Put (Into_List => Project.Config.Lib_Version_Options,
2338                           From_List => List,
2339                           In_Tree   => Data.Tree);
2340                   end if;
2341                end if;
2342             end if;
2343 
2344             Attribute_Id := Attribute.Next;
2345          end loop;
2346       end Process_Project_Level_Simple_Attributes;
2347 
2348       --------------------------------------------
2349       -- Process_Project_Level_Array_Attributes --
2350       --------------------------------------------
2351 
2352       procedure Process_Project_Level_Array_Attributes is
2353          Current_Array_Id : Array_Id;
2354          Current_Array    : Array_Data;
2355          Element_Id       : Array_Element_Id;
2356          Element          : Array_Element;
2357          List             : String_List_Id;
2358 
2359       begin
2360          --  Process the associative array attributes at project level
2361 
2362          Current_Array_Id := Project.Decl.Arrays;
2363          while Current_Array_Id /= No_Array loop
2364             Current_Array := Shared.Arrays.Table (Current_Array_Id);
2365 
2366             Element_Id := Current_Array.Value;
2367             while Element_Id /= No_Array_Element loop
2368                Element := Shared.Array_Elements.Table (Element_Id);
2369 
2370                --  Get the name of the language
2371 
2372                Lang_Index :=
2373                  Get_Language_From_Name
2374                    (Project, Get_Name_String (Element.Index));
2375 
2376                if Lang_Index /= No_Language_Index then
2377                   case Current_Array.Name is
2378                      when Name_Inherit_Source_Path =>
2379                         List := Element.Value.Values;
2380 
2381                         if List /= Nil_String then
2382                            Put
2383                              (Into_List  =>
2384                                 Lang_Index.Config.Include_Compatible_Languages,
2385                               From_List  => List,
2386                               In_Tree    => Data.Tree,
2387                               Lower_Case => True);
2388                         end if;
2389 
2390                      when Name_Toolchain_Description =>
2391 
2392                         --  Attribute Toolchain_Description (<language>)
2393 
2394                         Lang_Index.Config.Toolchain_Description :=
2395                           Element.Value.Value;
2396 
2397                      when Name_Toolchain_Version =>
2398 
2399                         --  Attribute Toolchain_Version (<language>)
2400 
2401                         Lang_Index.Config.Toolchain_Version :=
2402                           Element.Value.Value;
2403 
2404                         --  For Ada, set proper checksum computation mode,
2405                         --  which has changed from version to version.
2406 
2407                         if Lang_Index.Name = Name_Ada then
2408                            declare
2409                               Vers : constant String :=
2410                                        Get_Name_String (Element.Value.Value);
2411                               pragma Assert (Vers'First = 1);
2412 
2413                            begin
2414                               --  Version 6.3 or earlier
2415 
2416                               if Vers'Length >= 8
2417                                 and then Vers (1 .. 5) = "GNAT "
2418                                 and then Vers (7) = '.'
2419                                 and then
2420                                   (Vers (6) < '6'
2421                                     or else
2422                                       (Vers (6) = '6' and then Vers (8) < '4'))
2423                               then
2424                                  Checksum_GNAT_6_3 := True;
2425 
2426                                  --  Version 5.03 or earlier
2427 
2428                                  if Vers (6) < '5'
2429                                    or else (Vers (6) = '5'
2430                                              and then Vers (Vers'Last) < '4')
2431                                  then
2432                                     Checksum_GNAT_5_03 := True;
2433 
2434                                     --  Version 5.02 or earlier (no checksums)
2435 
2436                                     if Vers (6) /= '5'
2437                                       or else Vers (Vers'Last) < '3'
2438                                     then
2439                                        Checksum_Accumulate_Token_Checksum :=
2440                                          False;
2441                                     end if;
2442                                  end if;
2443                               end if;
2444                            end;
2445                         end if;
2446 
2447                      when Name_Runtime_Library_Dir =>
2448 
2449                         --  Attribute Runtime_Library_Dir (<language>)
2450 
2451                         Lang_Index.Config.Runtime_Library_Dir :=
2452                           Element.Value.Value;
2453 
2454                      when Name_Runtime_Source_Dir =>
2455 
2456                         --  Attribute Runtime_Source_Dir (<language>)
2457 
2458                         Lang_Index.Config.Runtime_Source_Dir :=
2459                           Element.Value.Value;
2460 
2461                      when Name_Object_Generated =>
2462                         declare
2463                            pragma Unsuppress (All_Checks);
2464                            Value : Boolean;
2465 
2466                         begin
2467                            Value :=
2468                              Boolean'Value
2469                                (Get_Name_String (Element.Value.Value));
2470 
2471                            Lang_Index.Config.Object_Generated := Value;
2472 
2473                            --  If no object is generated, no object may be
2474                            --  linked.
2475 
2476                            if not Value then
2477                               Lang_Index.Config.Objects_Linked := False;
2478                            end if;
2479 
2480                         exception
2481                            when Constraint_Error =>
2482                               Error_Msg
2483                                 (Data.Flags,
2484                                  "invalid value """
2485                                  & Get_Name_String (Element.Value.Value)
2486                                  & """ for Object_Generated",
2487                                  Element.Value.Location, Project);
2488                         end;
2489 
2490                      when Name_Objects_Linked =>
2491                         declare
2492                            pragma Unsuppress (All_Checks);
2493                            Value : Boolean;
2494 
2495                         begin
2496                            Value :=
2497                              Boolean'Value
2498                                (Get_Name_String (Element.Value.Value));
2499 
2500                            --  No change if Object_Generated is False, as this
2501                            --  forces Objects_Linked to be False too.
2502 
2503                            if Lang_Index.Config.Object_Generated then
2504                               Lang_Index.Config.Objects_Linked := Value;
2505                            end if;
2506 
2507                         exception
2508                            when Constraint_Error =>
2509                               Error_Msg
2510                                 (Data.Flags,
2511                                  "invalid value """
2512                                  & Get_Name_String (Element.Value.Value)
2513                                  & """ for Objects_Linked",
2514                                  Element.Value.Location, Project);
2515                         end;
2516                      when others =>
2517                         null;
2518                   end case;
2519                end if;
2520 
2521                Element_Id := Element.Next;
2522             end loop;
2523 
2524             Current_Array_Id := Current_Array.Next;
2525          end loop;
2526       end Process_Project_Level_Array_Attributes;
2527 
2528    --  Start of processing for Check_Configuration
2529 
2530    begin
2531       Process_Project_Level_Simple_Attributes;
2532       Process_Project_Level_Array_Attributes;
2533       Process_Packages;
2534 
2535       --  For unit based languages, set Casing, Dot_Replacement and
2536       --  Separate_Suffix in Naming_Data.
2537 
2538       Lang_Index := Project.Languages;
2539       while Lang_Index /= No_Language_Index loop
2540          if Lang_Index.Config.Kind = Unit_Based then
2541             Lang_Index.Config.Naming_Data.Casing := Casing;
2542             Lang_Index.Config.Naming_Data.Dot_Replacement := Dot_Replacement;
2543 
2544             if Separate_Suffix /= No_File then
2545                Lang_Index.Config.Naming_Data.Separate_Suffix :=
2546                  Separate_Suffix;
2547             end if;
2548 
2549             exit;
2550          end if;
2551 
2552          Lang_Index := Lang_Index.Next;
2553       end loop;
2554 
2555       --  Give empty names to various prefixes/suffixes, if they have not
2556       --  been specified in the configuration.
2557 
2558       if Project.Config.Archive_Suffix = No_File then
2559          Project.Config.Archive_Suffix := Empty_File;
2560       end if;
2561 
2562       if Project.Config.Shared_Lib_Prefix = No_File then
2563          Project.Config.Shared_Lib_Prefix := Empty_File;
2564       end if;
2565 
2566       if Project.Config.Shared_Lib_Suffix = No_File then
2567          Project.Config.Shared_Lib_Suffix := Empty_File;
2568       end if;
2569 
2570       Lang_Index := Project.Languages;
2571       while Lang_Index /= No_Language_Index loop
2572 
2573          --  For all languages, Compiler_Driver needs to be specified. This is
2574          --  only needed if we do intend to compile (not in GPS for instance).
2575 
2576          if Data.Flags.Compiler_Driver_Mandatory
2577            and then Lang_Index.Config.Compiler_Driver = No_File
2578            and then not Project.Externally_Built
2579          then
2580             Error_Msg_Name_1 := Lang_Index.Display_Name;
2581             Error_Msg
2582               (Data.Flags,
2583                "?\no compiler specified for language %%" &
2584                  ", ignoring all its sources",
2585                No_Location, Project);
2586 
2587             if Lang_Index = Project.Languages then
2588                Project.Languages := Lang_Index.Next;
2589             else
2590                Prev_Index.Next := Lang_Index.Next;
2591             end if;
2592 
2593          elsif Lang_Index.Config.Kind = Unit_Based then
2594             Prev_Index := Lang_Index;
2595 
2596             --  For unit based languages, Dot_Replacement, Spec_Suffix and
2597             --  Body_Suffix need to be specified.
2598 
2599             if Lang_Index.Config.Naming_Data.Dot_Replacement = No_File then
2600                Error_Msg
2601                  (Data.Flags,
2602                   "Dot_Replacement not specified for " &
2603                   Get_Name_String (Lang_Index.Name),
2604                   No_Location, Project);
2605             end if;
2606 
2607             if Lang_Index.Config.Naming_Data.Spec_Suffix = No_File then
2608                Error_Msg
2609                  (Data.Flags,
2610                   "\Spec_Suffix not specified for " &
2611                   Get_Name_String (Lang_Index.Name),
2612                   No_Location, Project);
2613             end if;
2614 
2615             if Lang_Index.Config.Naming_Data.Body_Suffix = No_File then
2616                Error_Msg
2617                  (Data.Flags,
2618                   "\Body_Suffix not specified for " &
2619                   Get_Name_String (Lang_Index.Name),
2620                   No_Location, Project);
2621             end if;
2622 
2623          else
2624             Prev_Index := Lang_Index;
2625 
2626             --  For file based languages, either Spec_Suffix or Body_Suffix
2627             --  need to be specified.
2628 
2629             if Data.Flags.Require_Sources_Other_Lang
2630               and then Lang_Index.Config.Naming_Data.Spec_Suffix = No_File
2631               and then Lang_Index.Config.Naming_Data.Body_Suffix = No_File
2632             then
2633                Error_Msg_Name_1 := Lang_Index.Display_Name;
2634                Error_Msg
2635                  (Data.Flags,
2636                   "\no suffixes specified for %%",
2637                   No_Location, Project);
2638             end if;
2639          end if;
2640 
2641          Lang_Index := Lang_Index.Next;
2642       end loop;
2643    end Check_Configuration;
2644 
2645    -------------------------------
2646    -- Check_If_Externally_Built --
2647    -------------------------------
2648 
2649    procedure Check_If_Externally_Built
2650      (Project : Project_Id;
2651       Data    : in out Tree_Processing_Data)
2652    is
2653       Shared   : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
2654       Externally_Built : constant Variable_Value :=
2655                            Util.Value_Of
2656                             (Name_Externally_Built,
2657                              Project.Decl.Attributes, Shared);
2658 
2659    begin
2660       if not Externally_Built.Default then
2661          Get_Name_String (Externally_Built.Value);
2662          To_Lower (Name_Buffer (1 .. Name_Len));
2663 
2664          if Name_Buffer (1 .. Name_Len) = "true" then
2665             Project.Externally_Built := True;
2666 
2667          elsif Name_Buffer (1 .. Name_Len) /= "false" then
2668             Error_Msg (Data.Flags,
2669                        "Externally_Built may only be true or false",
2670                        Externally_Built.Location, Project);
2671          end if;
2672       end if;
2673 
2674       --  A virtual project extending an externally built project is itself
2675       --  externally built.
2676 
2677       if Project.Virtual and then Project.Extends /= No_Project then
2678          Project.Externally_Built := Project.Extends.Externally_Built;
2679       end if;
2680 
2681       if Project.Externally_Built then
2682          Debug_Output ("project is externally built");
2683       else
2684          Debug_Output ("project is not externally built");
2685       end if;
2686    end Check_If_Externally_Built;
2687 
2688    ----------------------
2689    -- Check_Interfaces --
2690    ----------------------
2691 
2692    procedure Check_Interfaces
2693      (Project : Project_Id;
2694       Data    : in out Tree_Processing_Data)
2695    is
2696       Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
2697 
2698       Interfaces : constant Prj.Variable_Value :=
2699                      Prj.Util.Value_Of
2700                        (Snames.Name_Interfaces,
2701                         Project.Decl.Attributes,
2702                         Shared);
2703 
2704       Library_Interface : constant Prj.Variable_Value :=
2705                             Prj.Util.Value_Of
2706                               (Snames.Name_Library_Interface,
2707                                Project.Decl.Attributes,
2708                                Shared);
2709 
2710       List       : String_List_Id;
2711       Element    : String_Element;
2712       Name       : File_Name_Type;
2713       Iter       : Source_Iterator;
2714       Source     : Source_Id;
2715       Project_2  : Project_Id;
2716       Other      : Source_Id;
2717       Unit_Found : Boolean;
2718 
2719       Interface_ALIs   : String_List_Id := Nil_String;
2720       Other_Interfaces : String_List_Id := Nil_String;
2721 
2722    begin
2723       if not Interfaces.Default then
2724 
2725          --  Set In_Interfaces to False for all sources. It will be set to True
2726          --  later for the sources in the Interfaces list.
2727 
2728          Project_2 := Project;
2729          while Project_2 /= No_Project loop
2730             Iter := For_Each_Source (Data.Tree, Project_2);
2731             loop
2732                Source := Prj.Element (Iter);
2733                exit when Source = No_Source;
2734                Source.In_Interfaces := False;
2735                Next (Iter);
2736             end loop;
2737 
2738             Project_2 := Project_2.Extends;
2739          end loop;
2740 
2741          List := Interfaces.Values;
2742          while List /= Nil_String loop
2743             Element := Shared.String_Elements.Table (List);
2744             Name := Canonical_Case_File_Name (Element.Value);
2745 
2746             Project_2 := Project;
2747             Big_Loop : while Project_2 /= No_Project loop
2748                if Project.Qualifier = Aggregate_Library then
2749 
2750                   --  For an aggregate library we want to consider sources of
2751                   --  all aggregated projects.
2752 
2753                   Iter := For_Each_Source (Data.Tree);
2754 
2755                else
2756                   Iter := For_Each_Source (Data.Tree, Project_2);
2757                end if;
2758 
2759                loop
2760                   Source := Prj.Element (Iter);
2761                   exit when Source = No_Source;
2762 
2763                   if Source.File = Name then
2764                      if not Source.Locally_Removed then
2765                         Source.In_Interfaces := True;
2766                         Source.Declared_In_Interfaces := True;
2767 
2768                         Other := Other_Part (Source);
2769 
2770                         if Other /= No_Source then
2771                            Other.In_Interfaces := True;
2772                            Other.Declared_In_Interfaces := True;
2773                         end if;
2774 
2775                         --  Unit based case
2776 
2777                         if Source.Language.Config.Kind = Unit_Based then
2778                            if Source.Kind = Spec
2779                              and then Other_Part (Source) /= No_Source
2780                            then
2781                               Source := Other_Part (Source);
2782                            end if;
2783 
2784                            String_Element_Table.Increment_Last
2785                              (Shared.String_Elements);
2786 
2787                            Shared.String_Elements.Table
2788                              (String_Element_Table.Last
2789                                 (Shared.String_Elements)) :=
2790                              (Value         => Name_Id (Source.Dep_Name),
2791                               Index         => 0,
2792                               Display_Value => Name_Id (Source.Dep_Name),
2793                               Location      => No_Location,
2794                               Flag          => False,
2795                               Next          => Interface_ALIs);
2796 
2797                            Interface_ALIs :=
2798                              String_Element_Table.Last
2799                                (Shared.String_Elements);
2800 
2801                         --  File based case
2802 
2803                         else
2804                            String_Element_Table.Increment_Last
2805                              (Shared.String_Elements);
2806 
2807                            Shared.String_Elements.Table
2808                              (String_Element_Table.Last
2809                                 (Shared.String_Elements)) :=
2810                              (Value         => Name_Id (Source.File),
2811                               Index         => 0,
2812                               Display_Value => Name_Id (Source.Display_File),
2813                               Location      => No_Location,
2814                               Flag          => False,
2815                               Next          => Other_Interfaces);
2816 
2817                            Other_Interfaces :=
2818                              String_Element_Table.Last
2819                                (Shared.String_Elements);
2820                         end if;
2821 
2822                         Debug_Output
2823                           ("interface: ", Name_Id (Source.Path.Name));
2824                      end if;
2825 
2826                      exit Big_Loop;
2827                   end if;
2828 
2829                   Next (Iter);
2830                end loop;
2831 
2832                Project_2 := Project_2.Extends;
2833             end loop Big_Loop;
2834 
2835             if Source = No_Source then
2836                Error_Msg_File_1 := File_Name_Type (Element.Value);
2837                Error_Msg_Name_1 := Project.Name;
2838 
2839                Error_Msg
2840                  (Data.Flags,
2841                   "{ cannot be an interface of project %% "
2842                   & "as it is not one of its sources",
2843                   Element.Location, Project);
2844             end if;
2845 
2846             List := Element.Next;
2847          end loop;
2848 
2849          Project.Interfaces_Defined := True;
2850          Project.Lib_Interface_ALIs := Interface_ALIs;
2851          Project.Other_Interfaces   := Other_Interfaces;
2852 
2853       elsif Project.Library and then not Library_Interface.Default then
2854 
2855          --  Set In_Interfaces to False for all sources. It will be set to True
2856          --  later for the sources in the Library_Interface list.
2857 
2858          Project_2 := Project;
2859          while Project_2 /= No_Project loop
2860             Iter := For_Each_Source (Data.Tree, Project_2);
2861             loop
2862                Source := Prj.Element (Iter);
2863                exit when Source = No_Source;
2864                Source.In_Interfaces := False;
2865                Next (Iter);
2866             end loop;
2867 
2868             Project_2 := Project_2.Extends;
2869          end loop;
2870 
2871          List := Library_Interface.Values;
2872          while List /= Nil_String loop
2873             Element := Shared.String_Elements.Table (List);
2874             Get_Name_String (Element.Value);
2875             To_Lower (Name_Buffer (1 .. Name_Len));
2876             Name := Name_Find;
2877             Unit_Found := False;
2878 
2879             Project_2 := Project;
2880             Big_Loop_2 : while Project_2 /= No_Project loop
2881                if Project.Qualifier = Aggregate_Library then
2882 
2883                   --  For an aggregate library we want to consider sources of
2884                   --  all aggregated projects.
2885 
2886                   Iter := For_Each_Source (Data.Tree);
2887 
2888                else
2889                   Iter := For_Each_Source (Data.Tree, Project_2);
2890                end if;
2891 
2892                loop
2893                   Source := Prj.Element (Iter);
2894                   exit when Source = No_Source;
2895 
2896                   if Source.Unit /= No_Unit_Index
2897                     and then Source.Unit.Name = Name_Id (Name)
2898                   then
2899                      if not Source.Locally_Removed then
2900                         Source.In_Interfaces := True;
2901                         Source.Declared_In_Interfaces := True;
2902                         Project.Interfaces_Defined := True;
2903 
2904                         Other := Other_Part (Source);
2905 
2906                         if Other /= No_Source then
2907                            Other.In_Interfaces := True;
2908                            Other.Declared_In_Interfaces := True;
2909                         end if;
2910 
2911                         Debug_Output
2912                           ("interface: ", Name_Id (Source.Path.Name));
2913 
2914                         if Source.Kind = Spec
2915                           and then Other_Part (Source) /= No_Source
2916                         then
2917                            Source := Other_Part (Source);
2918                         end if;
2919 
2920                         String_Element_Table.Increment_Last
2921                           (Shared.String_Elements);
2922 
2923                         Shared.String_Elements.Table
2924                           (String_Element_Table.Last
2925                              (Shared.String_Elements)) :=
2926                           (Value         => Name_Id (Source.Dep_Name),
2927                            Index         => 0,
2928                            Display_Value => Name_Id (Source.Dep_Name),
2929                            Location      => No_Location,
2930                            Flag          => False,
2931                            Next          => Interface_ALIs);
2932 
2933                         Interface_ALIs :=
2934                           String_Element_Table.Last (Shared.String_Elements);
2935                      end if;
2936 
2937                      Unit_Found := True;
2938                      exit Big_Loop_2;
2939                   end if;
2940 
2941                   Next (Iter);
2942                end loop;
2943 
2944                Project_2 := Project_2.Extends;
2945             end loop Big_Loop_2;
2946 
2947             if not Unit_Found then
2948                Error_Msg_Name_1 := Name_Id (Name);
2949 
2950                Error_Msg
2951                  (Data.Flags,
2952                   "%% is not a unit of this project",
2953                   Element.Location, Project);
2954             end if;
2955 
2956             List := Element.Next;
2957          end loop;
2958 
2959          Project.Lib_Interface_ALIs := Interface_ALIs;
2960 
2961       elsif Project.Extends /= No_Project
2962         and then Project.Extends.Interfaces_Defined
2963       then
2964          Project.Interfaces_Defined := True;
2965 
2966          Iter := For_Each_Source (Data.Tree, Project);
2967          loop
2968             Source := Prj.Element (Iter);
2969             exit when Source = No_Source;
2970 
2971             if not Source.Declared_In_Interfaces then
2972                Source.In_Interfaces := False;
2973             end if;
2974 
2975             Next (Iter);
2976          end loop;
2977 
2978          Project.Lib_Interface_ALIs := Project.Extends.Lib_Interface_ALIs;
2979       end if;
2980    end Check_Interfaces;
2981 
2982    ------------------------------
2983    -- Check_Library_Attributes --
2984    ------------------------------
2985 
2986    --  This procedure is awfully long (over 700 lines) should be broken up???
2987 
2988    procedure Check_Library_Attributes
2989      (Project : Project_Id;
2990       Data    : in out Tree_Processing_Data)
2991    is
2992       Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
2993 
2994       Attributes     : constant Prj.Variable_Id := Project.Decl.Attributes;
2995 
2996       Lib_Dir        : constant Prj.Variable_Value :=
2997                          Prj.Util.Value_Of
2998                            (Snames.Name_Library_Dir, Attributes, Shared);
2999 
3000       Lib_Name       : constant Prj.Variable_Value :=
3001                          Prj.Util.Value_Of
3002                            (Snames.Name_Library_Name, Attributes, Shared);
3003 
3004       Lib_Standalone : constant Prj.Variable_Value :=
3005                          Prj.Util.Value_Of
3006                            (Snames.Name_Library_Standalone,
3007                             Attributes, Shared);
3008 
3009       Lib_Version    : constant Prj.Variable_Value :=
3010                          Prj.Util.Value_Of
3011                            (Snames.Name_Library_Version, Attributes, Shared);
3012 
3013       Lib_ALI_Dir    : constant Prj.Variable_Value :=
3014                          Prj.Util.Value_Of
3015                            (Snames.Name_Library_Ali_Dir, Attributes, Shared);
3016 
3017       Lib_GCC        : constant Prj.Variable_Value :=
3018                          Prj.Util.Value_Of
3019                            (Snames.Name_Library_GCC, Attributes, Shared);
3020 
3021       The_Lib_Kind   : constant Prj.Variable_Value :=
3022                          Prj.Util.Value_Of
3023                            (Snames.Name_Library_Kind, Attributes, Shared);
3024 
3025       Imported_Project_List : Project_List;
3026       Continuation          : String_Access := No_Continuation_String'Access;
3027       Support_For_Libraries : Library_Support;
3028 
3029       Library_Directory_Present : Boolean;
3030 
3031       procedure Check_Library (Proj : Project_Id; Extends : Boolean);
3032       --  Check if an imported or extended project if also a library project
3033 
3034       procedure Check_Aggregate_Library_Dirs;
3035       --  Check that the library directory and the library ALI directory of an
3036       --  aggregate library project are not the same as the object directory or
3037       --  the library directory of any of its aggregated projects.
3038 
3039       ----------------------------------
3040       -- Check_Aggregate_Library_Dirs --
3041       ----------------------------------
3042 
3043       procedure Check_Aggregate_Library_Dirs is
3044          procedure Process_Aggregate (Proj : Project_Id);
3045          --  Recursive procedure to check the aggregated projects, as they may
3046          --  also be aggregated library projects.
3047 
3048          -----------------------
3049          -- Process_Aggregate --
3050          -----------------------
3051 
3052          procedure Process_Aggregate (Proj : Project_Id) is
3053             Agg : Aggregated_Project_List;
3054 
3055          begin
3056             Agg := Proj.Aggregated_Projects;
3057             while Agg /= null loop
3058                Error_Msg_Name_1 := Agg.Project.Name;
3059 
3060                if Agg.Project.Qualifier /= Aggregate_Library
3061                  and then Project.Library_ALI_Dir.Name =
3062                                         Agg.Project.Object_Directory.Name
3063                then
3064                   Error_Msg
3065                     (Data.Flags,
3066                      "aggregate library 'A'L'I directory cannot be shared with"
3067                      & " object directory of aggregated project %%",
3068                      The_Lib_Kind.Location, Project);
3069 
3070                elsif Project.Library_ALI_Dir.Name =
3071                                         Agg.Project.Library_Dir.Name
3072                then
3073                   Error_Msg
3074                     (Data.Flags,
3075                      "aggregate library 'A'L'I directory cannot be shared with"
3076                      & " library directory of aggregated project %%",
3077                      The_Lib_Kind.Location, Project);
3078 
3079                elsif Agg.Project.Qualifier /= Aggregate_Library
3080                  and then Project.Library_Dir.Name =
3081                                         Agg.Project.Object_Directory.Name
3082                then
3083                   Error_Msg
3084                     (Data.Flags,
3085                      "aggregate library directory cannot be shared with"
3086                      & " object directory of aggregated project %%",
3087                      The_Lib_Kind.Location, Project);
3088 
3089                elsif Project.Library_Dir.Name =
3090                                         Agg.Project.Library_Dir.Name
3091                then
3092                   Error_Msg
3093                     (Data.Flags,
3094                      "aggregate library directory cannot be shared with"
3095                      & " library directory of aggregated project %%",
3096                      The_Lib_Kind.Location, Project);
3097                end if;
3098 
3099                if Agg.Project.Qualifier = Aggregate_Library then
3100                   Process_Aggregate (Agg.Project);
3101                end if;
3102 
3103                Agg := Agg.Next;
3104             end loop;
3105          end Process_Aggregate;
3106 
3107       --  Start of processing for Check_Aggregate_Library_Dirs
3108 
3109       begin
3110          if Project.Qualifier = Aggregate_Library then
3111             Process_Aggregate (Project);
3112          end if;
3113       end Check_Aggregate_Library_Dirs;
3114 
3115       -------------------
3116       -- Check_Library --
3117       -------------------
3118 
3119       procedure Check_Library (Proj : Project_Id; Extends : Boolean) is
3120          Src_Id : Source_Id;
3121          Iter   : Source_Iterator;
3122 
3123       begin
3124          if Proj /= No_Project then
3125             if not Proj.Library then
3126 
3127                --  The only not library projects that are OK are those that
3128                --  have no sources. However, header files from non-Ada
3129                --  languages are OK, as there is nothing to compile.
3130 
3131                Iter := For_Each_Source (Data.Tree, Proj);
3132                loop
3133                   Src_Id := Prj.Element (Iter);
3134                   exit when Src_Id = No_Source
3135                     or else Src_Id.Language.Config.Kind /= File_Based
3136                     or else Src_Id.Kind /= Spec;
3137                   Next (Iter);
3138                end loop;
3139 
3140                if Src_Id /= No_Source then
3141                   Error_Msg_Name_1 := Project.Name;
3142                   Error_Msg_Name_2 := Proj.Name;
3143 
3144                   if Extends then
3145                      if Project.Library_Kind /= Static then
3146                         Error_Msg
3147                           (Data.Flags,
3148                            Continuation.all &
3149                            "shared library project %% cannot extend " &
3150                            "project %% that is not a library project",
3151                            Project.Location, Project);
3152                         Continuation := Continuation_String'Access;
3153                      end if;
3154 
3155                   elsif not Unchecked_Shared_Lib_Imports
3156                     and then Project.Library_Kind /= Static
3157                   then
3158                      Error_Msg
3159                        (Data.Flags,
3160                         Continuation.all &
3161                         "shared library project %% cannot import project %% " &
3162                         "that is not a shared library project",
3163                         Project.Location, Project);
3164                      Continuation := Continuation_String'Access;
3165                   end if;
3166                end if;
3167 
3168             elsif Project.Library_Kind /= Static
3169               and then not Lib_Standalone.Default
3170               and then Get_Name_String (Lib_Standalone.Value) = "encapsulated"
3171               and then Proj.Library_Kind /= Static
3172             then
3173                --  An encapsulated library must depend only on static libraries
3174 
3175                Error_Msg_Name_1 := Project.Name;
3176                Error_Msg_Name_2 := Proj.Name;
3177 
3178                Error_Msg
3179                  (Data.Flags,
3180                   Continuation.all &
3181                     "encapsulated library project %% cannot import shared " &
3182                     "library project %%",
3183                   Project.Location, Project);
3184                Continuation := Continuation_String'Access;
3185 
3186             elsif Project.Library_Kind /= Static
3187               and then Proj.Library_Kind = Static
3188               and then
3189                 (Lib_Standalone.Default
3190                   or else
3191                     Get_Name_String (Lib_Standalone.Value) /= "encapsulated")
3192             then
3193                Error_Msg_Name_1 := Project.Name;
3194                Error_Msg_Name_2 := Proj.Name;
3195 
3196                if Extends then
3197                   Error_Msg
3198                     (Data.Flags,
3199                      Continuation.all &
3200                      "shared library project %% cannot extend static " &
3201                      "library project %%",
3202                      Project.Location, Project);
3203                   Continuation := Continuation_String'Access;
3204 
3205                elsif not Unchecked_Shared_Lib_Imports then
3206                   Error_Msg
3207                     (Data.Flags,
3208                      Continuation.all &
3209                      "shared library project %% cannot import static " &
3210                      "library project %%",
3211                      Project.Location, Project);
3212                   Continuation := Continuation_String'Access;
3213                end if;
3214 
3215             end if;
3216          end if;
3217       end Check_Library;
3218 
3219       Dir_Exists : Boolean;
3220 
3221    --  Start of processing for Check_Library_Attributes
3222 
3223    begin
3224       Library_Directory_Present := Lib_Dir.Value /= Empty_String;
3225 
3226       --  Special case of extending project
3227 
3228       if Project.Extends /= No_Project then
3229 
3230          --  If the project extended is a library project, we inherit the
3231          --  library name, if it is not redefined; we check that the library
3232          --  directory is specified.
3233 
3234          if Project.Extends.Library then
3235             if Project.Qualifier = Standard then
3236                Error_Msg
3237                  (Data.Flags,
3238                   "a standard project cannot extend a library project",
3239                   Project.Location, Project);
3240 
3241             else
3242                if Lib_Name.Default then
3243                   Project.Library_Name := Project.Extends.Library_Name;
3244                end if;
3245 
3246                if Lib_Dir.Default then
3247                   if not Project.Virtual then
3248                      Error_Msg
3249                        (Data.Flags,
3250                         "a project extending a library project must " &
3251                         "specify an attribute Library_Dir",
3252                         Project.Location, Project);
3253 
3254                   else
3255                      --  For a virtual project extending a library project,
3256                      --  inherit library directory and library kind.
3257 
3258                      Project.Library_Dir := Project.Extends.Library_Dir;
3259                      Library_Directory_Present := True;
3260                      Project.Library_Kind := Project.Extends.Library_Kind;
3261                   end if;
3262                end if;
3263             end if;
3264          end if;
3265       end if;
3266 
3267       pragma Assert (Lib_Name.Kind = Single);
3268 
3269       if Lib_Name.Value = Empty_String then
3270          if Current_Verbosity = High
3271            and then Project.Library_Name = No_Name
3272          then
3273             Debug_Indent;
3274             Write_Line ("no library name");
3275          end if;
3276 
3277       else
3278          --  There is no restriction on the syntax of library names
3279 
3280          Project.Library_Name := Lib_Name.Value;
3281       end if;
3282 
3283       if Project.Library_Name /= No_Name then
3284          if Current_Verbosity = High then
3285             Write_Attr
3286               ("Library name: ", Get_Name_String (Project.Library_Name));
3287          end if;
3288 
3289          pragma Assert (Lib_Dir.Kind = Single);
3290 
3291          if not Library_Directory_Present then
3292             Debug_Output ("no library directory");
3293 
3294          else
3295             --  Find path name (unless inherited), check that it is a directory
3296 
3297             if Project.Library_Dir = No_Path_Information then
3298                Locate_Directory
3299                  (Project,
3300                   File_Name_Type (Lib_Dir.Value),
3301                   Path             => Project.Library_Dir,
3302                   Dir_Exists       => Dir_Exists,
3303                   Data             => Data,
3304                   Create           => "library",
3305                   Must_Exist       => False,
3306                   Location         => Lib_Dir.Location,
3307                   Externally_Built => Project.Externally_Built);
3308 
3309             else
3310                Dir_Exists :=
3311                  Is_Directory
3312                    (Get_Name_String (Project.Library_Dir.Display_Name));
3313             end if;
3314 
3315             if not Dir_Exists then
3316                if Directories_Must_Exist_In_Projects then
3317 
3318                   --  Get the absolute name of the library directory that does
3319                   --  not exist, to report an error.
3320 
3321                   Err_Vars.Error_Msg_File_1 :=
3322                     File_Name_Type (Project.Library_Dir.Display_Name);
3323                   Error_Msg
3324                     (Data.Flags,
3325                      "library directory { does not exist",
3326                      Lib_Dir.Location, Project);
3327                end if;
3328 
3329             --  Checks for object/source directories
3330 
3331             elsif not Project.Externally_Built
3332 
3333               --  An aggregate library does not have sources or objects, so
3334               --  these tests are not required in this case.
3335 
3336               and then Project.Qualifier /= Aggregate_Library
3337             then
3338                --  Library directory cannot be the same as Object directory
3339 
3340                if Project.Library_Dir.Name = Project.Object_Directory.Name then
3341                   Error_Msg
3342                     (Data.Flags,
3343                      "library directory cannot be the same " &
3344                      "as object directory",
3345                      Lib_Dir.Location, Project);
3346                   Project.Library_Dir := No_Path_Information;
3347 
3348                else
3349                   declare
3350                      OK       : Boolean := True;
3351                      Dirs_Id  : String_List_Id;
3352                      Dir_Elem : String_Element;
3353                      Pid      : Project_List;
3354 
3355                   begin
3356                      --  The library directory cannot be the same as a source
3357                      --  directory of the current project.
3358 
3359                      Dirs_Id := Project.Source_Dirs;
3360                      while Dirs_Id /= Nil_String loop
3361                         Dir_Elem := Shared.String_Elements.Table (Dirs_Id);
3362                         Dirs_Id  := Dir_Elem.Next;
3363 
3364                         if Project.Library_Dir.Name =
3365                           Path_Name_Type (Dir_Elem.Value)
3366                         then
3367                            Err_Vars.Error_Msg_File_1 :=
3368                              File_Name_Type (Dir_Elem.Value);
3369                            Error_Msg
3370                              (Data.Flags,
3371                               "library directory cannot be the same "
3372                               & "as source directory {",
3373                               Lib_Dir.Location, Project);
3374                            OK := False;
3375                            exit;
3376                         end if;
3377                      end loop;
3378 
3379                      if OK then
3380 
3381                         --  The library directory cannot be the same as a
3382                         --  source directory of another project either.
3383 
3384                         Pid := Data.Tree.Projects;
3385                         Project_Loop : loop
3386                            exit Project_Loop when Pid = null;
3387 
3388                            if Pid.Project /= Project then
3389                               Dirs_Id := Pid.Project.Source_Dirs;
3390 
3391                               Dir_Loop : while Dirs_Id /= Nil_String loop
3392                                  Dir_Elem :=
3393                                    Shared.String_Elements.Table (Dirs_Id);
3394                                  Dirs_Id  := Dir_Elem.Next;
3395 
3396                                  if Project.Library_Dir.Name =
3397                                    Path_Name_Type (Dir_Elem.Value)
3398                                  then
3399                                     Err_Vars.Error_Msg_File_1 :=
3400                                       File_Name_Type (Dir_Elem.Value);
3401                                     Err_Vars.Error_Msg_Name_1 :=
3402                                       Pid.Project.Name;
3403 
3404                                     Error_Msg
3405                                       (Data.Flags,
3406                                        "library directory cannot be the same "
3407                                        & "as source directory { of project %%",
3408                                        Lib_Dir.Location, Project);
3409                                     OK := False;
3410                                     exit Project_Loop;
3411                                  end if;
3412                               end loop Dir_Loop;
3413                            end if;
3414 
3415                            Pid := Pid.Next;
3416                         end loop Project_Loop;
3417                      end if;
3418 
3419                      if not OK then
3420                         Project.Library_Dir := No_Path_Information;
3421 
3422                      elsif Current_Verbosity = High then
3423 
3424                         --  Display the Library directory in high verbosity
3425 
3426                         Write_Attr
3427                           ("Library directory",
3428                            Get_Name_String (Project.Library_Dir.Display_Name));
3429                      end if;
3430                   end;
3431                end if;
3432             end if;
3433          end if;
3434 
3435       end if;
3436 
3437       Project.Library :=
3438         Project.Library_Dir /= No_Path_Information
3439           and then Project.Library_Name /= No_Name;
3440 
3441       if Project.Extends = No_Project then
3442          case Project.Qualifier is
3443             when Standard =>
3444                if Project.Library then
3445                   Error_Msg
3446                     (Data.Flags,
3447                      "a standard project cannot be a library project",
3448                      Lib_Name.Location, Project);
3449                end if;
3450 
3451             when Library | Aggregate_Library =>
3452                if not Project.Library then
3453                   if Project.Library_Name = No_Name then
3454                      Error_Msg
3455                        (Data.Flags,
3456                         "attribute Library_Name not declared",
3457                         Project.Location, Project);
3458 
3459                      if not Library_Directory_Present then
3460                         Error_Msg
3461                           (Data.Flags,
3462                            "\attribute Library_Dir not declared",
3463                            Project.Location, Project);
3464                      end if;
3465 
3466                   elsif Project.Library_Dir = No_Path_Information then
3467                      Error_Msg
3468                        (Data.Flags,
3469                         "attribute Library_Dir not declared",
3470                         Project.Location, Project);
3471                   end if;
3472                end if;
3473 
3474             when others =>
3475                null;
3476          end case;
3477       end if;
3478 
3479       if Project.Library then
3480          Support_For_Libraries := Project.Config.Lib_Support;
3481 
3482          if not Project.Externally_Built
3483            and then Support_For_Libraries = Prj.None
3484          then
3485             Error_Msg
3486               (Data.Flags,
3487                "?libraries are not supported on this platform",
3488                Lib_Name.Location, Project);
3489             Project.Library := False;
3490 
3491          else
3492             if Lib_ALI_Dir.Value = Empty_String then
3493                Debug_Output ("no library ALI directory specified");
3494                Project.Library_ALI_Dir := Project.Library_Dir;
3495 
3496             else
3497                --  Find path name, check that it is a directory
3498 
3499                Locate_Directory
3500                  (Project,
3501                   File_Name_Type (Lib_ALI_Dir.Value),
3502                   Path             => Project.Library_ALI_Dir,
3503                   Create           => "library ALI",
3504                   Dir_Exists       => Dir_Exists,
3505                   Data             => Data,
3506                   Must_Exist       => False,
3507                   Location         => Lib_ALI_Dir.Location,
3508                   Externally_Built => Project.Externally_Built);
3509 
3510                if not Dir_Exists then
3511 
3512                   --  Get the absolute name of the library ALI directory that
3513                   --  does not exist, to report an error.
3514 
3515                   Err_Vars.Error_Msg_File_1 :=
3516                     File_Name_Type (Project.Library_ALI_Dir.Display_Name);
3517                   Error_Msg
3518                     (Data.Flags,
3519                      "library 'A'L'I directory { does not exist",
3520                      Lib_ALI_Dir.Location, Project);
3521                end if;
3522 
3523                if not Project.Externally_Built
3524                  and then Project.Library_ALI_Dir /= Project.Library_Dir
3525                then
3526                   --  The library ALI directory cannot be the same as the
3527                   --  Object directory.
3528 
3529                   if Project.Library_ALI_Dir = Project.Object_Directory then
3530                      Error_Msg
3531                        (Data.Flags,
3532                         "library 'A'L'I directory cannot be the same " &
3533                         "as object directory",
3534                         Lib_ALI_Dir.Location, Project);
3535                      Project.Library_ALI_Dir := No_Path_Information;
3536 
3537                   else
3538                      declare
3539                         OK       : Boolean := True;
3540                         Dirs_Id  : String_List_Id;
3541                         Dir_Elem : String_Element;
3542                         Pid      : Project_List;
3543 
3544                      begin
3545                         --  The library ALI directory cannot be the same as
3546                         --  a source directory of the current project.
3547 
3548                         Dirs_Id := Project.Source_Dirs;
3549                         while Dirs_Id /= Nil_String loop
3550                            Dir_Elem := Shared.String_Elements.Table (Dirs_Id);
3551                            Dirs_Id  := Dir_Elem.Next;
3552 
3553                            if Project.Library_ALI_Dir.Name =
3554                              Path_Name_Type (Dir_Elem.Value)
3555                            then
3556                               Err_Vars.Error_Msg_File_1 :=
3557                                 File_Name_Type (Dir_Elem.Value);
3558                               Error_Msg
3559                                 (Data.Flags,
3560                                  "library 'A'L'I directory cannot be " &
3561                                  "the same as source directory {",
3562                                  Lib_ALI_Dir.Location, Project);
3563                               OK := False;
3564                               exit;
3565                            end if;
3566                         end loop;
3567 
3568                         if OK then
3569 
3570                            --  The library ALI directory cannot be the same as
3571                            --  a source directory of another project either.
3572 
3573                            Pid := Data.Tree.Projects;
3574                            ALI_Project_Loop : loop
3575                               exit ALI_Project_Loop when Pid = null;
3576 
3577                               if Pid.Project /= Project then
3578                                  Dirs_Id := Pid.Project.Source_Dirs;
3579 
3580                                  ALI_Dir_Loop :
3581                                  while Dirs_Id /= Nil_String loop
3582                                     Dir_Elem :=
3583                                       Shared.String_Elements.Table (Dirs_Id);
3584                                     Dirs_Id  := Dir_Elem.Next;
3585 
3586                                     if Project.Library_ALI_Dir.Name =
3587                                         Path_Name_Type (Dir_Elem.Value)
3588                                     then
3589                                        Err_Vars.Error_Msg_File_1 :=
3590                                          File_Name_Type (Dir_Elem.Value);
3591                                        Err_Vars.Error_Msg_Name_1 :=
3592                                          Pid.Project.Name;
3593 
3594                                        Error_Msg
3595                                          (Data.Flags,
3596                                           "library 'A'L'I directory cannot " &
3597                                           "be the same as source directory " &
3598                                           "{ of project %%",
3599                                           Lib_ALI_Dir.Location, Project);
3600                                        OK := False;
3601                                        exit ALI_Project_Loop;
3602                                     end if;
3603                                  end loop ALI_Dir_Loop;
3604                               end if;
3605                               Pid := Pid.Next;
3606                            end loop ALI_Project_Loop;
3607                         end if;
3608 
3609                         if not OK then
3610                            Project.Library_ALI_Dir := No_Path_Information;
3611 
3612                         elsif Current_Verbosity = High then
3613 
3614                            --  Display Library ALI directory in high verbosity
3615 
3616                            Write_Attr
3617                              ("Library ALI dir",
3618                               Get_Name_String
3619                                 (Project.Library_ALI_Dir.Display_Name));
3620                         end if;
3621                      end;
3622                   end if;
3623                end if;
3624             end if;
3625 
3626             pragma Assert (Lib_Version.Kind = Single);
3627 
3628             if Lib_Version.Value = Empty_String then
3629                Debug_Output ("no library version specified");
3630 
3631             else
3632                Project.Lib_Internal_Name := Lib_Version.Value;
3633             end if;
3634 
3635             pragma Assert (The_Lib_Kind.Kind = Single);
3636 
3637             if The_Lib_Kind.Value = Empty_String then
3638                Debug_Output ("no library kind specified");
3639 
3640             else
3641                Get_Name_String (The_Lib_Kind.Value);
3642 
3643                declare
3644                   Kind_Name : constant String :=
3645                                 To_Lower (Name_Buffer (1 .. Name_Len));
3646 
3647                   OK : Boolean := True;
3648 
3649                begin
3650                   if Kind_Name = "static" then
3651                      Project.Library_Kind := Static;
3652 
3653                   elsif Kind_Name = "dynamic" then
3654                      Project.Library_Kind := Dynamic;
3655 
3656                   elsif Kind_Name = "relocatable" then
3657                      Project.Library_Kind := Relocatable;
3658 
3659                   else
3660                      Error_Msg
3661                        (Data.Flags,
3662                         "illegal value for Library_Kind",
3663                         The_Lib_Kind.Location, Project);
3664                      OK := False;
3665                   end if;
3666 
3667                   if Current_Verbosity = High and then OK then
3668                      Write_Attr ("Library kind", Kind_Name);
3669                   end if;
3670 
3671                   if Project.Library_Kind /= Static then
3672                      if not Project.Externally_Built
3673                        and then Support_For_Libraries = Prj.Static_Only
3674                      then
3675                         Error_Msg
3676                           (Data.Flags,
3677                            "only static libraries are supported " &
3678                            "on this platform",
3679                            The_Lib_Kind.Location, Project);
3680                         Project.Library := False;
3681 
3682                      else
3683                         --  Check if (obsolescent) attribute Library_GCC or
3684                         --  Linker'Driver is declared.
3685 
3686                         if Lib_GCC.Value /= Empty_String then
3687                            Error_Msg
3688                              (Data.Flags,
3689                               "?Library_'G'C'C is an obsolescent attribute, " &
3690                               "use Linker''Driver instead",
3691                               Lib_GCC.Location, Project);
3692                            Project.Config.Shared_Lib_Driver :=
3693                              File_Name_Type (Lib_GCC.Value);
3694 
3695                         else
3696                            declare
3697                               Linker : constant Package_Id :=
3698                                          Value_Of
3699                                            (Name_Linker,
3700                                             Project.Decl.Packages,
3701                                             Shared);
3702                               Driver : constant Variable_Value :=
3703                                          Value_Of
3704                                            (Name                 => No_Name,
3705                                             Attribute_Or_Array_Name =>
3706                                               Name_Driver,
3707                                             In_Package           => Linker,
3708                                             Shared               => Shared);
3709 
3710                            begin
3711                               if Driver /= Nil_Variable_Value
3712                                  and then Driver.Value /= Empty_String
3713                               then
3714                                  Project.Config.Shared_Lib_Driver :=
3715                                    File_Name_Type (Driver.Value);
3716                               end if;
3717                            end;
3718                         end if;
3719                      end if;
3720                   end if;
3721                end;
3722             end if;
3723 
3724             if Project.Library
3725               and then Project.Qualifier /= Aggregate_Library
3726             then
3727                Debug_Output ("this is a library project file");
3728 
3729                Check_Library (Project.Extends, Extends => True);
3730 
3731                Imported_Project_List := Project.Imported_Projects;
3732                while Imported_Project_List /= null loop
3733                   Check_Library
3734                     (Imported_Project_List.Project,
3735                      Extends => False);
3736                   Imported_Project_List := Imported_Project_List.Next;
3737                end loop;
3738             end if;
3739          end if;
3740       end if;
3741 
3742       --  Check if Linker'Switches or Linker'Default_Switches are declared.
3743       --  Warn if they are declared, as it is a common error to think that
3744       --  library are "linked" with Linker switches.
3745 
3746       if Project.Library then
3747          declare
3748             Linker_Package_Id : constant Package_Id :=
3749                                   Util.Value_Of
3750                                     (Name_Linker,
3751                                      Project.Decl.Packages, Shared);
3752             Linker_Package    : Package_Element;
3753             Switches          : Array_Element_Id := No_Array_Element;
3754 
3755          begin
3756             if Linker_Package_Id /= No_Package then
3757                Linker_Package := Shared.Packages.Table (Linker_Package_Id);
3758 
3759                Switches :=
3760                  Value_Of
3761                    (Name      => Name_Switches,
3762                     In_Arrays => Linker_Package.Decl.Arrays,
3763                     Shared    => Shared);
3764 
3765                if Switches = No_Array_Element then
3766                   Switches :=
3767                     Value_Of
3768                       (Name      => Name_Default_Switches,
3769                        In_Arrays => Linker_Package.Decl.Arrays,
3770                        Shared    => Shared);
3771                end if;
3772 
3773                if Switches /= No_Array_Element then
3774                   Error_Msg
3775                     (Data.Flags,
3776                      "?\Linker switches not taken into account in library " &
3777                      "projects",
3778                      No_Location, Project);
3779                end if;
3780             end if;
3781          end;
3782       end if;
3783 
3784       if Project.Extends /= No_Project and then Project.Extends.Library then
3785 
3786          --  Remove the library name from Lib_Data_Table
3787 
3788          for J in 1 .. Lib_Data_Table.Last loop
3789             if Lib_Data_Table.Table (J).Proj = Project.Extends then
3790                Lib_Data_Table.Table (J) :=
3791                  Lib_Data_Table.Table (Lib_Data_Table.Last);
3792                Lib_Data_Table.Set_Last (Lib_Data_Table.Last - 1);
3793                exit;
3794             end if;
3795          end loop;
3796       end if;
3797 
3798       if Project.Library and then not Lib_Name.Default then
3799 
3800          --  Check if the same library name is used in an other library project
3801 
3802          for J in 1 .. Lib_Data_Table.Last loop
3803             if Lib_Data_Table.Table (J).Name = Project.Library_Name
3804               and then Lib_Data_Table.Table (J).Tree = Data.Tree
3805             then
3806                Error_Msg_Name_1 := Lib_Data_Table.Table (J).Proj.Name;
3807                Error_Msg
3808                  (Data.Flags,
3809                   "Library name cannot be the same as in project %%",
3810                   Lib_Name.Location, Project);
3811                Project.Library := False;
3812                exit;
3813             end if;
3814          end loop;
3815       end if;
3816 
3817       if not Lib_Standalone.Default
3818         and then Project.Library_Kind = Static
3819       then
3820          --  An standalone library must be a shared library
3821 
3822          Error_Msg_Name_1 := Project.Name;
3823 
3824          Error_Msg
3825            (Data.Flags,
3826             Continuation.all &
3827               "standalone library project %% must be a shared library",
3828             Project.Location, Project);
3829          Continuation := Continuation_String'Access;
3830       end if;
3831 
3832       --  Check that aggregated libraries do not share the aggregate
3833       --  Library_ALI_Dir.
3834 
3835       if Project.Qualifier = Aggregate_Library then
3836          Check_Aggregate_Library_Dirs;
3837       end if;
3838 
3839       if Project.Library and not Data.In_Aggregate_Lib then
3840 
3841          --  Record the library name
3842 
3843          Lib_Data_Table.Append
3844            ((Name => Project.Library_Name,
3845              Proj => Project,
3846              Tree => Data.Tree));
3847       end if;
3848    end Check_Library_Attributes;
3849 
3850    --------------------------
3851    -- Check_Package_Naming --
3852    --------------------------
3853 
3854    procedure Check_Package_Naming
3855      (Project : Project_Id;
3856       Data    : in out Tree_Processing_Data)
3857    is
3858       Shared    : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
3859       Naming_Id : constant Package_Id :=
3860                     Util.Value_Of
3861                       (Name_Naming, Project.Decl.Packages, Shared);
3862       Naming    : Package_Element;
3863 
3864       Ada_Body_Suffix_Loc : Source_Ptr := No_Location;
3865 
3866       procedure Check_Naming;
3867       --  Check the validity of the Naming package (suffixes valid, ...)
3868 
3869       procedure Check_Common
3870         (Dot_Replacement : in out File_Name_Type;
3871          Casing          : in out Casing_Type;
3872          Casing_Defined  : out Boolean;
3873          Separate_Suffix : in out File_Name_Type;
3874          Sep_Suffix_Loc  : out Source_Ptr);
3875       --  Check attributes common
3876 
3877       procedure Process_Exceptions_File_Based
3878         (Lang_Id : Language_Ptr;
3879          Kind    : Source_Kind);
3880       procedure Process_Exceptions_Unit_Based
3881         (Lang_Id : Language_Ptr;
3882          Kind    : Source_Kind);
3883       --  Process the naming exceptions for the two types of languages
3884 
3885       procedure Initialize_Naming_Data;
3886       --  Initialize internal naming data for the various languages
3887 
3888       ------------------
3889       -- Check_Common --
3890       ------------------
3891 
3892       procedure Check_Common
3893         (Dot_Replacement : in out File_Name_Type;
3894          Casing          : in out Casing_Type;
3895          Casing_Defined  : out Boolean;
3896          Separate_Suffix : in out File_Name_Type;
3897          Sep_Suffix_Loc  : out Source_Ptr)
3898       is
3899          Dot_Repl      : constant Variable_Value :=
3900                            Util.Value_Of
3901                              (Name_Dot_Replacement,
3902                               Naming.Decl.Attributes,
3903                               Shared);
3904          Casing_String : constant Variable_Value :=
3905                            Util.Value_Of
3906                              (Name_Casing,
3907                               Naming.Decl.Attributes,
3908                               Shared);
3909          Sep_Suffix    : constant Variable_Value :=
3910                            Util.Value_Of
3911                              (Name_Separate_Suffix,
3912                               Naming.Decl.Attributes,
3913                               Shared);
3914          Dot_Repl_Loc  : Source_Ptr;
3915 
3916       begin
3917          Sep_Suffix_Loc := No_Location;
3918 
3919          if not Dot_Repl.Default then
3920             pragma Assert
3921               (Dot_Repl.Kind = Single, "Dot_Replacement is not a string");
3922 
3923             if Length_Of_Name (Dot_Repl.Value) = 0 then
3924                Error_Msg
3925                  (Data.Flags, "Dot_Replacement cannot be empty",
3926                   Dot_Repl.Location, Project);
3927             end if;
3928 
3929             Dot_Replacement := Canonical_Case_File_Name (Dot_Repl.Value);
3930             Dot_Repl_Loc    := Dot_Repl.Location;
3931 
3932             declare
3933                Repl : constant String := Get_Name_String (Dot_Replacement);
3934 
3935             begin
3936                --  Dot_Replacement cannot
3937                --   - be empty
3938                --   - start or end with an alphanumeric
3939                --   - be a single '_'
3940                --   - start with an '_' followed by an alphanumeric
3941                --   - contain a '.' except if it is "."
3942 
3943                if Repl'Length = 0
3944                  or else Is_Alphanumeric (Repl (Repl'First))
3945                  or else Is_Alphanumeric (Repl (Repl'Last))
3946                  or else (Repl (Repl'First) = '_'
3947                            and then
3948                              (Repl'Length = 1
3949                                or else
3950                                  Is_Alphanumeric (Repl (Repl'First + 1))))
3951                  or else (Repl'Length > 1
3952                            and then
3953                              Index (Source => Repl, Pattern => ".") /= 0)
3954                then
3955                   Error_Msg
3956                     (Data.Flags,
3957                      '"' & Repl &
3958                      """ is illegal for Dot_Replacement.",
3959                      Dot_Repl_Loc, Project);
3960                end if;
3961             end;
3962          end if;
3963 
3964          if Dot_Replacement /= No_File then
3965             Write_Attr
3966               ("Dot_Replacement", Get_Name_String (Dot_Replacement));
3967          end if;
3968 
3969          Casing_Defined := False;
3970 
3971          if not Casing_String.Default then
3972             pragma Assert
3973               (Casing_String.Kind = Single, "Casing is not a string");
3974 
3975             declare
3976                Casing_Image : constant String :=
3977                                 Get_Name_String (Casing_String.Value);
3978 
3979             begin
3980                if Casing_Image'Length = 0 then
3981                   Error_Msg
3982                     (Data.Flags,
3983                      "Casing cannot be an empty string",
3984                      Casing_String.Location, Project);
3985                end if;
3986 
3987                Casing := Value (Casing_Image);
3988                Casing_Defined := True;
3989 
3990             exception
3991                when Constraint_Error =>
3992                   Name_Len := Casing_Image'Length;
3993                   Name_Buffer (1 .. Name_Len) := Casing_Image;
3994                   Err_Vars.Error_Msg_Name_1 := Name_Find;
3995                   Error_Msg
3996                     (Data.Flags,
3997                      "%% is not a correct Casing",
3998                      Casing_String.Location, Project);
3999             end;
4000          end if;
4001 
4002          Write_Attr ("Casing", Image (Casing));
4003 
4004          if not Sep_Suffix.Default then
4005             if Length_Of_Name (Sep_Suffix.Value) = 0 then
4006                Error_Msg
4007                  (Data.Flags,
4008                   "Separate_Suffix cannot be empty",
4009                   Sep_Suffix.Location, Project);
4010 
4011             else
4012                Separate_Suffix := Canonical_Case_File_Name (Sep_Suffix.Value);
4013                Sep_Suffix_Loc  := Sep_Suffix.Location;
4014 
4015                Check_Illegal_Suffix
4016                  (Project, Separate_Suffix,
4017                   Dot_Replacement, "Separate_Suffix", Sep_Suffix.Location,
4018                   Data);
4019             end if;
4020          end if;
4021 
4022          if Separate_Suffix /= No_File then
4023             Write_Attr
4024               ("Separate_Suffix", Get_Name_String (Separate_Suffix));
4025          end if;
4026       end Check_Common;
4027 
4028       -----------------------------------
4029       -- Process_Exceptions_File_Based --
4030       -----------------------------------
4031 
4032       procedure Process_Exceptions_File_Based
4033         (Lang_Id : Language_Ptr;
4034          Kind    : Source_Kind)
4035       is
4036          Lang           : constant Name_Id := Lang_Id.Name;
4037          Exceptions     : Array_Element_Id;
4038          Exception_List : Variable_Value;
4039          Element_Id     : String_List_Id;
4040          Element        : String_Element;
4041          File_Name      : File_Name_Type;
4042          Source         : Source_Id;
4043 
4044       begin
4045          case Kind is
4046             when Impl | Sep =>
4047                Exceptions :=
4048                  Value_Of
4049                    (Name_Implementation_Exceptions,
4050                     In_Arrays => Naming.Decl.Arrays,
4051                     Shared    => Shared);
4052 
4053             when Spec =>
4054                Exceptions :=
4055                  Value_Of
4056                    (Name_Specification_Exceptions,
4057                     In_Arrays => Naming.Decl.Arrays,
4058                     Shared    => Shared);
4059          end case;
4060 
4061          Exception_List :=
4062            Value_Of
4063              (Index    => Lang,
4064               In_Array => Exceptions,
4065               Shared   => Shared);
4066 
4067          if Exception_List /= Nil_Variable_Value then
4068             Element_Id := Exception_List.Values;
4069             while Element_Id /= Nil_String loop
4070                Element   := Shared.String_Elements.Table (Element_Id);
4071                File_Name := Canonical_Case_File_Name (Element.Value);
4072 
4073                Source :=
4074                  Source_Files_Htable.Get
4075                    (Data.Tree.Source_Files_HT, File_Name);
4076                while Source /= No_Source
4077                  and then Source.Project /= Project
4078                loop
4079                   Source := Source.Next_With_File_Name;
4080                end loop;
4081 
4082                if Source = No_Source then
4083                   Add_Source
4084                     (Id               => Source,
4085                      Data             => Data,
4086                      Project          => Project,
4087                      Source_Dir_Rank  => 0,
4088                      Lang_Id          => Lang_Id,
4089                      Kind             => Kind,
4090                      File_Name        => File_Name,
4091                      Display_File     => File_Name_Type (Element.Value),
4092                      Naming_Exception => Yes,
4093                      Location         => Element.Location);
4094 
4095                else
4096                   --  Check if the file name is already recorded for another
4097                   --  language or another kind.
4098 
4099                   if Source.Language /= Lang_Id then
4100                      Error_Msg
4101                        (Data.Flags,
4102                         "the same file cannot be a source of two languages",
4103                         Element.Location, Project);
4104 
4105                   elsif Source.Kind /= Kind then
4106                      Error_Msg
4107                        (Data.Flags,
4108                         "the same file cannot be a source and a template",
4109                         Element.Location, Project);
4110                   end if;
4111 
4112                   --  If the file is already recorded for the same
4113                   --  language and the same kind, it means that the file
4114                   --  name appears several times in the *_Exceptions
4115                   --  attribute; so there is nothing to do.
4116                end if;
4117 
4118                Element_Id := Element.Next;
4119             end loop;
4120          end if;
4121       end Process_Exceptions_File_Based;
4122 
4123       -----------------------------------
4124       -- Process_Exceptions_Unit_Based --
4125       -----------------------------------
4126 
4127       procedure Process_Exceptions_Unit_Based
4128         (Lang_Id : Language_Ptr;
4129          Kind    : Source_Kind)
4130       is
4131          Exceptions : Array_Element_Id;
4132          Element    : Array_Element;
4133          Unit       : Name_Id;
4134          Index      : Int;
4135          File_Name  : File_Name_Type;
4136          Source     : Source_Id;
4137 
4138          Naming_Exception : Naming_Exception_Type;
4139 
4140       begin
4141          case Kind is
4142             when Impl | Sep =>
4143                Exceptions :=
4144                  Value_Of
4145                    (Name_Body,
4146                     In_Arrays => Naming.Decl.Arrays,
4147                     Shared    => Shared);
4148 
4149                if Exceptions = No_Array_Element then
4150                   Exceptions :=
4151                     Value_Of
4152                       (Name_Implementation,
4153                        In_Arrays => Naming.Decl.Arrays,
4154                        Shared    => Shared);
4155                end if;
4156 
4157             when Spec =>
4158                Exceptions :=
4159                  Value_Of
4160                    (Name_Spec,
4161                     In_Arrays => Naming.Decl.Arrays,
4162                     Shared    => Shared);
4163 
4164                if Exceptions = No_Array_Element then
4165                   Exceptions :=
4166                     Value_Of
4167                       (Name_Specification,
4168                        In_Arrays => Naming.Decl.Arrays,
4169                        Shared    => Shared);
4170                end if;
4171          end case;
4172 
4173          while Exceptions /= No_Array_Element loop
4174             Element   := Shared.Array_Elements.Table (Exceptions);
4175 
4176             if Element.Restricted then
4177                Naming_Exception := Inherited;
4178             else
4179                Naming_Exception := Yes;
4180             end if;
4181 
4182             File_Name := Canonical_Case_File_Name (Element.Value.Value);
4183 
4184             Get_Name_String (Element.Index);
4185             To_Lower (Name_Buffer (1 .. Name_Len));
4186             Index := Element.Value.Index;
4187 
4188             --  Check if it is a valid unit name
4189 
4190             Get_Name_String (Element.Index);
4191             Check_Unit_Name (Name_Buffer (1 .. Name_Len), Unit);
4192 
4193             if Unit = No_Name then
4194                Err_Vars.Error_Msg_Name_1 := Element.Index;
4195                Error_Msg
4196                  (Data.Flags,
4197                   "%% is not a valid unit name.",
4198                   Element.Value.Location, Project);
4199             end if;
4200 
4201             if Unit /= No_Name then
4202                Add_Source
4203                  (Id               => Source,
4204                   Data             => Data,
4205                   Project          => Project,
4206                   Source_Dir_Rank  => 0,
4207                   Lang_Id          => Lang_Id,
4208                   Kind             => Kind,
4209                   File_Name        => File_Name,
4210                   Display_File     => File_Name_Type (Element.Value.Value),
4211                   Unit             => Unit,
4212                   Index            => Index,
4213                   Location         => Element.Value.Location,
4214                   Naming_Exception => Naming_Exception);
4215             end if;
4216 
4217             Exceptions := Element.Next;
4218          end loop;
4219       end Process_Exceptions_Unit_Based;
4220 
4221       ------------------
4222       -- Check_Naming --
4223       ------------------
4224 
4225       procedure Check_Naming is
4226          Dot_Replacement : File_Name_Type :=
4227                              File_Name_Type
4228                                (First_Name_Id + Character'Pos ('-'));
4229          Separate_Suffix : File_Name_Type := No_File;
4230          Casing          : Casing_Type    := All_Lower_Case;
4231          Casing_Defined  : Boolean;
4232          Lang_Id         : Language_Ptr;
4233          Sep_Suffix_Loc  : Source_Ptr;
4234          Suffix          : Variable_Value;
4235          Lang            : Name_Id;
4236 
4237       begin
4238          Check_Common
4239            (Dot_Replacement => Dot_Replacement,
4240             Casing          => Casing,
4241             Casing_Defined  => Casing_Defined,
4242             Separate_Suffix => Separate_Suffix,
4243             Sep_Suffix_Loc  => Sep_Suffix_Loc);
4244 
4245          --  For all unit based languages, if any, set the specified value
4246          --  of Dot_Replacement, Casing and/or Separate_Suffix. Do not
4247          --  systematically overwrite, since the defaults come from the
4248          --  configuration file.
4249 
4250          if Dot_Replacement /= No_File
4251            or else Casing_Defined
4252            or else Separate_Suffix /= No_File
4253          then
4254             Lang_Id := Project.Languages;
4255             while Lang_Id /= No_Language_Index loop
4256                if Lang_Id.Config.Kind = Unit_Based then
4257                   if Dot_Replacement /= No_File then
4258                      Lang_Id.Config.Naming_Data.Dot_Replacement :=
4259                          Dot_Replacement;
4260                   end if;
4261 
4262                   if Casing_Defined then
4263                      Lang_Id.Config.Naming_Data.Casing := Casing;
4264                   end if;
4265                end if;
4266 
4267                Lang_Id := Lang_Id.Next;
4268             end loop;
4269          end if;
4270 
4271          --  Next, get the spec and body suffixes
4272 
4273          Lang_Id := Project.Languages;
4274          while Lang_Id /= No_Language_Index loop
4275             Lang := Lang_Id.Name;
4276 
4277             --  Spec_Suffix
4278 
4279             Suffix := Value_Of
4280               (Name                    => Lang,
4281                Attribute_Or_Array_Name => Name_Spec_Suffix,
4282                In_Package              => Naming_Id,
4283                Shared                  => Shared);
4284 
4285             if Suffix = Nil_Variable_Value then
4286                Suffix := Value_Of
4287                  (Name                    => Lang,
4288                   Attribute_Or_Array_Name => Name_Specification_Suffix,
4289                   In_Package              => Naming_Id,
4290                   Shared                  => Shared);
4291             end if;
4292 
4293             if Suffix /= Nil_Variable_Value
4294               and then Suffix.Value /= No_Name
4295             then
4296                Lang_Id.Config.Naming_Data.Spec_Suffix :=
4297                    File_Name_Type (Suffix.Value);
4298 
4299                Check_Illegal_Suffix
4300                  (Project,
4301                   Lang_Id.Config.Naming_Data.Spec_Suffix,
4302                   Lang_Id.Config.Naming_Data.Dot_Replacement,
4303                   "Spec_Suffix", Suffix.Location, Data);
4304 
4305                Write_Attr
4306                  ("Spec_Suffix",
4307                   Get_Name_String (Lang_Id.Config.Naming_Data.Spec_Suffix));
4308             end if;
4309 
4310             --  Body_Suffix
4311 
4312             Suffix :=
4313               Value_Of
4314                 (Name                    => Lang,
4315                  Attribute_Or_Array_Name => Name_Body_Suffix,
4316                  In_Package              => Naming_Id,
4317                  Shared                  => Shared);
4318 
4319             if Suffix = Nil_Variable_Value then
4320                Suffix :=
4321                  Value_Of
4322                    (Name                    => Lang,
4323                     Attribute_Or_Array_Name => Name_Implementation_Suffix,
4324                     In_Package              => Naming_Id,
4325                     Shared                  => Shared);
4326             end if;
4327 
4328             if Suffix /= Nil_Variable_Value
4329               and then Suffix.Value /= No_Name
4330             then
4331                Lang_Id.Config.Naming_Data.Body_Suffix :=
4332                  File_Name_Type (Suffix.Value);
4333 
4334                --  The default value of separate suffix should be the same as
4335                --  the body suffix, so we need to compute that first.
4336 
4337                if Separate_Suffix = No_File then
4338                   Lang_Id.Config.Naming_Data.Separate_Suffix :=
4339                     Lang_Id.Config.Naming_Data.Body_Suffix;
4340                   Write_Attr
4341                     ("Sep_Suffix",
4342                      Get_Name_String
4343                        (Lang_Id.Config.Naming_Data.Separate_Suffix));
4344                else
4345                   Lang_Id.Config.Naming_Data.Separate_Suffix :=
4346                     Separate_Suffix;
4347                end if;
4348 
4349                Check_Illegal_Suffix
4350                  (Project,
4351                   Lang_Id.Config.Naming_Data.Body_Suffix,
4352                   Lang_Id.Config.Naming_Data.Dot_Replacement,
4353                   "Body_Suffix", Suffix.Location, Data);
4354 
4355                Write_Attr
4356                  ("Body_Suffix",
4357                   Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix));
4358 
4359             elsif Separate_Suffix /= No_File then
4360                Lang_Id.Config.Naming_Data.Separate_Suffix := Separate_Suffix;
4361             end if;
4362 
4363             --  Spec_Suffix cannot be equal to Body_Suffix or Separate_Suffix,
4364             --  since that would cause a clear ambiguity. Note that we do allow
4365             --  a Spec_Suffix to have the same termination as one of these,
4366             --  which causes a potential ambiguity, but we resolve that by
4367             --  matching the longest possible suffix.
4368 
4369             if Lang_Id.Config.Naming_Data.Spec_Suffix /= No_File
4370               and then Lang_Id.Config.Naming_Data.Spec_Suffix =
4371                        Lang_Id.Config.Naming_Data.Body_Suffix
4372             then
4373                Error_Msg
4374                  (Data.Flags,
4375                   "Body_Suffix ("""
4376                   & Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix)
4377                   & """) cannot be the same as Spec_Suffix.",
4378                   Ada_Body_Suffix_Loc, Project);
4379             end if;
4380 
4381             if Lang_Id.Config.Naming_Data.Body_Suffix /=
4382                Lang_Id.Config.Naming_Data.Separate_Suffix
4383               and then Lang_Id.Config.Naming_Data.Spec_Suffix =
4384                        Lang_Id.Config.Naming_Data.Separate_Suffix
4385             then
4386                Error_Msg
4387                  (Data.Flags,
4388                   "Separate_Suffix ("""
4389                   & Get_Name_String
4390                     (Lang_Id.Config.Naming_Data.Separate_Suffix)
4391                   & """) cannot be the same as Spec_Suffix.",
4392                   Sep_Suffix_Loc, Project);
4393             end if;
4394 
4395             Lang_Id := Lang_Id.Next;
4396          end loop;
4397 
4398          --  Get the naming exceptions for all languages, but not for virtual
4399          --  projects.
4400 
4401          if not Project.Virtual then
4402             for Kind in Spec_Or_Body loop
4403                Lang_Id := Project.Languages;
4404                while Lang_Id /= No_Language_Index loop
4405                   case Lang_Id.Config.Kind is
4406                   when File_Based =>
4407                      Process_Exceptions_File_Based (Lang_Id, Kind);
4408 
4409                   when Unit_Based =>
4410                      Process_Exceptions_Unit_Based (Lang_Id, Kind);
4411                   end case;
4412 
4413                   Lang_Id := Lang_Id.Next;
4414                end loop;
4415             end loop;
4416          end if;
4417       end Check_Naming;
4418 
4419       ----------------------------
4420       -- Initialize_Naming_Data --
4421       ----------------------------
4422 
4423       procedure Initialize_Naming_Data is
4424          Specs : Array_Element_Id :=
4425                    Util.Value_Of
4426                      (Name_Spec_Suffix,
4427                       Naming.Decl.Arrays,
4428                       Shared);
4429 
4430          Impls : Array_Element_Id :=
4431                    Util.Value_Of
4432                      (Name_Body_Suffix,
4433                       Naming.Decl.Arrays,
4434                       Shared);
4435 
4436          Lang      : Language_Ptr;
4437          Lang_Name : Name_Id;
4438          Value     : Variable_Value;
4439          Extended  : Project_Id;
4440 
4441       begin
4442          --  At this stage, the project already contains the default extensions
4443          --  for the various languages. We now merge those suffixes read in the
4444          --  user project, and they override the default.
4445 
4446          while Specs /= No_Array_Element loop
4447             Lang_Name := Shared.Array_Elements.Table (Specs).Index;
4448             Lang :=
4449               Get_Language_From_Name
4450                 (Project, Name => Get_Name_String (Lang_Name));
4451 
4452             --  An extending project inherits its parent projects' languages
4453             --  so if needed we should create entries for those languages
4454 
4455             if Lang = null then
4456                Extended := Project.Extends;
4457                while Extended /= null loop
4458                   Lang := Get_Language_From_Name
4459                     (Extended, Name => Get_Name_String (Lang_Name));
4460                   exit when Lang /= null;
4461 
4462                   Extended := Extended.Extends;
4463                end loop;
4464 
4465                if Lang /= null then
4466                   Lang := new Language_Data'(Lang.all);
4467                   Lang.First_Source := null;
4468                   Lang.Next := Project.Languages;
4469                   Project.Languages := Lang;
4470                end if;
4471             end if;
4472 
4473             --  If language was not found in project or the projects it extends
4474 
4475             if Lang = null then
4476                Debug_Output
4477                  ("ignoring spec naming data (lang. not in project): ",
4478                   Lang_Name);
4479 
4480             else
4481                Value := Shared.Array_Elements.Table (Specs).Value;
4482 
4483                if Value.Kind = Single then
4484                   Lang.Config.Naming_Data.Spec_Suffix :=
4485                     Canonical_Case_File_Name (Value.Value);
4486                end if;
4487             end if;
4488 
4489             Specs := Shared.Array_Elements.Table (Specs).Next;
4490          end loop;
4491 
4492          while Impls /= No_Array_Element loop
4493             Lang_Name := Shared.Array_Elements.Table (Impls).Index;
4494             Lang :=
4495               Get_Language_From_Name
4496                 (Project, Name => Get_Name_String (Lang_Name));
4497 
4498             if Lang = null then
4499                Debug_Output
4500                  ("ignoring impl naming data (lang. not in project): ",
4501                   Lang_Name);
4502             else
4503                Value := Shared.Array_Elements.Table (Impls).Value;
4504 
4505                if Lang.Name = Name_Ada then
4506                   Ada_Body_Suffix_Loc := Value.Location;
4507                end if;
4508 
4509                if Value.Kind = Single then
4510                   Lang.Config.Naming_Data.Body_Suffix :=
4511                     Canonical_Case_File_Name (Value.Value);
4512                end if;
4513             end if;
4514 
4515             Impls := Shared.Array_Elements.Table (Impls).Next;
4516          end loop;
4517       end Initialize_Naming_Data;
4518 
4519    --  Start of processing for Check_Naming_Schemes
4520 
4521    begin
4522       --  No Naming package or parsing a configuration file? nothing to do
4523 
4524       if Naming_Id /= No_Package
4525         and then Project.Qualifier /= Configuration
4526       then
4527          Naming := Shared.Packages.Table (Naming_Id);
4528          Debug_Increase_Indent ("checking package Naming for ", Project.Name);
4529          Initialize_Naming_Data;
4530          Check_Naming;
4531          Debug_Decrease_Indent ("done checking package naming");
4532       end if;
4533    end Check_Package_Naming;
4534 
4535    ---------------------------------
4536    -- Check_Programming_Languages --
4537    ---------------------------------
4538 
4539    procedure Check_Programming_Languages
4540      (Project : Project_Id;
4541       Data    : in out Tree_Processing_Data)
4542    is
4543       Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
4544 
4545       Languages   : Variable_Value := Nil_Variable_Value;
4546       Def_Lang    : Variable_Value := Nil_Variable_Value;
4547       Def_Lang_Id : Name_Id;
4548 
4549       procedure Add_Language (Name, Display_Name : Name_Id);
4550       --  Add a new language to the list of languages for the project.
4551       --  Nothing is done if the language has already been defined
4552 
4553       ------------------
4554       -- Add_Language --
4555       ------------------
4556 
4557       procedure Add_Language (Name, Display_Name : Name_Id) is
4558          Lang : Language_Ptr;
4559 
4560       begin
4561          Lang := Project.Languages;
4562          while Lang /= No_Language_Index loop
4563             if Name = Lang.Name then
4564                return;
4565             end if;
4566 
4567             Lang := Lang.Next;
4568          end loop;
4569 
4570          Lang              := new Language_Data'(No_Language_Data);
4571          Lang.Next         := Project.Languages;
4572          Project.Languages := Lang;
4573          Lang.Name         := Name;
4574          Lang.Display_Name := Display_Name;
4575       end Add_Language;
4576 
4577    --  Start of processing for Check_Programming_Languages
4578 
4579    begin
4580       Project.Languages := null;
4581       Languages :=
4582         Prj.Util.Value_Of (Name_Languages, Project.Decl.Attributes, Shared);
4583       Def_Lang :=
4584         Prj.Util.Value_Of
4585           (Name_Default_Language, Project.Decl.Attributes, Shared);
4586 
4587       if Project.Source_Dirs /= Nil_String then
4588 
4589          --  Check if languages are specified in this project
4590 
4591          if Languages.Default then
4592 
4593             --  Fail if there is no default language defined
4594 
4595             if Def_Lang.Default then
4596                Error_Msg
4597                  (Data.Flags,
4598                   "no languages defined for this project",
4599                   Project.Location, Project);
4600                Def_Lang_Id := No_Name;
4601 
4602             else
4603                Get_Name_String (Def_Lang.Value);
4604                To_Lower (Name_Buffer (1 .. Name_Len));
4605                Def_Lang_Id := Name_Find;
4606             end if;
4607 
4608             if Def_Lang_Id /= No_Name then
4609                Get_Name_String (Def_Lang_Id);
4610                Name_Buffer (1) := GNAT.Case_Util.To_Upper (Name_Buffer (1));
4611                Add_Language
4612                  (Name         => Def_Lang_Id,
4613                   Display_Name => Name_Find);
4614             end if;
4615 
4616          else
4617             declare
4618                Current : String_List_Id := Languages.Values;
4619                Element : String_Element;
4620 
4621             begin
4622                --  If there are no languages declared, there are no sources
4623 
4624                if Current = Nil_String then
4625                   Project.Source_Dirs := Nil_String;
4626 
4627                   if Project.Qualifier = Standard then
4628                      Error_Msg
4629                        (Data.Flags,
4630                         "a standard project must have at least one language",
4631                         Languages.Location, Project);
4632                   end if;
4633 
4634                else
4635                   --  Look through all the languages specified in attribute
4636                   --  Languages.
4637 
4638                   while Current /= Nil_String loop
4639                      Element := Shared.String_Elements.Table (Current);
4640                      Get_Name_String (Element.Value);
4641                      To_Lower (Name_Buffer (1 .. Name_Len));
4642 
4643                      Add_Language
4644                        (Name         => Name_Find,
4645                         Display_Name => Element.Value);
4646 
4647                      Current := Element.Next;
4648                   end loop;
4649                end if;
4650             end;
4651          end if;
4652       end if;
4653    end Check_Programming_Languages;
4654 
4655    -------------------------------
4656    -- Check_Stand_Alone_Library --
4657    -------------------------------
4658 
4659    procedure Check_Stand_Alone_Library
4660      (Project : Project_Id;
4661       Data    : in out Tree_Processing_Data)
4662    is
4663       Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
4664 
4665       Lib_Name            : constant Prj.Variable_Value :=
4666                               Prj.Util.Value_Of
4667                                (Snames.Name_Library_Name,
4668                                 Project.Decl.Attributes,
4669                                 Shared);
4670 
4671       Lib_Standalone      : constant Prj.Variable_Value :=
4672                               Prj.Util.Value_Of
4673                                 (Snames.Name_Library_Standalone,
4674                                  Project.Decl.Attributes,
4675                                  Shared);
4676 
4677       Lib_Auto_Init       : constant Prj.Variable_Value :=
4678                               Prj.Util.Value_Of
4679                                 (Snames.Name_Library_Auto_Init,
4680                                  Project.Decl.Attributes,
4681                                  Shared);
4682 
4683       Lib_Src_Dir         : constant Prj.Variable_Value :=
4684                               Prj.Util.Value_Of
4685                                 (Snames.Name_Library_Src_Dir,
4686                                  Project.Decl.Attributes,
4687                                  Shared);
4688 
4689       Lib_Symbol_File     : constant Prj.Variable_Value :=
4690                               Prj.Util.Value_Of
4691                                 (Snames.Name_Library_Symbol_File,
4692                                  Project.Decl.Attributes,
4693                                  Shared);
4694 
4695       Lib_Symbol_Policy   : constant Prj.Variable_Value :=
4696                               Prj.Util.Value_Of
4697                                 (Snames.Name_Library_Symbol_Policy,
4698                                  Project.Decl.Attributes,
4699                                  Shared);
4700 
4701       Lib_Ref_Symbol_File : constant Prj.Variable_Value :=
4702                               Prj.Util.Value_Of
4703                                 (Snames.Name_Library_Reference_Symbol_File,
4704                                  Project.Decl.Attributes,
4705                                  Shared);
4706 
4707       Auto_Init_Supported : Boolean;
4708       OK                  : Boolean := True;
4709 
4710    begin
4711       Auto_Init_Supported := Project.Config.Auto_Init_Supported;
4712 
4713       --  It is a stand-alone library project file if there is at least one
4714       --  unit in the declared or inherited interface.
4715 
4716       if Project.Lib_Interface_ALIs = Nil_String then
4717          if not Lib_Standalone.Default
4718            and then Get_Name_String (Lib_Standalone.Value) /= "no"
4719          then
4720             Error_Msg
4721               (Data.Flags,
4722                "Library_Standalone valid only if library has Ada interfaces",
4723                Lib_Standalone.Location, Project);
4724          end if;
4725 
4726       else
4727          if Project.Standalone_Library = No then
4728             Project.Standalone_Library := Standard;
4729          end if;
4730 
4731          --  The name of a stand-alone library needs to have the syntax of an
4732          --  Ada identifier.
4733 
4734          declare
4735             Name : constant String := Get_Name_String (Project.Library_Name);
4736             OK   : Boolean         := Is_Letter (Name (Name'First));
4737 
4738             Underline : Boolean := False;
4739 
4740          begin
4741             for J in Name'First + 1 .. Name'Last loop
4742                exit when not OK;
4743 
4744                if Is_Alphanumeric (Name (J)) then
4745                   Underline := False;
4746 
4747                elsif Name (J) = '_' then
4748                   if Underline then
4749                      OK := False;
4750                   else
4751                      Underline := True;
4752                   end if;
4753 
4754                else
4755                   OK := False;
4756                end if;
4757             end loop;
4758 
4759             OK := OK and not Underline;
4760 
4761             if not OK then
4762                Error_Msg
4763                  (Data.Flags,
4764                   "Incorrect library name for a Stand-Alone Library",
4765                   Lib_Name.Location, Project);
4766                return;
4767             end if;
4768          end;
4769 
4770          if Lib_Standalone.Default then
4771             Project.Standalone_Library := Standard;
4772 
4773          else
4774             Get_Name_String (Lib_Standalone.Value);
4775             To_Lower (Name_Buffer (1 .. Name_Len));
4776 
4777             if Name_Buffer (1 .. Name_Len) = "standard" then
4778                Project.Standalone_Library := Standard;
4779 
4780             elsif Name_Buffer (1 .. Name_Len) = "encapsulated" then
4781                Project.Standalone_Library := Encapsulated;
4782 
4783             elsif Name_Buffer (1 .. Name_Len) = "no" then
4784                Project.Standalone_Library := No;
4785                Error_Msg
4786                  (Data.Flags,
4787                   "wrong value for Library_Standalone "
4788                   & "when Library_Interface defined",
4789                   Lib_Standalone.Location, Project);
4790 
4791             else
4792                Error_Msg
4793                  (Data.Flags,
4794                   "invalid value for attribute Library_Standalone",
4795                   Lib_Standalone.Location, Project);
4796             end if;
4797          end if;
4798 
4799          --  Check value of attribute Library_Auto_Init and set Lib_Auto_Init
4800          --  accordingly.
4801 
4802          if Lib_Auto_Init.Default then
4803 
4804             --  If no attribute Library_Auto_Init is declared, then set auto
4805             --  init only if it is supported.
4806 
4807             Project.Lib_Auto_Init := Auto_Init_Supported;
4808 
4809          else
4810             Get_Name_String (Lib_Auto_Init.Value);
4811             To_Lower (Name_Buffer (1 .. Name_Len));
4812 
4813             if Name_Buffer (1 .. Name_Len) = "false" then
4814                Project.Lib_Auto_Init := False;
4815 
4816             elsif Name_Buffer (1 .. Name_Len) = "true" then
4817                if Auto_Init_Supported then
4818                   Project.Lib_Auto_Init := True;
4819 
4820                else
4821                   --  Library_Auto_Init cannot be "true" if auto init is not
4822                   --  supported.
4823 
4824                   Error_Msg
4825                     (Data.Flags,
4826                      "library auto init not supported " &
4827                      "on this platform",
4828                      Lib_Auto_Init.Location, Project);
4829                end if;
4830 
4831             else
4832                Error_Msg
4833                  (Data.Flags,
4834                   "invalid value for attribute Library_Auto_Init",
4835                   Lib_Auto_Init.Location, Project);
4836             end if;
4837          end if;
4838 
4839          --  If attribute Library_Src_Dir is defined and not the empty string,
4840          --  check if the directory exist and is not the object directory or
4841          --  one of the source directories. This is the directory where copies
4842          --  of the interface sources will be copied. Note that this directory
4843          --  may be the library directory.
4844 
4845          if Lib_Src_Dir.Value /= Empty_String then
4846             declare
4847                Dir_Id     : constant File_Name_Type :=
4848                               File_Name_Type (Lib_Src_Dir.Value);
4849                Dir_Exists : Boolean;
4850 
4851             begin
4852                Locate_Directory
4853                  (Project,
4854                   Dir_Id,
4855                   Path             => Project.Library_Src_Dir,
4856                   Dir_Exists       => Dir_Exists,
4857                   Data             => Data,
4858                   Must_Exist       => False,
4859                   Create           => "library source copy",
4860                   Location         => Lib_Src_Dir.Location,
4861                   Externally_Built => Project.Externally_Built);
4862 
4863                --  If directory does not exist, report an error
4864 
4865                if not Dir_Exists then
4866 
4867                   --  Get the absolute name of the library directory that does
4868                   --  not exist, to report an error.
4869 
4870                   Err_Vars.Error_Msg_File_1 :=
4871                     File_Name_Type (Project.Library_Src_Dir.Display_Name);
4872                   Error_Msg
4873                     (Data.Flags,
4874                      "Directory { does not exist",
4875                      Lib_Src_Dir.Location, Project);
4876 
4877                   --  Report error if it is the same as the object directory
4878 
4879                elsif Project.Library_Src_Dir = Project.Object_Directory then
4880                   Error_Msg
4881                     (Data.Flags,
4882                      "directory to copy interfaces cannot be " &
4883                      "the object directory",
4884                      Lib_Src_Dir.Location, Project);
4885                   Project.Library_Src_Dir := No_Path_Information;
4886 
4887                else
4888                   declare
4889                      Src_Dirs : String_List_Id;
4890                      Src_Dir  : String_Element;
4891                      Pid      : Project_List;
4892 
4893                   begin
4894                      --  Interface copy directory cannot be one of the source
4895                      --  directory of the current project.
4896 
4897                      Src_Dirs := Project.Source_Dirs;
4898                      while Src_Dirs /= Nil_String loop
4899                         Src_Dir := Shared.String_Elements.Table (Src_Dirs);
4900 
4901                         --  Report error if it is one of the source directories
4902 
4903                         if Project.Library_Src_Dir.Name =
4904                              Path_Name_Type (Src_Dir.Value)
4905                         then
4906                            Error_Msg
4907                              (Data.Flags,
4908                               "directory to copy interfaces cannot " &
4909                               "be one of the source directories",
4910                               Lib_Src_Dir.Location, Project);
4911                            Project.Library_Src_Dir := No_Path_Information;
4912                            exit;
4913                         end if;
4914 
4915                         Src_Dirs := Src_Dir.Next;
4916                      end loop;
4917 
4918                      if Project.Library_Src_Dir /= No_Path_Information then
4919 
4920                         --  It cannot be a source directory of any other
4921                         --  project either.
4922 
4923                         Pid := Data.Tree.Projects;
4924                         Project_Loop : loop
4925                            exit Project_Loop when Pid = null;
4926 
4927                            Src_Dirs := Pid.Project.Source_Dirs;
4928                            Dir_Loop : while Src_Dirs /= Nil_String loop
4929                               Src_Dir :=
4930                                 Shared.String_Elements.Table (Src_Dirs);
4931 
4932                               --  Report error if it is one of the source
4933                               --  directories.
4934 
4935                               if Project.Library_Src_Dir.Name =
4936                                 Path_Name_Type (Src_Dir.Value)
4937                               then
4938                                  Error_Msg_File_1 :=
4939                                    File_Name_Type (Src_Dir.Value);
4940                                  Error_Msg_Name_1 := Pid.Project.Name;
4941                                  Error_Msg
4942                                    (Data.Flags,
4943                                     "directory to copy interfaces cannot " &
4944                                     "be the same as source directory { of " &
4945                                     "project %%",
4946                                     Lib_Src_Dir.Location, Project);
4947                                  Project.Library_Src_Dir :=
4948                                    No_Path_Information;
4949                                  exit Project_Loop;
4950                               end if;
4951 
4952                               Src_Dirs := Src_Dir.Next;
4953                            end loop Dir_Loop;
4954 
4955                            Pid := Pid.Next;
4956                         end loop Project_Loop;
4957                      end if;
4958                   end;
4959 
4960                   --  In high verbosity, if there is a valid Library_Src_Dir,
4961                   --  display its path name.
4962 
4963                   if Project.Library_Src_Dir /= No_Path_Information
4964                     and then Current_Verbosity = High
4965                   then
4966                      Write_Attr
4967                        ("Directory to copy interfaces",
4968                         Get_Name_String (Project.Library_Src_Dir.Name));
4969                   end if;
4970                end if;
4971             end;
4972          end if;
4973 
4974          --  Check the symbol related attributes
4975 
4976          --  First, the symbol policy
4977 
4978          if not Lib_Symbol_Policy.Default then
4979             declare
4980                Value : constant String :=
4981                          To_Lower
4982                            (Get_Name_String (Lib_Symbol_Policy.Value));
4983 
4984             begin
4985                --  Symbol policy must have one of a limited number of values
4986 
4987                if Value = "autonomous" or else Value = "default" then
4988                   Project.Symbol_Data.Symbol_Policy := Autonomous;
4989 
4990                elsif Value = "compliant" then
4991                   Project.Symbol_Data.Symbol_Policy := Compliant;
4992 
4993                elsif Value = "controlled" then
4994                   Project.Symbol_Data.Symbol_Policy := Controlled;
4995 
4996                elsif Value = "restricted" then
4997                   Project.Symbol_Data.Symbol_Policy := Restricted;
4998 
4999                elsif Value = "direct" then
5000                   Project.Symbol_Data.Symbol_Policy := Direct;
5001 
5002                else
5003                   Error_Msg
5004                     (Data.Flags,
5005                      "illegal value for Library_Symbol_Policy",
5006                      Lib_Symbol_Policy.Location, Project);
5007                end if;
5008             end;
5009          end if;
5010 
5011          --  If attribute Library_Symbol_File is not specified, symbol policy
5012          --  cannot be Restricted.
5013 
5014          if Lib_Symbol_File.Default then
5015             if Project.Symbol_Data.Symbol_Policy = Restricted then
5016                Error_Msg
5017                  (Data.Flags,
5018                   "Library_Symbol_File needs to be defined when " &
5019                   "symbol policy is Restricted",
5020                   Lib_Symbol_Policy.Location, Project);
5021             end if;
5022 
5023          else
5024             --  Library_Symbol_File is defined
5025 
5026             Project.Symbol_Data.Symbol_File :=
5027               Path_Name_Type (Lib_Symbol_File.Value);
5028 
5029             Get_Name_String (Lib_Symbol_File.Value);
5030 
5031             if Name_Len = 0 then
5032                Error_Msg
5033                  (Data.Flags,
5034                   "symbol file name cannot be an empty string",
5035                   Lib_Symbol_File.Location, Project);
5036 
5037             else
5038                OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len));
5039 
5040                if OK then
5041                   for J in 1 .. Name_Len loop
5042                      if Is_Directory_Separator (Name_Buffer (J)) then
5043                         OK := False;
5044                         exit;
5045                      end if;
5046                   end loop;
5047                end if;
5048 
5049                if not OK then
5050                   Error_Msg_File_1 := File_Name_Type (Lib_Symbol_File.Value);
5051                   Error_Msg
5052                     (Data.Flags,
5053                      "symbol file name { is illegal. " &
5054                      "Name cannot include directory info.",
5055                      Lib_Symbol_File.Location, Project);
5056                end if;
5057             end if;
5058          end if;
5059 
5060          --  If attribute Library_Reference_Symbol_File is not defined,
5061          --  symbol policy cannot be Compliant or Controlled.
5062 
5063          if Lib_Ref_Symbol_File.Default then
5064             if Project.Symbol_Data.Symbol_Policy = Compliant
5065               or else Project.Symbol_Data.Symbol_Policy = Controlled
5066             then
5067                Error_Msg
5068                  (Data.Flags,
5069                   "a reference symbol file needs to be defined",
5070                   Lib_Symbol_Policy.Location, Project);
5071             end if;
5072 
5073          else
5074             --  Library_Reference_Symbol_File is defined, check file exists
5075 
5076             Project.Symbol_Data.Reference :=
5077               Path_Name_Type (Lib_Ref_Symbol_File.Value);
5078 
5079             Get_Name_String (Lib_Ref_Symbol_File.Value);
5080 
5081             if Name_Len = 0 then
5082                Error_Msg
5083                  (Data.Flags,
5084                   "reference symbol file name cannot be an empty string",
5085                   Lib_Symbol_File.Location, Project);
5086 
5087             else
5088                if not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)) then
5089                   Name_Len := 0;
5090                   Add_Str_To_Name_Buffer
5091                     (Get_Name_String (Project.Directory.Name));
5092                   Add_Str_To_Name_Buffer
5093                     (Get_Name_String (Lib_Ref_Symbol_File.Value));
5094                   Project.Symbol_Data.Reference := Name_Find;
5095                end if;
5096 
5097                if not Is_Regular_File
5098                         (Get_Name_String (Project.Symbol_Data.Reference))
5099                then
5100                   Error_Msg_File_1 :=
5101                     File_Name_Type (Lib_Ref_Symbol_File.Value);
5102 
5103                   --  For controlled and direct symbol policies, it is an error
5104                   --  if the reference symbol file does not exist. For other
5105                   --  symbol policies, this is just a warning
5106 
5107                   Error_Msg_Warn :=
5108                     Project.Symbol_Data.Symbol_Policy /= Controlled
5109                       and then Project.Symbol_Data.Symbol_Policy /= Direct;
5110 
5111                   Error_Msg
5112                     (Data.Flags,
5113                      "<library reference symbol file { does not exist",
5114                      Lib_Ref_Symbol_File.Location, Project);
5115 
5116                   --  In addition in the non-controlled case, if symbol policy
5117                   --  is Compliant, it is changed to Autonomous, because there
5118                   --  is no reference to check against, and we don't want to
5119                   --  fail in this case.
5120 
5121                   if Project.Symbol_Data.Symbol_Policy /= Controlled then
5122                      if Project.Symbol_Data.Symbol_Policy = Compliant then
5123                         Project.Symbol_Data.Symbol_Policy := Autonomous;
5124                      end if;
5125                   end if;
5126                end if;
5127 
5128                --  If both the reference symbol file and the symbol file are
5129                --  defined, then check that they are not the same file.
5130 
5131                if Project.Symbol_Data.Symbol_File /= No_Path then
5132                   Get_Name_String (Project.Symbol_Data.Symbol_File);
5133 
5134                   if Name_Len > 0 then
5135                      declare
5136                         --  We do not need to pass a Directory to
5137                         --  Normalize_Pathname, since the path_information
5138                         --  already contains absolute information.
5139 
5140                         Symb_Path : constant String :=
5141                                       Normalize_Pathname
5142                                         (Get_Name_String
5143                                            (Project.Object_Directory.Name) &
5144                                          Name_Buffer (1 .. Name_Len),
5145                                          Directory     => "/",
5146                                          Resolve_Links =>
5147                                            Opt.Follow_Links_For_Files);
5148                         Ref_Path  : constant String :=
5149                                       Normalize_Pathname
5150                                         (Get_Name_String
5151                                            (Project.Symbol_Data.Reference),
5152                                          Directory     => "/",
5153                                          Resolve_Links =>
5154                                            Opt.Follow_Links_For_Files);
5155                      begin
5156                         if Symb_Path = Ref_Path then
5157                            Error_Msg
5158                              (Data.Flags,
5159                               "library reference symbol file and library" &
5160                               " symbol file cannot be the same file",
5161                               Lib_Ref_Symbol_File.Location, Project);
5162                         end if;
5163                      end;
5164                   end if;
5165                end if;
5166             end if;
5167          end if;
5168       end if;
5169    end Check_Stand_Alone_Library;
5170 
5171    ---------------------
5172    -- Check_Unit_Name --
5173    ---------------------
5174 
5175    procedure Check_Unit_Name (Name : String; Unit : out Name_Id) is
5176       The_Name        : String := Name;
5177       Real_Name       : Name_Id;
5178       Need_Letter     : Boolean := True;
5179       Last_Underscore : Boolean := False;
5180       OK              : Boolean := The_Name'Length > 0;
5181       First           : Positive;
5182 
5183       function Is_Reserved (Name : Name_Id) return Boolean;
5184       function Is_Reserved (S    : String)  return Boolean;
5185       --  Check that the given name is not an Ada 95 reserved word. The reason
5186       --  for the Ada 95 here is that we do not want to exclude the case of an
5187       --  Ada 95 unit called Interface (for example). In Ada 2005, such a unit
5188       --  name would be rejected anyway by the compiler. That means there is no
5189       --  requirement that the project file parser reject this.
5190 
5191       -----------------
5192       -- Is_Reserved --
5193       -----------------
5194 
5195       function Is_Reserved (S : String) return Boolean is
5196       begin
5197          Name_Len := 0;
5198          Add_Str_To_Name_Buffer (S);
5199          return Is_Reserved (Name_Find);
5200       end Is_Reserved;
5201 
5202       -----------------
5203       -- Is_Reserved --
5204       -----------------
5205 
5206       function Is_Reserved (Name : Name_Id) return Boolean is
5207       begin
5208          if Get_Name_Table_Byte (Name) /= 0
5209            and then
5210              not Nam_In (Name, Name_Project, Name_Extends, Name_External)
5211            and then Name not in Ada_2005_Reserved_Words
5212          then
5213             Unit := No_Name;
5214             Debug_Output ("Ada reserved word: ", Name);
5215             return True;
5216 
5217          else
5218             return False;
5219          end if;
5220       end Is_Reserved;
5221 
5222    --  Start of processing for Check_Unit_Name
5223 
5224    begin
5225       To_Lower (The_Name);
5226 
5227       Name_Len := The_Name'Length;
5228       Name_Buffer (1 .. Name_Len) := The_Name;
5229 
5230       Real_Name := Name_Find;
5231 
5232       if Is_Reserved (Real_Name) then
5233          return;
5234       end if;
5235 
5236       First := The_Name'First;
5237 
5238       for Index in The_Name'Range loop
5239          if Need_Letter then
5240 
5241             --  We need a letter (at the beginning, and following a dot),
5242             --  but we don't have one.
5243 
5244             if Is_Letter (The_Name (Index)) then
5245                Need_Letter := False;
5246 
5247             else
5248                OK := False;
5249 
5250                if Current_Verbosity = High then
5251                   Debug_Indent;
5252                   Write_Int  (Types.Int (Index));
5253                   Write_Str  (": '");
5254                   Write_Char (The_Name (Index));
5255                   Write_Line ("' is not a letter.");
5256                end if;
5257 
5258                exit;
5259             end if;
5260 
5261          elsif Last_Underscore
5262            and then (The_Name (Index) = '_' or else The_Name (Index) = '.')
5263          then
5264             --  Two underscores are illegal, and a dot cannot follow
5265             --  an underscore.
5266 
5267             OK := False;
5268 
5269             if Current_Verbosity = High then
5270                Debug_Indent;
5271                Write_Int  (Types.Int (Index));
5272                Write_Str  (": '");
5273                Write_Char (The_Name (Index));
5274                Write_Line ("' is illegal here.");
5275             end if;
5276 
5277             exit;
5278 
5279          elsif The_Name (Index) = '.' then
5280 
5281             --  First, check if the name before the dot is not a reserved word
5282 
5283             if Is_Reserved (The_Name (First .. Index - 1)) then
5284                return;
5285             end if;
5286 
5287             First := Index + 1;
5288 
5289             --  We need a letter after a dot
5290 
5291             Need_Letter := True;
5292 
5293          elsif The_Name (Index) = '_' then
5294             Last_Underscore := True;
5295 
5296          else
5297             --  We need an letter or a digit
5298 
5299             Last_Underscore := False;
5300 
5301             if not Is_Alphanumeric (The_Name (Index)) then
5302                OK := False;
5303 
5304                if Current_Verbosity = High then
5305                   Debug_Indent;
5306                   Write_Int  (Types.Int (Index));
5307                   Write_Str  (": '");
5308                   Write_Char (The_Name (Index));
5309                   Write_Line ("' is not alphanumeric.");
5310                end if;
5311 
5312                exit;
5313             end if;
5314          end if;
5315       end loop;
5316 
5317       --  Cannot end with an underscore or a dot
5318 
5319       OK := OK and then not Need_Letter and then not Last_Underscore;
5320 
5321       if OK then
5322          if First /= Name'First
5323            and then Is_Reserved (The_Name (First .. The_Name'Last))
5324          then
5325             return;
5326          end if;
5327 
5328          Unit := Real_Name;
5329 
5330       else
5331          --  Signal a problem with No_Name
5332 
5333          Unit := No_Name;
5334       end if;
5335    end Check_Unit_Name;
5336 
5337    ----------------------------
5338    -- Compute_Directory_Last --
5339    ----------------------------
5340 
5341    function Compute_Directory_Last (Dir : String) return Natural is
5342    begin
5343       if Dir'Length > 1
5344         and then Is_Directory_Separator (Dir (Dir'Last - 1))
5345       then
5346          return Dir'Last - 1;
5347       else
5348          return Dir'Last;
5349       end if;
5350    end Compute_Directory_Last;
5351 
5352    ---------------------
5353    -- Get_Directories --
5354    ---------------------
5355 
5356    procedure Get_Directories
5357      (Project : Project_Id;
5358       Data    : in out Tree_Processing_Data)
5359    is
5360       Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
5361 
5362       Object_Dir  : constant Variable_Value :=
5363                       Util.Value_Of
5364                         (Name_Object_Dir, Project.Decl.Attributes, Shared);
5365 
5366       Exec_Dir : constant Variable_Value :=
5367                    Util.Value_Of
5368                      (Name_Exec_Dir, Project.Decl.Attributes, Shared);
5369 
5370       Source_Dirs : constant Variable_Value :=
5371                       Util.Value_Of
5372                         (Name_Source_Dirs, Project.Decl.Attributes, Shared);
5373 
5374       Ignore_Source_Sub_Dirs : constant Variable_Value :=
5375                                  Util.Value_Of
5376                                    (Name_Ignore_Source_Sub_Dirs,
5377                                     Project.Decl.Attributes,
5378                                     Shared);
5379 
5380       Excluded_Source_Dirs : constant Variable_Value :=
5381                               Util.Value_Of
5382                                 (Name_Excluded_Source_Dirs,
5383                                  Project.Decl.Attributes,
5384                                  Shared);
5385 
5386       Source_Files : constant Variable_Value :=
5387                       Util.Value_Of
5388                         (Name_Source_Files,
5389                          Project.Decl.Attributes, Shared);
5390 
5391       Last_Source_Dir   : String_List_Id    := Nil_String;
5392       Last_Src_Dir_Rank : Number_List_Index := No_Number_List;
5393 
5394       Languages : constant Variable_Value :=
5395                       Prj.Util.Value_Of
5396                         (Name_Languages, Project.Decl.Attributes, Shared);
5397 
5398       Remove_Source_Dirs : Boolean := False;
5399 
5400       procedure Add_To_Or_Remove_From_Source_Dirs
5401         (Path : Path_Information;
5402          Rank : Natural);
5403       --  When Removed = False, the directory Path_Id to the list of
5404       --  source_dirs if not already in the list. When Removed = True,
5405       --  removed directory Path_Id if in the list.
5406 
5407       procedure Find_Source_Dirs is new Expand_Subdirectory_Pattern
5408         (Add_To_Or_Remove_From_Source_Dirs);
5409 
5410       ---------------------------------------
5411       -- Add_To_Or_Remove_From_Source_Dirs --
5412       ---------------------------------------
5413 
5414       procedure Add_To_Or_Remove_From_Source_Dirs
5415         (Path : Path_Information;
5416          Rank : Natural)
5417       is
5418          List      : String_List_Id;
5419          Prev      : String_List_Id;
5420          Rank_List : Number_List_Index;
5421          Prev_Rank : Number_List_Index;
5422          Element   : String_Element;
5423 
5424       begin
5425          Prev      := Nil_String;
5426          Prev_Rank := No_Number_List;
5427          List      := Project.Source_Dirs;
5428          Rank_List := Project.Source_Dir_Ranks;
5429          while List /= Nil_String loop
5430             Element := Shared.String_Elements.Table (List);
5431             exit when Element.Value = Name_Id (Path.Name);
5432             Prev := List;
5433             List := Element.Next;
5434             Prev_Rank := Rank_List;
5435             Rank_List := Shared.Number_Lists.Table (Prev_Rank).Next;
5436          end loop;
5437 
5438          --  The directory is in the list if List is not Nil_String
5439 
5440          if not Remove_Source_Dirs and then List = Nil_String then
5441             Debug_Output ("adding source dir=", Name_Id (Path.Display_Name));
5442 
5443             String_Element_Table.Increment_Last (Shared.String_Elements);
5444             Element :=
5445               (Value         => Name_Id (Path.Name),
5446                Index         => 0,
5447                Display_Value => Name_Id (Path.Display_Name),
5448                Location      => No_Location,
5449                Flag          => False,
5450                Next          => Nil_String);
5451 
5452             Number_List_Table.Increment_Last (Shared.Number_Lists);
5453 
5454             if Last_Source_Dir = Nil_String then
5455 
5456                --  This is the first source directory
5457 
5458                Project.Source_Dirs :=
5459                  String_Element_Table.Last (Shared.String_Elements);
5460                Project.Source_Dir_Ranks :=
5461                  Number_List_Table.Last (Shared.Number_Lists);
5462 
5463             else
5464                --  We already have source directories, link the previous
5465                --  last to the new one.
5466 
5467                Shared.String_Elements.Table (Last_Source_Dir).Next :=
5468                  String_Element_Table.Last (Shared.String_Elements);
5469                Shared.Number_Lists.Table (Last_Src_Dir_Rank).Next :=
5470                  Number_List_Table.Last (Shared.Number_Lists);
5471             end if;
5472 
5473             --  And register this source directory as the new last
5474 
5475             Last_Source_Dir :=
5476               String_Element_Table.Last (Shared.String_Elements);
5477             Shared.String_Elements.Table (Last_Source_Dir) := Element;
5478             Last_Src_Dir_Rank := Number_List_Table.Last (Shared.Number_Lists);
5479             Shared.Number_Lists.Table (Last_Src_Dir_Rank) :=
5480               (Number => Rank, Next => No_Number_List);
5481 
5482          elsif Remove_Source_Dirs and then List /= Nil_String then
5483 
5484             --  Remove source dir if present
5485 
5486             if Prev = Nil_String then
5487                Project.Source_Dirs := Shared.String_Elements.Table (List).Next;
5488                Project.Source_Dir_Ranks :=
5489                  Shared.Number_Lists.Table (Rank_List).Next;
5490 
5491             else
5492                Shared.String_Elements.Table (Prev).Next :=
5493                  Shared.String_Elements.Table (List).Next;
5494                Shared.Number_Lists.Table (Prev_Rank).Next :=
5495                  Shared.Number_Lists.Table (Rank_List).Next;
5496             end if;
5497          end if;
5498       end Add_To_Or_Remove_From_Source_Dirs;
5499 
5500       --  Local declarations
5501 
5502       Dir_Exists : Boolean;
5503 
5504       No_Sources : constant Boolean :=
5505         Project.Qualifier = Abstract_Project
5506           or else (((not Source_Files.Default
5507                       and then Source_Files.Values = Nil_String)
5508                     or else
5509                     (not Source_Dirs.Default
5510                       and then Source_Dirs.Values  = Nil_String)
5511                     or else
5512                      (not Languages.Default
5513                       and then Languages.Values    = Nil_String))
5514                    and then Project.Extends = No_Project);
5515 
5516    --  Start of processing for Get_Directories
5517 
5518    begin
5519       Debug_Output ("starting to look for directories");
5520 
5521       --  Set the object directory to its default which may be nil, if there
5522       --  is no sources in the project.
5523 
5524       if No_Sources then
5525          Project.Object_Directory := No_Path_Information;
5526       else
5527          Project.Object_Directory := Project.Directory;
5528       end if;
5529 
5530       --  Check the object directory
5531 
5532       if Object_Dir.Value /= Empty_String then
5533          Get_Name_String (Object_Dir.Value);
5534 
5535          if Name_Len = 0 then
5536             Error_Msg
5537               (Data.Flags,
5538                "Object_Dir cannot be empty",
5539                Object_Dir.Location, Project);
5540 
5541          elsif Setup_Projects
5542            and then No_Sources
5543            and then Project.Extends = No_Project
5544          then
5545             --  Do not create an object directory for a non extending project
5546             --  with no sources.
5547 
5548             Locate_Directory
5549               (Project,
5550                File_Name_Type (Object_Dir.Value),
5551                Path             => Project.Object_Directory,
5552                Dir_Exists       => Dir_Exists,
5553                Data             => Data,
5554                Location         => Object_Dir.Location,
5555                Must_Exist       => False,
5556                Externally_Built => Project.Externally_Built);
5557 
5558          else
5559             --  We check that the specified object directory does exist.
5560             --  However, even when it doesn't exist, we set it to a default
5561             --  value. This is for the benefit of tools that recover from
5562             --  errors; for example, these tools could create the non existent
5563             --  directory. We always return an absolute directory name though.
5564 
5565             Locate_Directory
5566               (Project,
5567                File_Name_Type (Object_Dir.Value),
5568                Path             => Project.Object_Directory,
5569                Create           => "object",
5570                Dir_Exists       => Dir_Exists,
5571                Data             => Data,
5572                Location         => Object_Dir.Location,
5573                Must_Exist       => False,
5574                Externally_Built => Project.Externally_Built);
5575 
5576             if not Dir_Exists and then not Project.Externally_Built then
5577                if Opt.Directories_Must_Exist_In_Projects then
5578 
5579                   --  The object directory does not exist, report an error if
5580                   --  the project is not externally built.
5581 
5582                   Err_Vars.Error_Msg_File_1 :=
5583                     File_Name_Type (Object_Dir.Value);
5584                   Error_Or_Warning
5585                     (Data.Flags, Data.Flags.Require_Obj_Dirs,
5586                      "object directory { not found",
5587                      Project.Location, Project);
5588                end if;
5589             end if;
5590          end if;
5591 
5592       elsif not No_Sources
5593         and then (Subdirs /= null or else Build_Tree_Dir /= null)
5594       then
5595          Name_Len := 1;
5596          Name_Buffer (1) := '.';
5597          Locate_Directory
5598            (Project,
5599             Name_Find,
5600             Path             => Project.Object_Directory,
5601             Create           => "object",
5602             Dir_Exists       => Dir_Exists,
5603             Data             => Data,
5604             Location         => Object_Dir.Location,
5605             Externally_Built => Project.Externally_Built);
5606       end if;
5607 
5608       if Current_Verbosity = High then
5609          if Project.Object_Directory = No_Path_Information then
5610             Debug_Output ("no object directory");
5611          else
5612             Write_Attr
5613               ("Object directory",
5614                Get_Name_String (Project.Object_Directory.Display_Name));
5615          end if;
5616       end if;
5617 
5618       --  Check the exec directory
5619 
5620       --  We set the object directory to its default
5621 
5622       Project.Exec_Directory := Project.Object_Directory;
5623 
5624       if Exec_Dir.Value /= Empty_String then
5625          Get_Name_String (Exec_Dir.Value);
5626 
5627          if Name_Len = 0 then
5628             Error_Msg
5629               (Data.Flags,
5630                "Exec_Dir cannot be empty",
5631                Exec_Dir.Location, Project);
5632 
5633          elsif Setup_Projects
5634            and then No_Sources
5635            and then Project.Extends = No_Project
5636          then
5637             --  Do not create an exec directory for a non extending project
5638             --  with no sources.
5639 
5640             Locate_Directory
5641               (Project,
5642                File_Name_Type (Exec_Dir.Value),
5643                Path             => Project.Exec_Directory,
5644                Dir_Exists       => Dir_Exists,
5645                Data             => Data,
5646                Location         => Exec_Dir.Location,
5647                Externally_Built => Project.Externally_Built);
5648 
5649          else
5650             --  We check that the specified exec directory does exist
5651 
5652             Locate_Directory
5653               (Project,
5654                File_Name_Type (Exec_Dir.Value),
5655                Path             => Project.Exec_Directory,
5656                Dir_Exists       => Dir_Exists,
5657                Data             => Data,
5658                Create           => "exec",
5659                Location         => Exec_Dir.Location,
5660                Externally_Built => Project.Externally_Built);
5661 
5662             if not Dir_Exists then
5663                if Opt.Directories_Must_Exist_In_Projects then
5664                   Err_Vars.Error_Msg_File_1 := File_Name_Type (Exec_Dir.Value);
5665                   Error_Or_Warning
5666                     (Data.Flags, Data.Flags.Missing_Source_Files,
5667                      "exec directory { not found", Project.Location, Project);
5668 
5669                else
5670                   Project.Exec_Directory := No_Path_Information;
5671                end if;
5672             end if;
5673          end if;
5674       end if;
5675 
5676       if Current_Verbosity = High then
5677          if Project.Exec_Directory = No_Path_Information then
5678             Debug_Output ("no exec directory");
5679          else
5680             Debug_Output
5681               ("exec directory: ",
5682                Name_Id (Project.Exec_Directory.Display_Name));
5683          end if;
5684       end if;
5685 
5686       --  Look for the source directories
5687 
5688       Debug_Output ("starting to look for source directories");
5689 
5690       pragma Assert (Source_Dirs.Kind = List, "Source_Dirs is not a list");
5691 
5692       if not Source_Files.Default and then Source_Files.Values = Nil_String
5693       then
5694          Project.Source_Dirs := Nil_String;
5695 
5696          if Project.Qualifier = Standard then
5697             Error_Msg
5698               (Data.Flags,
5699                "a standard project cannot have no sources",
5700                Source_Files.Location, Project);
5701          end if;
5702 
5703       elsif Source_Dirs.Default then
5704 
5705          --  No Source_Dirs specified: the single source directory is the one
5706          --  containing the project file.
5707 
5708          Remove_Source_Dirs := False;
5709          Add_To_Or_Remove_From_Source_Dirs
5710            (Path => (Name         => Project.Directory.Name,
5711                      Display_Name => Project.Directory.Display_Name),
5712             Rank => 1);
5713 
5714       else
5715          Remove_Source_Dirs := False;
5716          Find_Source_Dirs
5717            (Project       => Project,
5718             Data          => Data,
5719             Patterns      => Source_Dirs.Values,
5720             Ignore        => Ignore_Source_Sub_Dirs.Values,
5721             Search_For    => Search_Directories,
5722             Resolve_Links => Opt.Follow_Links_For_Dirs);
5723 
5724          if Project.Source_Dirs = Nil_String
5725            and then Project.Qualifier = Standard
5726          then
5727             Error_Msg
5728               (Data.Flags,
5729                "a standard project cannot have no source directories",
5730                Source_Dirs.Location, Project);
5731          end if;
5732       end if;
5733 
5734       if not Excluded_Source_Dirs.Default
5735         and then Excluded_Source_Dirs.Values /= Nil_String
5736       then
5737          Remove_Source_Dirs := True;
5738          Find_Source_Dirs
5739            (Project       => Project,
5740             Data          => Data,
5741             Patterns      => Excluded_Source_Dirs.Values,
5742             Ignore        => Nil_String,
5743             Search_For    => Search_Directories,
5744             Resolve_Links => Opt.Follow_Links_For_Dirs);
5745       end if;
5746 
5747       Debug_Output ("putting source directories in canonical cases");
5748 
5749       declare
5750          Current : String_List_Id := Project.Source_Dirs;
5751          Element : String_Element;
5752 
5753       begin
5754          while Current /= Nil_String loop
5755             Element := Shared.String_Elements.Table (Current);
5756             if Element.Value /= No_Name then
5757                Element.Value :=
5758                  Name_Id (Canonical_Case_File_Name (Element.Value));
5759                Shared.String_Elements.Table (Current) := Element;
5760             end if;
5761 
5762             Current := Element.Next;
5763          end loop;
5764       end;
5765    end Get_Directories;
5766 
5767    ---------------
5768    -- Get_Mains --
5769    ---------------
5770 
5771    procedure Get_Mains
5772      (Project : Project_Id;
5773       Data    : in out Tree_Processing_Data)
5774    is
5775       Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
5776 
5777       Mains : constant Variable_Value :=
5778                Prj.Util.Value_Of
5779                  (Name_Main, Project.Decl.Attributes, Shared);
5780       List  : String_List_Id;
5781       Elem  : String_Element;
5782 
5783    begin
5784       Project.Mains := Mains.Values;
5785 
5786       --  If no Mains were specified, and if we are an extending project,
5787       --  inherit the Mains from the project we are extending.
5788 
5789       if Mains.Default then
5790          if not Project.Library and then Project.Extends /= No_Project then
5791             Project.Mains := Project.Extends.Mains;
5792          end if;
5793 
5794       --  In a library project file, Main cannot be specified
5795 
5796       elsif Project.Library then
5797          Error_Msg
5798            (Data.Flags,
5799             "a library project file cannot have Main specified",
5800             Mains.Location, Project);
5801 
5802       else
5803          List := Mains.Values;
5804          while List /= Nil_String loop
5805             Elem := Shared.String_Elements.Table (List);
5806 
5807             if Length_Of_Name (Elem.Value) = 0 then
5808                Error_Msg
5809                  (Data.Flags,
5810                   "?a main cannot have an empty name",
5811                   Elem.Location, Project);
5812                exit;
5813             end if;
5814 
5815             List := Elem.Next;
5816          end loop;
5817       end if;
5818    end Get_Mains;
5819 
5820    ---------------------------
5821    -- Get_Sources_From_File --
5822    ---------------------------
5823 
5824    procedure Get_Sources_From_File
5825      (Path     : String;
5826       Location : Source_Ptr;
5827       Project  : in out Project_Processing_Data;
5828       Data     : in out Tree_Processing_Data)
5829    is
5830       File        : Prj.Util.Text_File;
5831       Line        : String (1 .. 250);
5832       Last        : Natural;
5833       Source_Name : File_Name_Type;
5834       Name_Loc    : Name_Location;
5835 
5836    begin
5837       if Current_Verbosity = High then
5838          Debug_Output ("opening """ & Path & '"');
5839       end if;
5840 
5841       --  Open the file
5842 
5843       Prj.Util.Open (File, Path);
5844 
5845       if not Prj.Util.Is_Valid (File) then
5846          Error_Msg
5847            (Data.Flags, "file does not exist", Location, Project.Project);
5848 
5849       else
5850          --  Read the lines one by one
5851 
5852          while not Prj.Util.End_Of_File (File) loop
5853             Prj.Util.Get_Line (File, Line, Last);
5854 
5855             --  A non empty, non comment line should contain a file name
5856 
5857             if Last /= 0 and then (Last = 1 or else Line (1 .. 2) /= "--") then
5858                Name_Len := Last;
5859                Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
5860                Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
5861                Source_Name := Name_Find;
5862 
5863                --  Check that there is no directory information
5864 
5865                for J in 1 .. Last loop
5866                   if Is_Directory_Separator (Line (J)) then
5867                      Error_Msg_File_1 := Source_Name;
5868                      Error_Msg
5869                        (Data.Flags,
5870                         "file name cannot include directory information ({)",
5871                         Location, Project.Project);
5872                      exit;
5873                   end if;
5874                end loop;
5875 
5876                Name_Loc := Source_Names_Htable.Get
5877                  (Project.Source_Names, Source_Name);
5878 
5879                if Name_Loc = No_Name_Location then
5880                   Name_Loc :=
5881                     (Name     => Source_Name,
5882                      Location => Location,
5883                      Source   => No_Source,
5884                      Listed   => True,
5885                      Found    => False);
5886 
5887                else
5888                   Name_Loc.Listed := True;
5889                end if;
5890 
5891                Source_Names_Htable.Set
5892                  (Project.Source_Names, Source_Name, Name_Loc);
5893             end if;
5894          end loop;
5895 
5896          Prj.Util.Close (File);
5897 
5898       end if;
5899    end Get_Sources_From_File;
5900 
5901    ------------------
5902    -- No_Space_Img --
5903    ------------------
5904 
5905    function No_Space_Img (N : Natural) return String is
5906       Image : constant String := N'Img;
5907    begin
5908       return Image (2 .. Image'Last);
5909    end No_Space_Img;
5910 
5911    -----------------------
5912    -- Compute_Unit_Name --
5913    -----------------------
5914 
5915    procedure Compute_Unit_Name
5916      (File_Name : File_Name_Type;
5917       Naming    : Lang_Naming_Data;
5918       Kind      : out Source_Kind;
5919       Unit      : out Name_Id;
5920       Project   : Project_Processing_Data)
5921    is
5922       Filename : constant String  := Get_Name_String (File_Name);
5923       Last     : Integer          := Filename'Last;
5924       Sep_Len  : Integer;
5925       Body_Len : Integer;
5926       Spec_Len : Integer;
5927 
5928       Unit_Except : Unit_Exception;
5929       Masked      : Boolean  := False;
5930 
5931    begin
5932       Unit := No_Name;
5933       Kind := Spec;
5934 
5935       if Naming.Separate_Suffix = No_File
5936         or else Naming.Body_Suffix = No_File
5937         or else Naming.Spec_Suffix = No_File
5938       then
5939          return;
5940       end if;
5941 
5942       if Naming.Dot_Replacement = No_File then
5943          Debug_Output ("no dot_replacement specified");
5944          return;
5945       end if;
5946 
5947       Sep_Len  := Integer (Length_Of_Name (Naming.Separate_Suffix));
5948       Spec_Len := Integer (Length_Of_Name (Naming.Spec_Suffix));
5949       Body_Len := Integer (Length_Of_Name (Naming.Body_Suffix));
5950 
5951       --  Choose the longest suffix that matches. If there are several matches,
5952       --  give priority to specs, then bodies, then separates.
5953 
5954       if Naming.Separate_Suffix /= Naming.Body_Suffix
5955         and then Suffix_Matches (Filename, Naming.Separate_Suffix)
5956       then
5957          Last := Filename'Last - Sep_Len;
5958          Kind := Sep;
5959       end if;
5960 
5961       if Filename'Last - Body_Len <= Last
5962         and then Suffix_Matches (Filename, Naming.Body_Suffix)
5963       then
5964          Last := Natural'Min (Last, Filename'Last - Body_Len);
5965          Kind := Impl;
5966       end if;
5967 
5968       if Filename'Last - Spec_Len <= Last
5969         and then Suffix_Matches (Filename, Naming.Spec_Suffix)
5970       then
5971          Last := Natural'Min (Last, Filename'Last - Spec_Len);
5972          Kind := Spec;
5973       end if;
5974 
5975       if Last = Filename'Last then
5976          Debug_Output ("no matching suffix");
5977          return;
5978       end if;
5979 
5980       --  Check that the casing matches
5981 
5982       if File_Names_Case_Sensitive then
5983          case Naming.Casing is
5984             when All_Lower_Case =>
5985                for J in Filename'First .. Last loop
5986                   if Is_Letter (Filename (J))
5987                     and then not Is_Lower (Filename (J))
5988                   then
5989                      Debug_Output ("invalid casing");
5990                      return;
5991                   end if;
5992                end loop;
5993 
5994             when All_Upper_Case =>
5995                for J in Filename'First .. Last loop
5996                   if Is_Letter (Filename (J))
5997                     and then not Is_Upper (Filename (J))
5998                   then
5999                      Debug_Output ("invalid casing");
6000                      return;
6001                   end if;
6002                end loop;
6003 
6004             when Mixed_Case | Unknown =>
6005                null;
6006          end case;
6007       end if;
6008 
6009       --  If Dot_Replacement is not a single dot, then there should not
6010       --  be any dot in the name.
6011 
6012       declare
6013          Dot_Repl : constant String :=
6014                       Get_Name_String (Naming.Dot_Replacement);
6015 
6016       begin
6017          if Dot_Repl /= "." then
6018             for Index in Filename'First .. Last loop
6019                if Filename (Index) = '.' then
6020                   Debug_Output ("invalid name, contains dot");
6021                   return;
6022                end if;
6023             end loop;
6024 
6025             Replace_Into_Name_Buffer
6026               (Filename (Filename'First .. Last), Dot_Repl, '.');
6027 
6028          else
6029             Name_Len := Last - Filename'First + 1;
6030             Name_Buffer (1 .. Name_Len) := Filename (Filename'First .. Last);
6031             Fixed.Translate
6032               (Source  => Name_Buffer (1 .. Name_Len),
6033                Mapping => Lower_Case_Map);
6034          end if;
6035       end;
6036 
6037       --  In the standard GNAT naming scheme, check for special cases: children
6038       --  or separates of A, G, I or S, and run time sources.
6039 
6040       if Is_Standard_GNAT_Naming (Naming) and then Name_Len >= 3 then
6041          declare
6042             S1 : constant Character := Name_Buffer (1);
6043             S2 : constant Character := Name_Buffer (2);
6044             S3 : constant Character := Name_Buffer (3);
6045 
6046          begin
6047             if S1 = 'a' or else S1 = 'g' or else S1 = 'i' or else S1 = 's' then
6048 
6049                --  Children or separates of packages A, G, I or S. These names
6050                --  are x__ ... or x~... (where x is a, g, i, or s). Both
6051                --  versions (x__... and x~...) are allowed in all platforms,
6052                --  because it is not possible to know the platform before
6053                --  processing of the project files.
6054 
6055                if S2 = '_' and then S3 = '_' then
6056                   Name_Buffer (2) := '.';
6057                   Name_Buffer (3 .. Name_Len - 1) :=
6058                     Name_Buffer (4 .. Name_Len);
6059                   Name_Len := Name_Len - 1;
6060 
6061                elsif S2 = '~' then
6062                   Name_Buffer (2) := '.';
6063 
6064                elsif S2 = '.' then
6065 
6066                   --  If it is potentially a run time source
6067 
6068                   null;
6069                end if;
6070             end if;
6071          end;
6072       end if;
6073 
6074       --  Name_Buffer contains the name of the unit in lower-cases. Check
6075       --  that this is a valid unit name
6076 
6077       Check_Unit_Name (Name_Buffer (1 .. Name_Len), Unit);
6078 
6079       --  If there is a naming exception for the same unit, the file is not
6080       --  a source for the unit.
6081 
6082       if Unit /= No_Name then
6083          Unit_Except :=
6084            Unit_Exceptions_Htable.Get (Project.Unit_Exceptions, Unit);
6085 
6086          if Kind = Spec then
6087             Masked := Unit_Except.Spec /= No_File
6088                         and then
6089                       Unit_Except.Spec /= File_Name;
6090          else
6091             Masked := Unit_Except.Impl /= No_File
6092                         and then
6093                       Unit_Except.Impl /= File_Name;
6094          end if;
6095 
6096          if Masked then
6097             if Current_Verbosity = High then
6098                Debug_Indent;
6099                Write_Str ("   """ & Filename & """ contains the ");
6100 
6101                if Kind = Spec then
6102                   Write_Str ("spec of a unit found in """);
6103                   Write_Str (Get_Name_String (Unit_Except.Spec));
6104                else
6105                   Write_Str ("body of a unit found in """);
6106                   Write_Str (Get_Name_String (Unit_Except.Impl));
6107                end if;
6108 
6109                Write_Line (""" (ignored)");
6110             end if;
6111 
6112             Unit := No_Name;
6113          end if;
6114       end if;
6115 
6116       if Unit /= No_Name and then Current_Verbosity = High then
6117          case Kind is
6118             when Spec => Debug_Output ("spec of", Unit);
6119             when Impl => Debug_Output ("body of", Unit);
6120             when Sep  => Debug_Output ("sep of", Unit);
6121          end case;
6122       end if;
6123    end Compute_Unit_Name;
6124 
6125    --------------------------
6126    -- Check_Illegal_Suffix --
6127    --------------------------
6128 
6129    procedure Check_Illegal_Suffix
6130      (Project         : Project_Id;
6131       Suffix          : File_Name_Type;
6132       Dot_Replacement : File_Name_Type;
6133       Attribute_Name  : String;
6134       Location        : Source_Ptr;
6135       Data            : in out Tree_Processing_Data)
6136    is
6137       Suffix_Str : constant String := Get_Name_String (Suffix);
6138 
6139    begin
6140       if Suffix_Str'Length = 0 then
6141 
6142          --  Always valid
6143 
6144          return;
6145 
6146       elsif Index (Suffix_Str, ".") = 0 then
6147          Err_Vars.Error_Msg_File_1 := Suffix;
6148          Error_Msg
6149            (Data.Flags,
6150             "{ is illegal for " & Attribute_Name & ": must have a dot",
6151             Location, Project);
6152          return;
6153       end if;
6154 
6155       --  Case of dot replacement is a single dot, and first character of
6156       --  suffix is also a dot.
6157 
6158       if Dot_Replacement /= No_File
6159         and then Get_Name_String (Dot_Replacement) = "."
6160         and then Suffix_Str (Suffix_Str'First) = '.'
6161       then
6162          for Index in Suffix_Str'First + 1 .. Suffix_Str'Last loop
6163 
6164             --  If there are multiple dots in the name
6165 
6166             if Suffix_Str (Index) = '.' then
6167 
6168                --  It is illegal to have a letter following the initial dot
6169 
6170                if Is_Letter (Suffix_Str (Suffix_Str'First + 1)) then
6171                   Err_Vars.Error_Msg_File_1 := Suffix;
6172                   Error_Msg
6173                     (Data.Flags,
6174                      "{ is illegal for " & Attribute_Name
6175                      & ": ambiguous prefix when Dot_Replacement is a dot",
6176                      Location, Project);
6177                end if;
6178                return;
6179             end if;
6180          end loop;
6181       end if;
6182    end Check_Illegal_Suffix;
6183 
6184    ----------------------
6185    -- Locate_Directory --
6186    ----------------------
6187 
6188    procedure Locate_Directory
6189      (Project          : Project_Id;
6190       Name             : File_Name_Type;
6191       Path             : out Path_Information;
6192       Dir_Exists       : out Boolean;
6193       Data             : in out Tree_Processing_Data;
6194       Create           : String := "";
6195       Location         : Source_Ptr := No_Location;
6196       Must_Exist       : Boolean := True;
6197       Externally_Built : Boolean := False)
6198    is
6199       Parent          : constant Path_Name_Type :=
6200                           Project.Directory.Display_Name;
6201       The_Parent      : constant String :=
6202                           Get_Name_String (Parent);
6203       The_Parent_Last : constant Natural :=
6204                           Compute_Directory_Last (The_Parent);
6205       Full_Name       : File_Name_Type;
6206       The_Name        : File_Name_Type;
6207 
6208    begin
6209       --  Check if we have a root-object dir specified, if so relocate all
6210       --  artefact directories to it.
6211 
6212       if Build_Tree_Dir /= null
6213         and then Create /= ""
6214         and then not Is_Absolute_Path (Get_Name_String (Name))
6215       then
6216          Name_Len := 0;
6217          Add_Str_To_Name_Buffer (Build_Tree_Dir.all);
6218 
6219          if The_Parent_Last - The_Parent'First  + 1 < Root_Dir'Length then
6220             Err_Vars.Error_Msg_File_1 := Name;
6221             Error_Or_Warning
6222               (Data.Flags, Error,
6223                "{ cannot relocate deeper than " & Create & " directory",
6224                No_Location, Project);
6225          end if;
6226 
6227          Add_Str_To_Name_Buffer
6228            (Relative_Path
6229               (The_Parent (The_Parent'First .. The_Parent_Last),
6230                Root_Dir.all));
6231          Add_Str_To_Name_Buffer (Get_Name_String (Name));
6232 
6233       else
6234          if Build_Tree_Dir /= null and then Create /= "" then
6235 
6236             --  Issue a warning that we cannot relocate absolute obj dir
6237 
6238             Err_Vars.Error_Msg_File_1 := Name;
6239             Error_Or_Warning
6240               (Data.Flags, Warning,
6241                "{ cannot relocate absolute object directory",
6242                No_Location, Project);
6243          end if;
6244 
6245          Get_Name_String (Name);
6246       end if;
6247 
6248       --  Add Subdirs.all if it is a directory that may be created and
6249       --  Subdirs is not null;
6250 
6251       if Create /= "" and then Subdirs /= null then
6252          if Name_Buffer (Name_Len) /= Directory_Separator then
6253             Add_Char_To_Name_Buffer (Directory_Separator);
6254          end if;
6255 
6256          Add_Str_To_Name_Buffer (Subdirs.all);
6257       end if;
6258 
6259       --  Convert '/' to directory separator (for Windows)
6260 
6261       for J in 1 .. Name_Len loop
6262          if Name_Buffer (J) = '/' then
6263             Name_Buffer (J) := Directory_Separator;
6264          end if;
6265       end loop;
6266 
6267       The_Name := Name_Find;
6268 
6269       if Current_Verbosity = High then
6270          Debug_Indent;
6271          Write_Str ("Locate_Directory (""");
6272          Write_Str (Get_Name_String (The_Name));
6273          Write_Str (""", in """);
6274          Write_Str (The_Parent);
6275          Write_Line (""")");
6276       end if;
6277 
6278       Path := No_Path_Information;
6279       Dir_Exists := False;
6280 
6281       if Is_Absolute_Path (Get_Name_String (The_Name)) then
6282          Full_Name := The_Name;
6283 
6284       else
6285          Name_Len := 0;
6286          Add_Str_To_Name_Buffer
6287            (The_Parent (The_Parent'First .. The_Parent_Last));
6288          Add_Str_To_Name_Buffer (Get_Name_String (The_Name));
6289          Full_Name := Name_Find;
6290       end if;
6291 
6292       declare
6293          Full_Path_Name : String_Access :=
6294                             new String'(Get_Name_String (Full_Name));
6295 
6296       begin
6297          if (Setup_Projects or else Subdirs /= null)
6298            and then Create'Length > 0
6299          then
6300             if not Is_Directory (Full_Path_Name.all) then
6301 
6302                --  If project is externally built, do not create a subdir,
6303                --  use the specified directory, without the subdir.
6304 
6305                if Externally_Built then
6306                   if Is_Absolute_Path (Get_Name_String (Name)) then
6307                      Get_Name_String (Name);
6308 
6309                   else
6310                      Name_Len := 0;
6311                      Add_Str_To_Name_Buffer
6312                        (The_Parent (The_Parent'First .. The_Parent_Last));
6313                      Add_Str_To_Name_Buffer (Get_Name_String (Name));
6314                   end if;
6315 
6316                   Full_Path_Name := new String'(Name_Buffer (1 .. Name_Len));
6317 
6318                else
6319                   begin
6320                      Create_Path (Full_Path_Name.all);
6321 
6322                      if not Quiet_Output then
6323                         Write_Str (Create);
6324                         Write_Str (" directory """);
6325                         Write_Str (Full_Path_Name.all);
6326                         Write_Str (""" created for project ");
6327                         Write_Line (Get_Name_String (Project.Name));
6328                      end if;
6329 
6330                   exception
6331                      when Use_Error =>
6332 
6333                         --  Output message with name of directory. Note that we
6334                         --  use the ~ insertion method here in case the name
6335                         --  has special characters in it.
6336 
6337                         Error_Msg_Strlen := Full_Path_Name'Length;
6338                         Error_Msg_String (1 .. Error_Msg_Strlen) :=
6339                           Full_Path_Name.all;
6340                         Error_Msg
6341                           (Data.Flags,
6342                            "could not create " & Create & " directory ~",
6343                            Location,
6344                            Project);
6345                   end;
6346                end if;
6347             end if;
6348          end if;
6349 
6350          Dir_Exists := Is_Directory (Full_Path_Name.all);
6351 
6352          if not Must_Exist or Dir_Exists then
6353             declare
6354                Normed : constant String :=
6355                           Normalize_Pathname
6356                             (Full_Path_Name.all,
6357                              Directory      =>
6358                               The_Parent (The_Parent'First .. The_Parent_Last),
6359                              Resolve_Links  => False,
6360                              Case_Sensitive => True);
6361 
6362                Canonical_Path : constant String :=
6363                                   Normalize_Pathname
6364                                     (Normed,
6365                                      Directory      =>
6366                                        The_Parent
6367                                          (The_Parent'First .. The_Parent_Last),
6368                                      Resolve_Links  =>
6369                                         Opt.Follow_Links_For_Dirs,
6370                                      Case_Sensitive => False);
6371 
6372             begin
6373                Name_Len := Normed'Length;
6374                Name_Buffer (1 .. Name_Len) := Normed;
6375 
6376                --  Directories should always end with a directory separator
6377 
6378                if Name_Buffer (Name_Len) /= Directory_Separator then
6379                   Add_Char_To_Name_Buffer (Directory_Separator);
6380                end if;
6381 
6382                Path.Display_Name := Name_Find;
6383 
6384                Name_Len := Canonical_Path'Length;
6385                Name_Buffer (1 .. Name_Len) := Canonical_Path;
6386 
6387                if Name_Buffer (Name_Len) /= Directory_Separator then
6388                   Add_Char_To_Name_Buffer (Directory_Separator);
6389                end if;
6390 
6391                Path.Name := Name_Find;
6392             end;
6393          end if;
6394 
6395          Free (Full_Path_Name);
6396       end;
6397    end Locate_Directory;
6398 
6399    ---------------------------
6400    -- Find_Excluded_Sources --
6401    ---------------------------
6402 
6403    procedure Find_Excluded_Sources
6404      (Project : in out Project_Processing_Data;
6405       Data    : in out Tree_Processing_Data)
6406    is
6407       Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
6408 
6409       Excluded_Source_List_File : constant Variable_Value :=
6410                                     Util.Value_Of
6411                                       (Name_Excluded_Source_List_File,
6412                                        Project.Project.Decl.Attributes,
6413                                        Shared);
6414       Excluded_Sources          : Variable_Value := Util.Value_Of
6415                                     (Name_Excluded_Source_Files,
6416                                      Project.Project.Decl.Attributes,
6417                                      Shared);
6418 
6419       Current         : String_List_Id;
6420       Element         : String_Element;
6421       Location        : Source_Ptr;
6422       Name            : File_Name_Type;
6423       File            : Prj.Util.Text_File;
6424       Line            : String (1 .. 300);
6425       Last            : Natural;
6426       Locally_Removed : Boolean := False;
6427 
6428    begin
6429       --  If Excluded_Source_Files is not declared, check Locally_Removed_Files
6430 
6431       if Excluded_Sources.Default then
6432          Locally_Removed := True;
6433          Excluded_Sources :=
6434            Util.Value_Of
6435              (Name_Locally_Removed_Files,
6436               Project.Project.Decl.Attributes, Shared);
6437       end if;
6438 
6439       --  If there are excluded sources, put them in the table
6440 
6441       if not Excluded_Sources.Default then
6442          if not Excluded_Source_List_File.Default then
6443             if Locally_Removed then
6444                Error_Msg
6445                  (Data.Flags,
6446                   "?both attributes Locally_Removed_Files and " &
6447                   "Excluded_Source_List_File are present",
6448                   Excluded_Source_List_File.Location, Project.Project);
6449             else
6450                Error_Msg
6451                  (Data.Flags,
6452                   "?both attributes Excluded_Source_Files and " &
6453                   "Excluded_Source_List_File are present",
6454                   Excluded_Source_List_File.Location, Project.Project);
6455             end if;
6456          end if;
6457 
6458          Current := Excluded_Sources.Values;
6459          while Current /= Nil_String loop
6460             Element := Shared.String_Elements.Table (Current);
6461             Name := Canonical_Case_File_Name (Element.Value);
6462 
6463             --  If the element has no location, then use the location of
6464             --  Excluded_Sources to report possible errors.
6465 
6466             if Element.Location = No_Location then
6467                Location := Excluded_Sources.Location;
6468             else
6469                Location := Element.Location;
6470             end if;
6471 
6472             Excluded_Sources_Htable.Set
6473               (Project.Excluded, Name,
6474                (Name, No_File, 0, False, Location));
6475             Current := Element.Next;
6476          end loop;
6477 
6478       elsif not Excluded_Source_List_File.Default then
6479          Location := Excluded_Source_List_File.Location;
6480 
6481          declare
6482             Source_File_Name : constant File_Name_Type :=
6483                                  File_Name_Type
6484                                     (Excluded_Source_List_File.Value);
6485             Source_File_Line : Natural := 0;
6486 
6487             Source_File_Path_Name : constant String :=
6488                                       Path_Name_Of
6489                                         (Source_File_Name,
6490                                          Project.Project.Directory.Name);
6491 
6492          begin
6493             if Source_File_Path_Name'Length = 0 then
6494                Err_Vars.Error_Msg_File_1 :=
6495                  File_Name_Type (Excluded_Source_List_File.Value);
6496                Error_Msg
6497                  (Data.Flags,
6498                   "file with excluded sources { does not exist",
6499                   Excluded_Source_List_File.Location, Project.Project);
6500 
6501             else
6502                --  Open the file
6503 
6504                Prj.Util.Open (File, Source_File_Path_Name);
6505 
6506                if not Prj.Util.Is_Valid (File) then
6507                   Error_Msg
6508                     (Data.Flags, "file does not exist",
6509                      Location, Project.Project);
6510                else
6511                   --  Read the lines one by one
6512 
6513                   while not Prj.Util.End_Of_File (File) loop
6514                      Prj.Util.Get_Line (File, Line, Last);
6515                      Source_File_Line := Source_File_Line + 1;
6516 
6517                      --  Non empty, non comment line should contain a file name
6518 
6519                      if Last /= 0
6520                        and then (Last = 1 or else Line (1 .. 2) /= "--")
6521                      then
6522                         Name_Len := Last;
6523                         Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
6524                         Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
6525                         Name := Name_Find;
6526 
6527                         --  Check that there is no directory information
6528 
6529                         for J in 1 .. Last loop
6530                            if Is_Directory_Separator (Line (J)) then
6531                               Error_Msg_File_1 := Name;
6532                               Error_Msg
6533                                 (Data.Flags,
6534                                  "file name cannot include "
6535                                  & "directory information ({)",
6536                                  Location, Project.Project);
6537                               exit;
6538                            end if;
6539                         end loop;
6540 
6541                         Excluded_Sources_Htable.Set
6542                           (Project.Excluded,
6543                            Name,
6544                            (Name, Source_File_Name, Source_File_Line,
6545                             False, Location));
6546                      end if;
6547                   end loop;
6548 
6549                   Prj.Util.Close (File);
6550                end if;
6551             end if;
6552          end;
6553       end if;
6554    end Find_Excluded_Sources;
6555 
6556    ------------------
6557    -- Find_Sources --
6558    ------------------
6559 
6560    procedure Find_Sources
6561      (Project : in out Project_Processing_Data;
6562       Data    : in out Tree_Processing_Data)
6563    is
6564       Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
6565 
6566       Sources : constant Variable_Value :=
6567                   Util.Value_Of
6568                     (Name_Source_Files,
6569                      Project.Project.Decl.Attributes,
6570                      Shared);
6571 
6572       Source_List_File : constant Variable_Value :=
6573                            Util.Value_Of
6574                              (Name_Source_List_File,
6575                               Project.Project.Decl.Attributes,
6576                               Shared);
6577 
6578       Name_Loc             : Name_Location;
6579       Has_Explicit_Sources : Boolean;
6580 
6581    begin
6582       pragma Assert (Sources.Kind = List, "Source_Files is not a list");
6583       pragma Assert
6584         (Source_List_File.Kind = Single,
6585          "Source_List_File is not a single string");
6586 
6587       Project.Source_List_File_Location := Source_List_File.Location;
6588 
6589       --  If the user has specified a Source_Files attribute
6590 
6591       if not Sources.Default then
6592          if not Source_List_File.Default then
6593             Error_Msg
6594               (Data.Flags,
6595                "?both attributes source_files and " &
6596                "source_list_file are present",
6597                Source_List_File.Location, Project.Project);
6598          end if;
6599 
6600          --  Sources is a list of file names
6601 
6602          declare
6603             Current  : String_List_Id := Sources.Values;
6604             Element  : String_Element;
6605             Location : Source_Ptr;
6606             Name     : File_Name_Type;
6607 
6608          begin
6609             if Current = Nil_String then
6610                Project.Project.Languages := No_Language_Index;
6611 
6612                --  This project contains no source. For projects that don't
6613                --  extend other projects, this also means that there is no
6614                --  need for an object directory, if not specified.
6615 
6616                if Project.Project.Extends = No_Project
6617                  and then
6618                    Project.Project.Object_Directory = Project.Project.Directory
6619                  and then not (Project.Project.Qualifier = Aggregate_Library)
6620                then
6621                   Project.Project.Object_Directory := No_Path_Information;
6622                end if;
6623             end if;
6624 
6625             while Current /= Nil_String loop
6626                Element := Shared.String_Elements.Table (Current);
6627                Name := Canonical_Case_File_Name (Element.Value);
6628                Get_Name_String (Element.Value);
6629 
6630                --  If the element has no location, then use the location of
6631                --  Sources to report possible errors.
6632 
6633                if Element.Location = No_Location then
6634                   Location := Sources.Location;
6635                else
6636                   Location := Element.Location;
6637                end if;
6638 
6639                --  Check that there is no directory information
6640 
6641                for J in 1 .. Name_Len loop
6642                   if Is_Directory_Separator (Name_Buffer (J)) then
6643                      Error_Msg_File_1 := Name;
6644                      Error_Msg
6645                        (Data.Flags,
6646                         "file name cannot include directory " &
6647                         "information ({)",
6648                         Location, Project.Project);
6649                      exit;
6650                   end if;
6651                end loop;
6652 
6653                --  Check whether the file is already there: the same file name
6654                --  may be in the list. If the source is missing, the error will
6655                --  be on the first mention of the source file name.
6656 
6657                Name_Loc := Source_Names_Htable.Get
6658                  (Project.Source_Names, Name);
6659 
6660                if Name_Loc = No_Name_Location then
6661                   Name_Loc :=
6662                     (Name     => Name,
6663                      Location => Location,
6664                      Source   => No_Source,
6665                      Listed   => True,
6666                      Found    => False);
6667 
6668                else
6669                   Name_Loc.Listed := True;
6670                end if;
6671 
6672                Source_Names_Htable.Set
6673                  (Project.Source_Names, Name, Name_Loc);
6674 
6675                Current := Element.Next;
6676             end loop;
6677 
6678             Has_Explicit_Sources := True;
6679          end;
6680 
6681          --  If we have no Source_Files attribute, check the Source_List_File
6682          --  attribute.
6683 
6684       elsif not Source_List_File.Default then
6685 
6686          --  Source_List_File is the name of the file that contains the source
6687          --  file names.
6688 
6689          declare
6690             Source_File_Path_Name : constant String :=
6691                                       Path_Name_Of
6692                                         (File_Name_Type
6693                                            (Source_List_File.Value),
6694                                          Project.Project.
6695                                            Directory.Display_Name);
6696 
6697          begin
6698             Has_Explicit_Sources := True;
6699 
6700             if Source_File_Path_Name'Length = 0 then
6701                Err_Vars.Error_Msg_File_1 :=
6702                  File_Name_Type (Source_List_File.Value);
6703                Error_Msg
6704                  (Data.Flags,
6705                   "file with sources { does not exist",
6706                   Source_List_File.Location, Project.Project);
6707 
6708             else
6709                Get_Sources_From_File
6710                  (Source_File_Path_Name, Source_List_File.Location,
6711                   Project, Data);
6712             end if;
6713          end;
6714 
6715       else
6716          --  Neither Source_Files nor Source_List_File has been specified. Find
6717          --  all the files that satisfy the naming scheme in all the source
6718          --  directories.
6719 
6720          Has_Explicit_Sources := False;
6721       end if;
6722 
6723       --  Remove any exception that is not in the specified list of sources
6724 
6725       if Has_Explicit_Sources then
6726          declare
6727             Source : Source_Id;
6728             Iter   : Source_Iterator;
6729             NL     : Name_Location;
6730             Again  : Boolean;
6731          begin
6732             Iter_Loop :
6733             loop
6734                Again := False;
6735                Iter := For_Each_Source (Data.Tree, Project.Project);
6736 
6737                Source_Loop :
6738                loop
6739                   Source := Prj.Element (Iter);
6740                   exit Source_Loop when Source = No_Source;
6741 
6742                   if Source.Naming_Exception /= No then
6743                      NL := Source_Names_Htable.Get
6744                        (Project.Source_Names, Source.File);
6745 
6746                      if NL /= No_Name_Location and then not NL.Listed then
6747 
6748                         --  Remove the exception
6749 
6750                         Source_Names_Htable.Set
6751                           (Project.Source_Names,
6752                            Source.File,
6753                            No_Name_Location);
6754                         Remove_Source (Data.Tree, Source, No_Source);
6755 
6756                         if Source.Naming_Exception = Yes then
6757                            Error_Msg_Name_1 := Name_Id (Source.File);
6758                            Error_Msg
6759                              (Data.Flags,
6760                               "? unknown source file %%",
6761                               NL.Location,
6762                               Project.Project);
6763                         end if;
6764 
6765                         Again := True;
6766                         exit Source_Loop;
6767                      end if;
6768                   end if;
6769 
6770                   Next (Iter);
6771                end loop Source_Loop;
6772 
6773                exit Iter_Loop when not Again;
6774             end loop Iter_Loop;
6775          end;
6776       end if;
6777 
6778       Search_Directories
6779         (Project,
6780          Data            => Data,
6781          For_All_Sources => Sources.Default and then Source_List_File.Default);
6782 
6783       --  Check if all exceptions have been found
6784 
6785       declare
6786          Source : Source_Id;
6787          Iter   : Source_Iterator;
6788          Found  : Boolean := False;
6789 
6790       begin
6791          Iter := For_Each_Source (Data.Tree, Project.Project);
6792          loop
6793             Source := Prj.Element (Iter);
6794             exit when Source = No_Source;
6795 
6796             --  If the full source path is unknown for this source_id, there
6797             --  could be several reasons:
6798             --    * we simply did not find the file itself, this is an error
6799             --    * we have a multi-unit source file. Another Source_Id from
6800             --      the same file has received the full path, so we need to
6801             --      propagate it.
6802 
6803             if Source.Path = No_Path_Information then
6804                if Source.Naming_Exception = Yes then
6805                   if Source.Unit /= No_Unit_Index then
6806                      Found := False;
6807 
6808                      if Source.Index /= 0 then  --  Only multi-unit files
6809                         declare
6810                            S : Source_Id :=
6811                                  Source_Files_Htable.Get
6812                                    (Data.Tree.Source_Files_HT, Source.File);
6813 
6814                         begin
6815                            while S /= null loop
6816                               if S.Path /= No_Path_Information then
6817                                  Source.Path := S.Path;
6818                                  Found := True;
6819 
6820                                  if Current_Verbosity = High then
6821                                     Debug_Output
6822                                       ("setting full path for "
6823                                        & Get_Name_String (Source.File)
6824                                        & " at" & Source.Index'Img
6825                                        & " to "
6826                                        & Get_Name_String (Source.Path.Name));
6827                                  end if;
6828 
6829                                  exit;
6830                               end if;
6831 
6832                               S := S.Next_With_File_Name;
6833                            end loop;
6834                         end;
6835                      end if;
6836 
6837                      if not Found then
6838                         Error_Msg_Name_1 := Name_Id (Source.Display_File);
6839                         Error_Msg_Name_2 := Source.Unit.Name;
6840                         Error_Or_Warning
6841                           (Data.Flags, Data.Flags.Missing_Source_Files,
6842                            "\source file %% for unit %% not found",
6843                            No_Location, Project.Project);
6844                      end if;
6845                   end if;
6846 
6847                   if Source.Path = No_Path_Information then
6848                      Remove_Source (Data.Tree, Source, No_Source);
6849                   end if;
6850 
6851                elsif Source.Naming_Exception = Inherited then
6852                   Remove_Source (Data.Tree, Source, No_Source);
6853                end if;
6854             end if;
6855 
6856             Next (Iter);
6857          end loop;
6858       end;
6859 
6860       --  It is an error if a source file name in a source list or in a source
6861       --  list file is not found.
6862 
6863       if Has_Explicit_Sources then
6864          declare
6865             NL          : Name_Location;
6866             First_Error : Boolean;
6867 
6868          begin
6869             NL := Source_Names_Htable.Get_First (Project.Source_Names);
6870             First_Error := True;
6871             while NL /= No_Name_Location loop
6872                if not NL.Found then
6873                   Err_Vars.Error_Msg_File_1 := NL.Name;
6874                   if First_Error then
6875                      Error_Or_Warning
6876                        (Data.Flags, Data.Flags.Missing_Source_Files,
6877                         "source file { not found",
6878                         NL.Location, Project.Project);
6879                      First_Error := False;
6880                   else
6881                      Error_Or_Warning
6882                        (Data.Flags, Data.Flags.Missing_Source_Files,
6883                         "\source file { not found",
6884                         NL.Location, Project.Project);
6885                   end if;
6886                end if;
6887 
6888                NL := Source_Names_Htable.Get_Next (Project.Source_Names);
6889             end loop;
6890          end;
6891       end if;
6892    end Find_Sources;
6893 
6894    ----------------
6895    -- Initialize --
6896    ----------------
6897 
6898    procedure Initialize
6899      (Data      : out Tree_Processing_Data;
6900       Tree      : Project_Tree_Ref;
6901       Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
6902       Flags     : Prj.Processing_Flags)
6903    is
6904    begin
6905       Data.Tree      := Tree;
6906       Data.Node_Tree := Node_Tree;
6907       Data.Flags     := Flags;
6908    end Initialize;
6909 
6910    ----------
6911    -- Free --
6912    ----------
6913 
6914    procedure Free (Data : in out Tree_Processing_Data) is
6915       pragma Unreferenced (Data);
6916    begin
6917       null;
6918    end Free;
6919 
6920    ----------------
6921    -- Initialize --
6922    ----------------
6923 
6924    procedure Initialize
6925      (Data    : in out Project_Processing_Data;
6926       Project : Project_Id)
6927    is
6928    begin
6929       Data.Project := Project;
6930    end Initialize;
6931 
6932    ----------
6933    -- Free --
6934    ----------
6935 
6936    procedure Free (Data : in out Project_Processing_Data) is
6937    begin
6938       Source_Names_Htable.Reset     (Data.Source_Names);
6939       Unit_Exceptions_Htable.Reset  (Data.Unit_Exceptions);
6940       Excluded_Sources_Htable.Reset (Data.Excluded);
6941    end Free;
6942 
6943    -------------------------------
6944    -- Check_File_Naming_Schemes --
6945    -------------------------------
6946 
6947    procedure Check_File_Naming_Schemes
6948      (Project               : Project_Processing_Data;
6949       File_Name             : File_Name_Type;
6950       Alternate_Languages   : out Language_List;
6951       Language              : out Language_Ptr;
6952       Display_Language_Name : out Name_Id;
6953       Unit                  : out Name_Id;
6954       Lang_Kind             : out Language_Kind;
6955       Kind                  : out Source_Kind)
6956    is
6957       Filename : constant String := Get_Name_String (File_Name);
6958       Config   : Language_Config;
6959       Tmp_Lang : Language_Ptr;
6960 
6961       Header_File : Boolean := False;
6962       --  True if we found at least one language for which the file is a header
6963       --  In such a case, we search for all possible languages where this is
6964       --  also a header (C and C++ for instance), since the file might be used
6965       --  for several such languages.
6966 
6967       procedure Check_File_Based_Lang;
6968       --  Does the naming scheme test for file-based languages. For those,
6969       --  there is no Unit. Just check if the file name has the implementation
6970       --  or, if it is specified, the template suffix of the language.
6971       --
6972       --  Returns True if the file belongs to the current language and we
6973       --  should stop searching for matching languages. Not that a given header
6974       --  file could belong to several languages (C and C++ for instance). Thus
6975       --  if we found a header we'll check whether it matches other languages.
6976 
6977       ---------------------------
6978       -- Check_File_Based_Lang --
6979       ---------------------------
6980 
6981       procedure Check_File_Based_Lang is
6982       begin
6983          if not Header_File
6984            and then Suffix_Matches (Filename, Config.Naming_Data.Body_Suffix)
6985          then
6986             Unit     := No_Name;
6987             Kind     := Impl;
6988             Language := Tmp_Lang;
6989 
6990             Debug_Output
6991               ("implementation of language ", Display_Language_Name);
6992 
6993          elsif Suffix_Matches (Filename, Config.Naming_Data.Spec_Suffix) then
6994             Debug_Output
6995               ("header of language ", Display_Language_Name);
6996 
6997             if Header_File then
6998                Alternate_Languages := new Language_List_Element'
6999                  (Language => Language,
7000                   Next     => Alternate_Languages);
7001 
7002             else
7003                Header_File := True;
7004                Kind        := Spec;
7005                Unit        := No_Name;
7006                Language    := Tmp_Lang;
7007             end if;
7008          end if;
7009       end Check_File_Based_Lang;
7010 
7011    --  Start of processing for Check_File_Naming_Schemes
7012 
7013    begin
7014       Language              := No_Language_Index;
7015       Alternate_Languages   := null;
7016       Display_Language_Name := No_Name;
7017       Unit                  := No_Name;
7018       Lang_Kind             := File_Based;
7019       Kind                  := Spec;
7020 
7021       Tmp_Lang := Project.Project.Languages;
7022       while Tmp_Lang /= No_Language_Index loop
7023          if Current_Verbosity = High then
7024             Debug_Output
7025               ("testing language "
7026                & Get_Name_String (Tmp_Lang.Name)
7027                & " Header_File=" & Header_File'Img);
7028          end if;
7029 
7030          Display_Language_Name := Tmp_Lang.Display_Name;
7031          Config := Tmp_Lang.Config;
7032          Lang_Kind := Config.Kind;
7033 
7034          case Config.Kind is
7035             when File_Based =>
7036                Check_File_Based_Lang;
7037                exit when Kind = Impl;
7038 
7039             when Unit_Based =>
7040 
7041                --  We know it belongs to a least a file_based language, no
7042                --  need to check unit-based ones.
7043 
7044                if not Header_File then
7045                   Compute_Unit_Name
7046                     (File_Name => File_Name,
7047                      Naming    => Config.Naming_Data,
7048                      Kind      => Kind,
7049                      Unit      => Unit,
7050                      Project   => Project);
7051 
7052                   if Unit /= No_Name then
7053                      Language    := Tmp_Lang;
7054                      exit;
7055                   end if;
7056                end if;
7057          end case;
7058 
7059          Tmp_Lang := Tmp_Lang.Next;
7060       end loop;
7061 
7062       if Language = No_Language_Index then
7063          Debug_Output ("not a source of any language");
7064       end if;
7065    end Check_File_Naming_Schemes;
7066 
7067    -------------------
7068    -- Override_Kind --
7069    -------------------
7070 
7071    procedure Override_Kind (Source : Source_Id; Kind : Source_Kind) is
7072    begin
7073       --  If the file was previously already associated with a unit, change it
7074 
7075       if Source.Unit /= null
7076         and then Source.Kind in Spec_Or_Body
7077         and then Source.Unit.File_Names (Source.Kind) /= null
7078       then
7079          --  If we had another file referencing the same unit (for instance it
7080          --  was in an extended project), that source file is in fact invisible
7081          --  from now on, and in particular doesn't belong to the same unit.
7082          --  If the source is an inherited naming exception, then it may not
7083          --  really exist: the source potentially replaced is left untouched.
7084 
7085          if Source.Unit.File_Names (Source.Kind) /= Source then
7086             Source.Unit.File_Names (Source.Kind).Unit := No_Unit_Index;
7087          end if;
7088 
7089          Source.Unit.File_Names (Source.Kind) := null;
7090       end if;
7091 
7092       Source.Kind := Kind;
7093 
7094       if Current_Verbosity = High and then Source.File /= No_File then
7095          Debug_Output ("override kind for "
7096                        & Get_Name_String (Source.File)
7097                        & " idx=" & Source.Index'Img
7098                        & " kind=" & Source.Kind'Img);
7099       end if;
7100 
7101       if Source.Unit /= null then
7102          if Source.Kind = Spec then
7103             Source.Unit.File_Names (Spec) := Source;
7104          else
7105             Source.Unit.File_Names (Impl) := Source;
7106          end if;
7107       end if;
7108    end Override_Kind;
7109 
7110    ----------------
7111    -- Check_File --
7112    ----------------
7113 
7114    procedure Check_File
7115      (Project           : in out Project_Processing_Data;
7116       Data              : in out Tree_Processing_Data;
7117       Source_Dir_Rank   : Natural;
7118       Path              : Path_Name_Type;
7119       Display_Path      : Path_Name_Type;
7120       File_Name         : File_Name_Type;
7121       Display_File_Name : File_Name_Type;
7122       Locally_Removed   : Boolean;
7123       For_All_Sources   : Boolean)
7124    is
7125       Name_Loc              : Name_Location :=
7126                                 Source_Names_Htable.Get
7127                                   (Project.Source_Names, File_Name);
7128       Check_Name            : Boolean := False;
7129       Alternate_Languages   : Language_List;
7130       Language              : Language_Ptr;
7131       Source                : Source_Id;
7132       Src_Ind               : Source_File_Index;
7133       Unit                  : Name_Id;
7134       Display_Language_Name : Name_Id;
7135       Lang_Kind             : Language_Kind;
7136       Kind                  : Source_Kind := Spec;
7137 
7138    begin
7139       if Current_Verbosity = High then
7140          Debug_Increase_Indent
7141            ("checking file (rank=" & Source_Dir_Rank'Img & ")",
7142             Name_Id (Display_Path));
7143       end if;
7144 
7145       if Name_Loc = No_Name_Location then
7146          Check_Name := For_All_Sources;
7147 
7148       else
7149          if Name_Loc.Found then
7150 
7151             --  Check if it is OK to have the same file name in several
7152             --  source directories.
7153 
7154             if Name_Loc.Source /= No_Source
7155               and then Source_Dir_Rank = Name_Loc.Source.Source_Dir_Rank
7156             then
7157                Error_Msg_File_1 := File_Name;
7158                Error_Msg
7159                  (Data.Flags,
7160                   "{ is found in several source directories",
7161                   Name_Loc.Location, Project.Project);
7162             end if;
7163 
7164          else
7165             Name_Loc.Found := True;
7166 
7167             Source_Names_Htable.Set
7168               (Project.Source_Names, File_Name, Name_Loc);
7169 
7170             if Name_Loc.Source = No_Source then
7171                Check_Name := True;
7172 
7173             else
7174                --  Set the full path for the source_id (which might have been
7175                --  created when parsing the naming exceptions, and therefore
7176                --  might not have the full path).
7177                --  We only set this for this source_id, but not for other
7178                --  source_id in the same file (case of multi-unit source files)
7179                --  For the latter, they will be set in Find_Sources when we
7180                --  check that all source_id have known full paths.
7181                --  Doing this later saves one htable lookup per file in the
7182                --  common case where the user is not using multi-unit files.
7183 
7184                Name_Loc.Source.Path := (Path, Display_Path);
7185 
7186                Source_Paths_Htable.Set
7187                  (Data.Tree.Source_Paths_HT, Path, Name_Loc.Source);
7188 
7189                --  Check if this is a subunit
7190 
7191                if Name_Loc.Source.Unit /= No_Unit_Index
7192                  and then Name_Loc.Source.Kind = Impl
7193                then
7194                   Src_Ind := Sinput.P.Load_Project_File
7195                     (Get_Name_String (Display_Path));
7196 
7197                   if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
7198                      Override_Kind (Name_Loc.Source, Sep);
7199                   end if;
7200                end if;
7201 
7202                --  If this is an inherited naming exception, make sure that
7203                --  the naming exception it replaces is no longer a source.
7204 
7205                if Name_Loc.Source.Naming_Exception = Inherited then
7206                   declare
7207                      Proj : Project_Id := Name_Loc.Source.Project.Extends;
7208                      Iter : Source_Iterator;
7209                      Src  : Source_Id;
7210                   begin
7211                      while Proj /= No_Project loop
7212                         Iter := For_Each_Source (Data.Tree, Proj);
7213                         Src := Prj.Element (Iter);
7214                         while Src /= No_Source loop
7215                            if Src.File = Name_Loc.Source.File then
7216                               Src.Replaced_By := Name_Loc.Source;
7217                               exit;
7218                            end if;
7219 
7220                            Next (Iter);
7221                            Src := Prj.Element (Iter);
7222                         end loop;
7223 
7224                         Proj := Proj.Extends;
7225                      end loop;
7226                   end;
7227 
7228                   if Name_Loc.Source.Unit /= No_Unit_Index then
7229                      if Name_Loc.Source.Kind = Spec then
7230                         Name_Loc.Source.Unit.File_Names (Spec) :=
7231                           Name_Loc.Source;
7232 
7233                      elsif Name_Loc.Source.Kind = Impl then
7234                         Name_Loc.Source.Unit.File_Names (Impl) :=
7235                           Name_Loc.Source;
7236                      end if;
7237 
7238                      Units_Htable.Set
7239                        (Data.Tree.Units_HT,
7240                         Name_Loc.Source.Unit.Name,
7241                         Name_Loc.Source.Unit);
7242                   end if;
7243                end if;
7244             end if;
7245          end if;
7246       end if;
7247 
7248       if Check_Name then
7249          Check_File_Naming_Schemes
7250            (Project               => Project,
7251             File_Name             => File_Name,
7252             Alternate_Languages   => Alternate_Languages,
7253             Language              => Language,
7254             Display_Language_Name => Display_Language_Name,
7255             Unit                  => Unit,
7256             Lang_Kind             => Lang_Kind,
7257             Kind                  => Kind);
7258 
7259          if Language = No_Language_Index then
7260 
7261             --  A file name in a list must be a source of a language
7262 
7263             if Data.Flags.Error_On_Unknown_Language and then Name_Loc.Found
7264             then
7265                Error_Msg_File_1 := File_Name;
7266                Error_Msg
7267                  (Data.Flags,
7268                   "language unknown for {",
7269                   Name_Loc.Location, Project.Project);
7270             end if;
7271 
7272          else
7273             Add_Source
7274               (Id                  => Source,
7275                Project             => Project.Project,
7276                Source_Dir_Rank     => Source_Dir_Rank,
7277                Lang_Id             => Language,
7278                Kind                => Kind,
7279                Data                => Data,
7280                Alternate_Languages => Alternate_Languages,
7281                File_Name           => File_Name,
7282                Display_File        => Display_File_Name,
7283                Unit                => Unit,
7284                Locally_Removed     => Locally_Removed,
7285                Path                => (Path, Display_Path));
7286 
7287             --  If it is a source specified in a list, update the entry in
7288             --  the Source_Names table.
7289 
7290             if Name_Loc.Found and then Name_Loc.Source = No_Source then
7291                Name_Loc.Source := Source;
7292                Source_Names_Htable.Set
7293                  (Project.Source_Names, File_Name, Name_Loc);
7294             end if;
7295          end if;
7296       end if;
7297 
7298       Debug_Decrease_Indent;
7299    end Check_File;
7300 
7301    ---------------------------------
7302    -- Expand_Subdirectory_Pattern --
7303    ---------------------------------
7304 
7305    procedure Expand_Subdirectory_Pattern
7306      (Project       : Project_Id;
7307       Data          : in out Tree_Processing_Data;
7308       Patterns      : String_List_Id;
7309       Ignore        : String_List_Id;
7310       Search_For    : Search_Type;
7311       Resolve_Links : Boolean)
7312    is
7313       Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
7314 
7315       package Recursive_Dirs is new GNAT.Dynamic_HTables.Simple_HTable
7316         (Header_Num => Header_Num,
7317          Element    => Boolean,
7318          No_Element => False,
7319          Key        => Path_Name_Type,
7320          Hash       => Hash,
7321          Equal      => "=");
7322       --  Hash table stores recursive source directories, to avoid looking
7323       --  several times, and to avoid cycles that may be introduced by symbolic
7324       --  links.
7325 
7326       File_Pattern : GNAT.Regexp.Regexp;
7327       --  Pattern to use when matching file names
7328 
7329       Visited : Recursive_Dirs.Instance;
7330 
7331       procedure Find_Pattern
7332         (Pattern_Id : Name_Id;
7333          Rank       : Natural;
7334          Location   : Source_Ptr);
7335       --  Find a specific pattern
7336 
7337       function Recursive_Find_Dirs
7338         (Path : Path_Information;
7339          Rank : Natural) return Boolean;
7340       --  Search all the subdirectories (recursively) of Path.
7341       --  Return True if at least one file or directory was processed
7342 
7343       function Subdirectory_Matches
7344         (Path : Path_Information;
7345          Rank : Natural) return Boolean;
7346       --  Called when a matching directory was found. If the user is in fact
7347       --  searching for files, we then search for those files matching the
7348       --  pattern within the directory.
7349       --  Return True if at least one file or directory was processed
7350 
7351       --------------------------
7352       -- Subdirectory_Matches --
7353       --------------------------
7354 
7355       function Subdirectory_Matches
7356         (Path : Path_Information;
7357          Rank : Natural) return Boolean
7358       is
7359          Dir     : Dir_Type;
7360          Name    : String (1 .. 250);
7361          Last    : Natural;
7362          Found   : Path_Information;
7363          Success : Boolean := False;
7364 
7365       begin
7366          case Search_For is
7367             when Search_Directories =>
7368                Callback (Path, Rank);
7369                return True;
7370 
7371             when Search_Files =>
7372                Open (Dir, Get_Name_String (Path.Display_Name));
7373                loop
7374                   Read (Dir, Name, Last);
7375                   exit when Last = 0;
7376 
7377                   if Name (Name'First .. Last) /= "."
7378                     and then Name (Name'First .. Last) /= ".."
7379                     and then Match (Name (Name'First .. Last), File_Pattern)
7380                   then
7381                      Get_Name_String (Path.Display_Name);
7382                      Add_Str_To_Name_Buffer (Name (Name'First .. Last));
7383 
7384                      Found.Display_Name := Name_Find;
7385                      Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
7386                      Found.Name := Name_Find;
7387 
7388                      Callback (Found, Rank);
7389                      Success := True;
7390                   end if;
7391                end loop;
7392 
7393                Close (Dir);
7394 
7395                return Success;
7396          end case;
7397       end Subdirectory_Matches;
7398 
7399       -------------------------
7400       -- Recursive_Find_Dirs --
7401       -------------------------
7402 
7403       function Recursive_Find_Dirs
7404         (Path : Path_Information;
7405          Rank : Natural) return Boolean
7406       is
7407          Path_Str : constant String := Get_Name_String (Path.Display_Name);
7408          Dir      : Dir_Type;
7409          Name     : String (1 .. 250);
7410          Last     : Natural;
7411          Success  : Boolean := False;
7412 
7413       begin
7414          Debug_Output ("looking for subdirs of ", Name_Id (Path.Display_Name));
7415 
7416          if Recursive_Dirs.Get (Visited, Path.Name) then
7417             return Success;
7418          end if;
7419 
7420          Recursive_Dirs.Set (Visited, Path.Name, True);
7421 
7422          Success := Subdirectory_Matches (Path, Rank) or Success;
7423 
7424          Open (Dir, Path_Str);
7425 
7426          loop
7427             Read (Dir, Name, Last);
7428             exit when Last = 0;
7429 
7430             if Name (1 .. Last) /= "." and then Name (1 .. Last) /= ".." then
7431                declare
7432                   Path_Name : constant String :=
7433                                 Normalize_Pathname
7434                                   (Name           => Name (1 .. Last),
7435                                    Directory      => Path_Str,
7436                                    Resolve_Links  => Resolve_Links)
7437                                 & Directory_Separator;
7438 
7439                   Path2 : Path_Information;
7440                   OK    : Boolean := True;
7441 
7442                begin
7443                   if Is_Directory (Path_Name) then
7444                      if Ignore /= Nil_String then
7445                         declare
7446                            Dir_Name : String := Name (1 .. Last);
7447                            List     : String_List_Id := Ignore;
7448 
7449                         begin
7450                            Canonical_Case_File_Name (Dir_Name);
7451 
7452                            while List /= Nil_String loop
7453                               Get_Name_String
7454                                 (Shared.String_Elements.Table (List).Value);
7455                               Canonical_Case_File_Name
7456                                 (Name_Buffer (1 .. Name_Len));
7457                               OK := Name_Buffer (1 .. Name_Len) /= Dir_Name;
7458                               exit when not OK;
7459                               List := Shared.String_Elements.Table (List).Next;
7460                            end loop;
7461                         end;
7462                      end if;
7463 
7464                      if OK then
7465                         Name_Len := 0;
7466                         Add_Str_To_Name_Buffer (Path_Name);
7467                         Path2.Display_Name := Name_Find;
7468 
7469                         Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
7470                         Path2.Name := Name_Find;
7471 
7472                         Success :=
7473                           Recursive_Find_Dirs (Path2, Rank) or Success;
7474                      end if;
7475                   end if;
7476                end;
7477             end if;
7478          end loop;
7479 
7480          Close (Dir);
7481 
7482          return Success;
7483 
7484       exception
7485          when Directory_Error =>
7486             return Success;
7487       end Recursive_Find_Dirs;
7488 
7489       ------------------
7490       -- Find_Pattern --
7491       ------------------
7492 
7493       procedure Find_Pattern
7494         (Pattern_Id : Name_Id;
7495          Rank       : Natural;
7496          Location   : Source_Ptr)
7497       is
7498          Pattern     : constant String := Get_Name_String (Pattern_Id);
7499          Pattern_End : Natural := Pattern'Last;
7500          Recursive   : Boolean;
7501          Dir         : File_Name_Type;
7502          Path_Name   : Path_Information;
7503          Dir_Exists  : Boolean;
7504          Has_Error   : Boolean := False;
7505          Success     : Boolean;
7506 
7507       begin
7508          Debug_Increase_Indent ("Find_Pattern", Pattern_Id);
7509 
7510          --  If we are looking for files, find the pattern for the files
7511 
7512          if Search_For = Search_Files then
7513             while Pattern_End >= Pattern'First
7514               and then not Is_Directory_Separator (Pattern (Pattern_End))
7515             loop
7516                Pattern_End := Pattern_End - 1;
7517             end loop;
7518 
7519             if Pattern_End = Pattern'Last then
7520                Err_Vars.Error_Msg_File_1 := File_Name_Type (Pattern_Id);
7521                Error_Or_Warning
7522                  (Data.Flags, Data.Flags.Missing_Source_Files,
7523                   "Missing file name or pattern in {", Location, Project);
7524                return;
7525             end if;
7526 
7527             if Current_Verbosity = High then
7528                Debug_Indent;
7529                Write_Str ("file_pattern=");
7530                Write_Str (Pattern (Pattern_End + 1 .. Pattern'Last));
7531                Write_Str (" dir_pattern=");
7532                Write_Line (Pattern (Pattern'First .. Pattern_End));
7533             end if;
7534 
7535             File_Pattern := Compile
7536               (Pattern (Pattern_End + 1 .. Pattern'Last),
7537                Glob           => True,
7538                Case_Sensitive => File_Names_Case_Sensitive);
7539 
7540             --  If we had just "*.gpr", this is equivalent to "./*.gpr"
7541 
7542             if Pattern_End > Pattern'First then
7543                Pattern_End := Pattern_End - 1; --  Skip directory separator
7544             end if;
7545          end if;
7546 
7547          Recursive :=
7548            Pattern_End - 1 >= Pattern'First
7549            and then Pattern (Pattern_End - 1 .. Pattern_End) = "**"
7550            and then
7551              (Pattern_End - 1 = Pattern'First
7552                or else Is_Directory_Separator (Pattern (Pattern_End - 2)));
7553 
7554          if Recursive then
7555             Pattern_End := Pattern_End - 2;
7556             if Pattern_End > Pattern'First then
7557                Pattern_End := Pattern_End - 1; --  Skip '/'
7558             end if;
7559          end if;
7560 
7561          Name_Len := Pattern_End - Pattern'First + 1;
7562          Name_Buffer (1 .. Name_Len) := Pattern (Pattern'First .. Pattern_End);
7563          Dir := Name_Find;
7564 
7565          Locate_Directory
7566            (Project     => Project,
7567             Name        => Dir,
7568             Path        => Path_Name,
7569             Dir_Exists  => Dir_Exists,
7570             Data        => Data,
7571             Must_Exist  => False);
7572 
7573          if not Dir_Exists then
7574             Err_Vars.Error_Msg_File_1 := Dir;
7575             Error_Or_Warning
7576               (Data.Flags, Data.Flags.Missing_Source_Files,
7577                "{ is not a valid directory", Location, Project);
7578             Has_Error := Data.Flags.Missing_Source_Files = Error;
7579          end if;
7580 
7581          if not Has_Error then
7582 
7583             --  Links have been resolved if necessary, and Path_Name
7584             --  always ends with a directory separator.
7585 
7586             if Recursive then
7587                Success := Recursive_Find_Dirs (Path_Name, Rank);
7588             else
7589                Success := Subdirectory_Matches (Path_Name, Rank);
7590             end if;
7591 
7592             if not Success then
7593                case Search_For is
7594                   when Search_Directories =>
7595                      null;  --  Error can't occur
7596 
7597                   when Search_Files =>
7598                      Err_Vars.Error_Msg_File_1 := File_Name_Type (Pattern_Id);
7599                      Error_Or_Warning
7600                        (Data.Flags, Data.Flags.Missing_Source_Files,
7601                         "file { not found", Location, Project);
7602                end case;
7603             end if;
7604          end if;
7605 
7606          Debug_Decrease_Indent ("done Find_Pattern");
7607       end Find_Pattern;
7608 
7609       --  Local variables
7610 
7611       Pattern_Id : String_List_Id := Patterns;
7612       Element    : String_Element;
7613       Rank       : Natural := 1;
7614 
7615    --  Start of processing for Expand_Subdirectory_Pattern
7616 
7617    begin
7618       while Pattern_Id /= Nil_String loop
7619          Element := Shared.String_Elements.Table (Pattern_Id);
7620          Find_Pattern (Element.Value, Rank, Element.Location);
7621          Rank := Rank + 1;
7622          Pattern_Id := Element.Next;
7623       end loop;
7624 
7625       Recursive_Dirs.Reset (Visited);
7626    end Expand_Subdirectory_Pattern;
7627 
7628    ------------------------
7629    -- Search_Directories --
7630    ------------------------
7631 
7632    procedure Search_Directories
7633      (Project         : in out Project_Processing_Data;
7634       Data            : in out Tree_Processing_Data;
7635       For_All_Sources : Boolean)
7636    is
7637       Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
7638 
7639       Source_Dir        : String_List_Id;
7640       Element           : String_Element;
7641       Src_Dir_Rank      : Number_List_Index;
7642       Num_Nod           : Number_Node;
7643       Dir               : Dir_Type;
7644       Name              : String (1 .. 1_000);
7645       Last              : Natural;
7646       File_Name         : File_Name_Type;
7647       Display_File_Name : File_Name_Type;
7648 
7649    begin
7650       Debug_Increase_Indent ("looking for sources of", Project.Project.Name);
7651 
7652       --  Loop through subdirectories
7653 
7654       Src_Dir_Rank := Project.Project.Source_Dir_Ranks;
7655 
7656       Source_Dir := Project.Project.Source_Dirs;
7657       while Source_Dir /= Nil_String loop
7658          begin
7659             Num_Nod := Shared.Number_Lists.Table (Src_Dir_Rank);
7660             Element := Shared.String_Elements.Table (Source_Dir);
7661 
7662             --  Use Element.Value in this test, not Display_Value, because we
7663             --  want the symbolic links to be resolved when appropriate.
7664 
7665             if Element.Value /= No_Name then
7666                declare
7667                   Source_Directory : constant String :=
7668                                        Get_Name_String (Element.Value)
7669                                        & Directory_Separator;
7670 
7671                   Dir_Last : constant Natural :=
7672                                Compute_Directory_Last (Source_Directory);
7673 
7674                   Display_Source_Directory : constant String :=
7675                                                Get_Name_String
7676                                                  (Element.Display_Value)
7677                                                   & Directory_Separator;
7678                   --  Display_Source_Directory is to allow us to open a UTF-8
7679                   --  encoded directory on Windows.
7680 
7681                begin
7682                   if Current_Verbosity = High then
7683                      Debug_Increase_Indent
7684                        ("Source_Dir (node=" & Num_Nod.Number'Img & ") """
7685                         & Source_Directory (Source_Directory'First .. Dir_Last)
7686                         & '"');
7687                   end if;
7688 
7689                   --  We look to every entry in the source directory
7690 
7691                   Open (Dir, Display_Source_Directory);
7692 
7693                   loop
7694                      Read (Dir, Name, Last);
7695                      exit when Last = 0;
7696 
7697                      --  In fast project loading mode (without -eL), the user
7698                      --  guarantees that no directory has a name which is a
7699                      --  valid source name, so we can avoid doing a system call
7700                      --  here. This provides a very significant speed up on
7701                      --  slow file systems (remote files for instance).
7702 
7703                      if not Opt.Follow_Links_For_Files
7704                        or else Is_Regular_File
7705                                  (Display_Source_Directory & Name (1 .. Last))
7706                      then
7707                         Name_Len := Last;
7708                         Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
7709                         Display_File_Name := Name_Find;
7710 
7711                         if Osint.File_Names_Case_Sensitive then
7712                            File_Name := Display_File_Name;
7713                         else
7714                            Canonical_Case_File_Name
7715                              (Name_Buffer (1 .. Name_Len));
7716                            File_Name := Name_Find;
7717                         end if;
7718 
7719                         declare
7720                            Path_Name : constant String :=
7721                                          Normalize_Pathname
7722                                            (Name (1 .. Last),
7723                                             Directory       =>
7724                                               Source_Directory
7725                                                 (Source_Directory'First ..
7726                                                  Dir_Last),
7727                                             Resolve_Links   =>
7728                                               Opt.Follow_Links_For_Files,
7729                                             Case_Sensitive => True);
7730 
7731                            Path      : Path_Name_Type;
7732                            FF        : File_Found :=
7733                                          Excluded_Sources_Htable.Get
7734                                            (Project.Excluded, File_Name);
7735                            To_Remove : Boolean := False;
7736 
7737                         begin
7738                            Name_Len := Path_Name'Length;
7739                            Name_Buffer (1 .. Name_Len) := Path_Name;
7740 
7741                            if Osint.File_Names_Case_Sensitive then
7742                               Path := Name_Find;
7743                            else
7744                               Canonical_Case_File_Name
7745                                 (Name_Buffer (1 .. Name_Len));
7746                               Path := Name_Find;
7747                            end if;
7748 
7749                            if FF /= No_File_Found then
7750                               if not FF.Found then
7751                                  FF.Found := True;
7752                                  Excluded_Sources_Htable.Set
7753                                    (Project.Excluded, File_Name, FF);
7754 
7755                                  Debug_Output
7756                                    ("excluded source ",
7757                                     Name_Id (Display_File_Name));
7758 
7759                                  --  Will mark the file as removed, but we
7760                                  --  still need to add it to the list: if we
7761                                  --  don't, the file will not appear in the
7762                                  --  mapping file and will cause the compiler
7763                                  --  to fail.
7764 
7765                                  To_Remove := True;
7766                               end if;
7767                            end if;
7768 
7769                            --  Preserve the user's original casing and use of
7770                            --  links. The display_value (a directory) already
7771                            --  ends with a directory separator by construction,
7772                            --  so no need to add one.
7773 
7774                            Get_Name_String (Element.Display_Value);
7775                            Get_Name_String_And_Append (Display_File_Name);
7776 
7777                            Check_File
7778                              (Project           => Project,
7779                               Source_Dir_Rank   => Num_Nod.Number,
7780                               Data              => Data,
7781                               Path              => Path,
7782                               Display_Path      => Name_Find,
7783                               File_Name         => File_Name,
7784                               Locally_Removed   => To_Remove,
7785                               Display_File_Name => Display_File_Name,
7786                               For_All_Sources   => For_All_Sources);
7787                         end;
7788 
7789                      else
7790                         if Current_Verbosity = High then
7791                            Debug_Output ("ignore " & Name (1 .. Last));
7792                         end if;
7793                      end if;
7794                   end loop;
7795 
7796                   Debug_Decrease_Indent;
7797                   Close (Dir);
7798                end;
7799             end if;
7800 
7801          exception
7802             when Directory_Error =>
7803                null;
7804          end;
7805 
7806          Source_Dir := Element.Next;
7807          Src_Dir_Rank := Num_Nod.Next;
7808       end loop;
7809 
7810       Debug_Decrease_Indent ("end looking for sources.");
7811    end Search_Directories;
7812 
7813    ----------------------------
7814    -- Load_Naming_Exceptions --
7815    ----------------------------
7816 
7817    procedure Load_Naming_Exceptions
7818      (Project : in out Project_Processing_Data;
7819       Data    : in out Tree_Processing_Data)
7820    is
7821       Source : Source_Id;
7822       Iter   : Source_Iterator;
7823 
7824    begin
7825       Iter := For_Each_Source (Data.Tree, Project.Project);
7826       loop
7827          Source := Prj.Element (Iter);
7828          exit when Source = No_Source;
7829 
7830          --  An excluded file cannot also be an exception file name
7831 
7832          if Excluded_Sources_Htable.Get (Project.Excluded, Source.File) /=
7833                                                                  No_File_Found
7834          then
7835             Error_Msg_File_1 := Source.File;
7836             Error_Msg
7837               (Data.Flags,
7838                "\{ cannot be both excluded and an exception file name",
7839                No_Location, Project.Project);
7840          end if;
7841 
7842          Debug_Output
7843            ("naming exception: adding source file to source_Names: ",
7844             Name_Id (Source.File));
7845 
7846          Source_Names_Htable.Set
7847            (Project.Source_Names,
7848             K => Source.File,
7849             E => Name_Location'
7850                   (Name     => Source.File,
7851                    Location => Source.Location,
7852                    Source   => Source,
7853                    Listed   => False,
7854                    Found    => False));
7855 
7856          --  If this is an Ada exception, record in table Unit_Exceptions
7857 
7858          if Source.Unit /= No_Unit_Index then
7859             declare
7860                Unit_Except : Unit_Exception :=
7861                                Unit_Exceptions_Htable.Get
7862                                  (Project.Unit_Exceptions, Source.Unit.Name);
7863 
7864             begin
7865                Unit_Except.Name := Source.Unit.Name;
7866 
7867                if Source.Kind = Spec then
7868                   Unit_Except.Spec := Source.File;
7869                else
7870                   Unit_Except.Impl := Source.File;
7871                end if;
7872 
7873                Unit_Exceptions_Htable.Set
7874                  (Project.Unit_Exceptions, Source.Unit.Name, Unit_Except);
7875             end;
7876          end if;
7877 
7878          Next (Iter);
7879       end loop;
7880    end Load_Naming_Exceptions;
7881 
7882    ----------------------
7883    -- Look_For_Sources --
7884    ----------------------
7885 
7886    procedure Look_For_Sources
7887      (Project : in out Project_Processing_Data;
7888       Data    : in out Tree_Processing_Data)
7889    is
7890       Object_Files : Object_File_Names_Htable.Instance;
7891       Iter         : Source_Iterator;
7892       Src          : Source_Id;
7893 
7894       procedure Check_Object (Src : Source_Id);
7895       --  Check if object file name of Src is already used in the project tree,
7896       --  and report an error if so.
7897 
7898       procedure Check_Object_Files;
7899       --  Check that no two sources of this project have the same object file
7900 
7901       procedure Mark_Excluded_Sources;
7902       --  Mark as such the sources that are declared as excluded
7903 
7904       procedure Check_Missing_Sources;
7905       --  Check whether one of the languages has no sources, and report an
7906       --  error when appropriate
7907 
7908       procedure Get_Sources_From_Source_Info;
7909       --  Get the source information from the tables that were created when a
7910       --  source info file was read.
7911 
7912       ---------------------------
7913       -- Check_Missing_Sources --
7914       ---------------------------
7915 
7916       procedure Check_Missing_Sources is
7917          Extending    : constant Boolean :=
7918                           Project.Project.Extends /= No_Project;
7919          Language     : Language_Ptr;
7920          Source       : Source_Id;
7921          Alt_Lang     : Language_List;
7922          Continuation : Boolean := False;
7923          Iter         : Source_Iterator;
7924       begin
7925          if not Project.Project.Externally_Built and then not Extending then
7926             Language := Project.Project.Languages;
7927             while Language /= No_Language_Index loop
7928 
7929                --  If there are no sources for this language, check if there
7930                --  are sources for which this is an alternate language.
7931 
7932                if Language.First_Source = No_Source
7933                  and then (Data.Flags.Require_Sources_Other_Lang
7934                             or else Language.Name = Name_Ada)
7935                then
7936                   Iter := For_Each_Source (In_Tree => Data.Tree,
7937                                            Project => Project.Project);
7938                   Source_Loop : loop
7939                      Source := Element (Iter);
7940                      exit Source_Loop when Source = No_Source
7941                        or else Source.Language = Language;
7942 
7943                      Alt_Lang := Source.Alternate_Languages;
7944                      while Alt_Lang /= null loop
7945                         exit Source_Loop when Alt_Lang.Language = Language;
7946                         Alt_Lang := Alt_Lang.Next;
7947                      end loop;
7948 
7949                      Next (Iter);
7950                   end loop Source_Loop;
7951 
7952                   if Source = No_Source then
7953                      Report_No_Sources
7954                        (Project.Project,
7955                         Get_Name_String (Language.Display_Name),
7956                         Data,
7957                         Project.Source_List_File_Location,
7958                         Continuation);
7959                      Continuation := True;
7960                   end if;
7961                end if;
7962 
7963                Language := Language.Next;
7964             end loop;
7965          end if;
7966       end Check_Missing_Sources;
7967 
7968       ------------------
7969       -- Check_Object --
7970       ------------------
7971 
7972       procedure Check_Object (Src : Source_Id) is
7973          Source : Source_Id;
7974 
7975       begin
7976          Source := Object_File_Names_Htable.Get (Object_Files, Src.Object);
7977 
7978          --  We cannot just check on "Source /= Src", since we might have
7979          --  two different entries for the same file (and since that's
7980          --  the same file it is expected that it has the same object)
7981 
7982          if Source /= No_Source
7983            and then Source.Replaced_By = No_Source
7984            and then Source.Path /= Src.Path
7985            and then Source.Index = 0
7986            and then Src.Index = 0
7987            and then Is_Extending (Src.Project, Source.Project)
7988          then
7989             Error_Msg_File_1 := Src.File;
7990             Error_Msg_File_2 := Source.File;
7991             Error_Msg
7992               (Data.Flags,
7993                "\{ and { have the same object file name",
7994                No_Location, Project.Project);
7995 
7996          else
7997             Object_File_Names_Htable.Set (Object_Files, Src.Object, Src);
7998          end if;
7999       end Check_Object;
8000 
8001       ---------------------------
8002       -- Mark_Excluded_Sources --
8003       ---------------------------
8004 
8005       procedure Mark_Excluded_Sources is
8006          Source   : Source_Id := No_Source;
8007          Excluded : File_Found;
8008          Proj     : Project_Id;
8009 
8010       begin
8011          --  Minor optimization: if there are no excluded files, no need to
8012          --  traverse the list of sources. We cannot however also check whether
8013          --  the existing exceptions have ".Found" set to True (indicating we
8014          --  found them before) because we need to do some final processing on
8015          --  them in any case.
8016 
8017          if Excluded_Sources_Htable.Get_First (Project.Excluded) /=
8018                                                              No_File_Found
8019          then
8020             Proj := Project.Project;
8021             while Proj /= No_Project loop
8022                Iter := For_Each_Source (Data.Tree, Proj);
8023                while Prj.Element (Iter) /= No_Source loop
8024                   Source   := Prj.Element (Iter);
8025                   Excluded := Excluded_Sources_Htable.Get
8026                     (Project.Excluded, Source.File);
8027 
8028                   if Excluded /= No_File_Found then
8029                      Source.In_Interfaces   := False;
8030                      Source.Locally_Removed := True;
8031 
8032                      if Proj = Project.Project then
8033                         Source.Suppressed := True;
8034                      end if;
8035 
8036                      if Current_Verbosity = High then
8037                         Debug_Indent;
8038                         Write_Str ("removing file ");
8039                         Write_Line
8040                           (Get_Name_String (Excluded.File)
8041                            & " " & Get_Name_String (Source.Project.Name));
8042                      end if;
8043 
8044                      Excluded_Sources_Htable.Remove
8045                        (Project.Excluded, Source.File);
8046                   end if;
8047 
8048                   Next (Iter);
8049                end loop;
8050 
8051                Proj := Proj.Extends;
8052             end loop;
8053          end if;
8054 
8055          --  If we have any excluded element left, that means we did not find
8056          --  the source file
8057 
8058          Excluded := Excluded_Sources_Htable.Get_First (Project.Excluded);
8059          while Excluded /= No_File_Found loop
8060             if not Excluded.Found then
8061 
8062                --  Check if the file belongs to another imported project to
8063                --  provide a better error message.
8064 
8065                Src := Find_Source
8066                  (In_Tree          => Data.Tree,
8067                   Project          => Project.Project,
8068                   In_Imported_Only => True,
8069                   Base_Name        => Excluded.File);
8070 
8071                Err_Vars.Error_Msg_File_1 := Excluded.File;
8072 
8073                if Src = No_Source then
8074                   if Excluded.Excl_File = No_File then
8075                      Error_Msg
8076                        (Data.Flags,
8077                         "unknown file {", Excluded.Location, Project.Project);
8078 
8079                   else
8080                      Error_Msg
8081                     (Data.Flags,
8082                      "in " &
8083                      Get_Name_String (Excluded.Excl_File) & ":" &
8084                      No_Space_Img (Excluded.Excl_Line) &
8085                      ": unknown file {", Excluded.Location, Project.Project);
8086                   end if;
8087 
8088                else
8089                   if Excluded.Excl_File = No_File then
8090                      Error_Msg
8091                        (Data.Flags,
8092                         "cannot remove a source from an imported project: {",
8093                         Excluded.Location, Project.Project);
8094 
8095                   else
8096                      Error_Msg
8097                        (Data.Flags,
8098                         "in " &
8099                         Get_Name_String (Excluded.Excl_File) & ":" &
8100                           No_Space_Img (Excluded.Excl_Line) &
8101                         ": cannot remove a source from an imported project: {",
8102                         Excluded.Location, Project.Project);
8103                   end if;
8104                end if;
8105             end if;
8106 
8107             Excluded := Excluded_Sources_Htable.Get_Next (Project.Excluded);
8108          end loop;
8109       end Mark_Excluded_Sources;
8110 
8111       ------------------------
8112       -- Check_Object_Files --
8113       ------------------------
8114 
8115       procedure Check_Object_Files is
8116          Iter    : Source_Iterator;
8117          Src_Id  : Source_Id;
8118          Src_Ind : Source_File_Index;
8119 
8120       begin
8121          Iter := For_Each_Source (Data.Tree);
8122          loop
8123             Src_Id := Prj.Element (Iter);
8124             exit when Src_Id = No_Source;
8125 
8126             if Is_Compilable (Src_Id)
8127               and then Src_Id.Language.Config.Object_Generated
8128               and then Is_Extending (Project.Project, Src_Id.Project)
8129             then
8130                if Src_Id.Unit = No_Unit_Index then
8131                   if Src_Id.Kind = Impl then
8132                      Check_Object (Src_Id);
8133                   end if;
8134 
8135                else
8136                   case Src_Id.Kind is
8137                      when Spec =>
8138                         if Other_Part (Src_Id) = No_Source then
8139                            Check_Object (Src_Id);
8140                         end if;
8141 
8142                      when Sep =>
8143                         null;
8144 
8145                      when Impl =>
8146                         if Other_Part (Src_Id) /= No_Source then
8147                            Check_Object (Src_Id);
8148 
8149                         else
8150                            --  Check if it is a subunit
8151 
8152                            Src_Ind :=
8153                              Sinput.P.Load_Project_File
8154                                (Get_Name_String (Src_Id.Path.Display_Name));
8155 
8156                            if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
8157                               Override_Kind (Src_Id, Sep);
8158                            else
8159                               Check_Object (Src_Id);
8160                            end if;
8161                         end if;
8162                   end case;
8163                end if;
8164             end if;
8165 
8166             Next (Iter);
8167          end loop;
8168       end Check_Object_Files;
8169 
8170       ----------------------------------
8171       -- Get_Sources_From_Source_Info --
8172       ----------------------------------
8173 
8174       procedure Get_Sources_From_Source_Info is
8175          Iter    : Source_Info_Iterator;
8176          Src     : Source_Info;
8177          Id      : Source_Id;
8178          Lang_Id : Language_Ptr;
8179 
8180       begin
8181          Initialize (Iter, Project.Project.Name);
8182 
8183          loop
8184             Src := Source_Info_Of (Iter);
8185 
8186             exit when Src = No_Source_Info;
8187 
8188             Id := new Source_Data;
8189 
8190             Id.Project := Project.Project;
8191 
8192             Lang_Id := Project.Project.Languages;
8193             while Lang_Id /= No_Language_Index
8194               and then Lang_Id.Name /= Src.Language
8195             loop
8196                Lang_Id := Lang_Id.Next;
8197             end loop;
8198 
8199             if Lang_Id = No_Language_Index then
8200                Prj.Com.Fail
8201                  ("unknown language " &
8202                   Get_Name_String (Src.Language) &
8203                   " for project " &
8204                   Get_Name_String (Src.Project) &
8205                   " in source info file");
8206             end if;
8207 
8208             Id.Language := Lang_Id;
8209             Id.Kind     := Src.Kind;
8210             Id.Index    := Src.Index;
8211 
8212             Id.Path :=
8213               (Path_Name_Type (Src.Display_Path_Name),
8214                Path_Name_Type (Src.Path_Name));
8215 
8216             Name_Len := 0;
8217             Add_Str_To_Name_Buffer
8218               (Directories.Simple_Name (Get_Name_String (Src.Path_Name)));
8219             Id.File := Name_Find;
8220 
8221             Id.Next_With_File_Name :=
8222               Source_Files_Htable.Get (Data.Tree.Source_Files_HT, Id.File);
8223             Source_Files_Htable.Set (Data.Tree.Source_Files_HT, Id.File, Id);
8224 
8225             Name_Len := 0;
8226             Add_Str_To_Name_Buffer
8227               (Directories.Simple_Name
8228                  (Get_Name_String (Src.Display_Path_Name)));
8229             Id.Display_File := Name_Find;
8230 
8231             Id.Dep_Name         :=
8232               Dependency_Name (Id.File, Id.Language.Config.Dependency_Kind);
8233             Id.Naming_Exception := Src.Naming_Exception;
8234             Id.Object           :=
8235               Object_Name (Id.File, Id.Language.Config.Object_File_Suffix);
8236             Id.Switches         := Switches_Name (Id.File);
8237 
8238             --  Add the source id to the Unit_Sources_HT hash table, if the
8239             --  unit name is not null.
8240 
8241             if Src.Kind /= Sep and then Src.Unit_Name /= No_Name then
8242                declare
8243                   UData : Unit_Index :=
8244                     Units_Htable.Get (Data.Tree.Units_HT, Src.Unit_Name);
8245                begin
8246                   if UData = No_Unit_Index then
8247                      UData := new Unit_Data;
8248                      UData.Name := Src.Unit_Name;
8249                      Units_Htable.Set
8250                        (Data.Tree.Units_HT, Src.Unit_Name, UData);
8251                   end if;
8252 
8253                   Id.Unit := UData;
8254                end;
8255 
8256                --  Note that this updates Unit information as well
8257 
8258                Override_Kind (Id, Id.Kind);
8259             end if;
8260 
8261             if Src.Index /= 0 then
8262                Project.Project.Has_Multi_Unit_Sources := True;
8263             end if;
8264 
8265             --  Add the source to the language list
8266 
8267             Id.Next_In_Lang := Id.Language.First_Source;
8268             Id.Language.First_Source := Id;
8269 
8270             Next (Iter);
8271          end loop;
8272       end Get_Sources_From_Source_Info;
8273 
8274    --  Start of processing for Look_For_Sources
8275 
8276    begin
8277       if Data.Tree.Source_Info_File_Exists then
8278          Get_Sources_From_Source_Info;
8279 
8280       else
8281          if Project.Project.Source_Dirs /= Nil_String then
8282             Find_Excluded_Sources (Project, Data);
8283 
8284             if Project.Project.Languages /= No_Language_Index then
8285                Load_Naming_Exceptions (Project, Data);
8286                Find_Sources (Project, Data);
8287                Mark_Excluded_Sources;
8288                Check_Object_Files;
8289                Check_Missing_Sources;
8290             end if;
8291          end if;
8292 
8293          Object_File_Names_Htable.Reset (Object_Files);
8294       end if;
8295    end Look_For_Sources;
8296 
8297    ------------------
8298    -- Path_Name_Of --
8299    ------------------
8300 
8301    function Path_Name_Of
8302      (File_Name : File_Name_Type;
8303       Directory : Path_Name_Type) return String
8304    is
8305       Result        : String_Access;
8306       The_Directory : constant String := Get_Name_String (Directory);
8307 
8308    begin
8309       Debug_Output ("Path_Name_Of file name=", Name_Id (File_Name));
8310       Debug_Output ("Path_Name_Of directory=", Name_Id (Directory));
8311       Get_Name_String (File_Name);
8312       Result :=
8313         Locate_Regular_File
8314           (File_Name => Name_Buffer (1 .. Name_Len),
8315            Path      => The_Directory);
8316 
8317       if Result = null then
8318          return "";
8319       else
8320          declare
8321             R : constant String := Result.all;
8322          begin
8323             Free (Result);
8324             return R;
8325          end;
8326       end if;
8327    end Path_Name_Of;
8328 
8329    -------------------
8330    -- Remove_Source --
8331    -------------------
8332 
8333    procedure Remove_Source
8334      (Tree        : Project_Tree_Ref;
8335       Id          : Source_Id;
8336       Replaced_By : Source_Id)
8337    is
8338       Source : Source_Id;
8339 
8340    begin
8341       if Current_Verbosity = High then
8342          Debug_Indent;
8343          Write_Str ("removing source ");
8344          Write_Str (Get_Name_String (Id.File));
8345 
8346          if Id.Index /= 0 then
8347             Write_Str (" at" & Id.Index'Img);
8348          end if;
8349 
8350          Write_Eol;
8351       end if;
8352 
8353       if Replaced_By /= No_Source then
8354          Id.Replaced_By := Replaced_By;
8355          Replaced_By.Declared_In_Interfaces := Id.Declared_In_Interfaces;
8356 
8357          if Id.File /= Replaced_By.File then
8358             declare
8359                Replacement : constant File_Name_Type :=
8360                                Replaced_Source_HTable.Get
8361                                  (Tree.Replaced_Sources, Id.File);
8362 
8363             begin
8364                Replaced_Source_HTable.Set
8365                  (Tree.Replaced_Sources, Id.File, Replaced_By.File);
8366 
8367                if Replacement = No_File then
8368                   Tree.Replaced_Source_Number :=
8369                     Tree.Replaced_Source_Number + 1;
8370                end if;
8371             end;
8372          end if;
8373       end if;
8374 
8375       Id.In_Interfaces := False;
8376       Id.Locally_Removed := True;
8377 
8378       --  ??? Should we remove the source from the unit ? The file is not used,
8379       --  so probably should not be referenced from the unit. On the other hand
8380       --  it might give useful additional info
8381       --        if Id.Unit /= null then
8382       --           Id.Unit.File_Names (Id.Kind) := null;
8383       --        end if;
8384 
8385       Source := Id.Language.First_Source;
8386 
8387       if Source = Id then
8388          Id.Language.First_Source := Id.Next_In_Lang;
8389 
8390       else
8391          while Source.Next_In_Lang /= Id loop
8392             Source := Source.Next_In_Lang;
8393          end loop;
8394 
8395          Source.Next_In_Lang := Id.Next_In_Lang;
8396       end if;
8397    end Remove_Source;
8398 
8399    -----------------------
8400    -- Report_No_Sources --
8401    -----------------------
8402 
8403    procedure Report_No_Sources
8404      (Project      : Project_Id;
8405       Lang_Name    : String;
8406       Data         : Tree_Processing_Data;
8407       Location     : Source_Ptr;
8408       Continuation : Boolean := False)
8409    is
8410    begin
8411       case Data.Flags.When_No_Sources is
8412          when Silent =>
8413             null;
8414 
8415          when Warning | Error =>
8416             declare
8417                Msg : constant String :=
8418                       "<there are no "
8419                       & Lang_Name & " sources in this project";
8420 
8421             begin
8422                Error_Msg_Warn := Data.Flags.When_No_Sources = Warning;
8423 
8424                if Continuation then
8425                   Error_Msg (Data.Flags, "\" & Msg, Location, Project);
8426                else
8427                   Error_Msg (Data.Flags, Msg, Location, Project);
8428                end if;
8429             end;
8430       end case;
8431    end Report_No_Sources;
8432 
8433    ----------------------
8434    -- Show_Source_Dirs --
8435    ----------------------
8436 
8437    procedure Show_Source_Dirs
8438      (Project : Project_Id;
8439       Shared  : Shared_Project_Tree_Data_Access)
8440    is
8441       Current : String_List_Id;
8442       Element : String_Element;
8443 
8444    begin
8445       if Project.Source_Dirs = Nil_String then
8446          Debug_Output ("no Source_Dirs");
8447       else
8448          Debug_Increase_Indent ("Source_Dirs:");
8449 
8450          Current := Project.Source_Dirs;
8451          while Current /= Nil_String loop
8452             Element := Shared.String_Elements.Table (Current);
8453             Debug_Output (Get_Name_String (Element.Display_Value));
8454             Current := Element.Next;
8455          end loop;
8456 
8457          Debug_Decrease_Indent ("end Source_Dirs.");
8458       end if;
8459    end Show_Source_Dirs;
8460 
8461    ---------------------------
8462    -- Process_Naming_Scheme --
8463    ---------------------------
8464 
8465    procedure Process_Naming_Scheme
8466      (Tree         : Project_Tree_Ref;
8467       Root_Project : Project_Id;
8468       Node_Tree    : Prj.Tree.Project_Node_Tree_Ref;
8469       Flags        : Processing_Flags)
8470    is
8471 
8472       procedure Check
8473         (Project          : Project_Id;
8474          In_Aggregate_Lib : Boolean;
8475          Data             : in out Tree_Processing_Data);
8476       --  Process the naming scheme for a single project
8477 
8478       procedure Recursive_Check
8479         (Project  : Project_Id;
8480          Prj_Tree : Project_Tree_Ref;
8481          Context  : Project_Context;
8482          Data     : in out Tree_Processing_Data);
8483       --  Check_Naming_Scheme for the project
8484 
8485       -----------
8486       -- Check --
8487       -----------
8488 
8489       procedure Check
8490         (Project          : Project_Id;
8491          In_Aggregate_Lib : Boolean;
8492          Data             : in out Tree_Processing_Data)
8493       is
8494          procedure Check_Aggregated;
8495          --  Check aggregated projects which should not be externally built
8496 
8497          ----------------------
8498          -- Check_Aggregated --
8499          ----------------------
8500 
8501          procedure Check_Aggregated is
8502             L : Aggregated_Project_List;
8503 
8504          begin
8505             --  Check that aggregated projects are not externally built
8506 
8507             L := Project.Aggregated_Projects;
8508             while L /= null loop
8509                declare
8510                   Var : constant Prj.Variable_Value :=
8511                           Prj.Util.Value_Of
8512                             (Snames.Name_Externally_Built,
8513                              L.Project.Decl.Attributes,
8514                              Data.Tree.Shared);
8515                begin
8516                   if not Var.Default then
8517                      Error_Msg_Name_1 := L.Project.Display_Name;
8518                      Error_Msg
8519                        (Data.Flags,
8520                         "cannot aggregate externally built project %%",
8521                         Var.Location, Project);
8522                   end if;
8523                end;
8524 
8525                L := L.Next;
8526             end loop;
8527          end Check_Aggregated;
8528 
8529          --  Local Variables
8530 
8531          Shared   : constant Shared_Project_Tree_Data_Access :=
8532                       Data.Tree.Shared;
8533          Prj_Data : Project_Processing_Data;
8534 
8535       --  Start of processing for Check
8536 
8537       begin
8538          Debug_Increase_Indent ("check", Project.Name);
8539 
8540          Initialize (Prj_Data, Project);
8541 
8542          Check_If_Externally_Built (Project, Data);
8543 
8544          case Project.Qualifier is
8545             when Aggregate =>
8546                Check_Aggregated;
8547 
8548             when Aggregate_Library =>
8549                Check_Aggregated;
8550 
8551                if Project.Object_Directory = No_Path_Information then
8552                   Project.Object_Directory := Project.Directory;
8553                end if;
8554 
8555             when others =>
8556                Get_Directories (Project, Data);
8557                Check_Programming_Languages (Project, Data);
8558 
8559                if Current_Verbosity = High then
8560                   Show_Source_Dirs (Project, Shared);
8561                end if;
8562 
8563                if Project.Qualifier = Abstract_Project then
8564                   Check_Abstract_Project (Project, Data);
8565                end if;
8566          end case;
8567 
8568          --  Check configuration. Must be done for gnatmake (even though no
8569          --  user configuration file was provided) since the default config we
8570          --  generate indicates whether libraries are supported for instance.
8571 
8572          Check_Configuration (Project, Data);
8573 
8574          if Project.Qualifier /= Aggregate then
8575             Check_Library_Attributes (Project, Data);
8576             Check_Package_Naming (Project, Data);
8577 
8578             --  An aggregate library has no source, no need to look for them
8579 
8580             if Project.Qualifier /= Aggregate_Library then
8581                Look_For_Sources (Prj_Data, Data);
8582             end if;
8583 
8584             Check_Interfaces (Project, Data);
8585 
8586             --  If this library is part of an aggregated library don't check it
8587             --  as it has no sources by itself and so interface won't be found.
8588 
8589             if Project.Library and not In_Aggregate_Lib then
8590                Check_Stand_Alone_Library (Project, Data);
8591             end if;
8592 
8593             Get_Mains (Project, Data);
8594          end if;
8595 
8596          Free (Prj_Data);
8597 
8598          Debug_Decrease_Indent ("done check");
8599       end Check;
8600 
8601       ---------------------
8602       -- Recursive_Check --
8603       ---------------------
8604 
8605       procedure Recursive_Check
8606         (Project  : Project_Id;
8607          Prj_Tree : Project_Tree_Ref;
8608          Context  : Project_Context;
8609          Data     : in out Tree_Processing_Data)
8610       is
8611       begin
8612          if Current_Verbosity = High then
8613             Debug_Increase_Indent
8614               ("Processing_Naming_Scheme for project", Project.Name);
8615          end if;
8616 
8617          Data.Tree := Prj_Tree;
8618          Data.In_Aggregate_Lib := Context.In_Aggregate_Lib;
8619 
8620          Check (Project, Context.In_Aggregate_Lib, Data);
8621 
8622          if Current_Verbosity = High then
8623             Debug_Decrease_Indent ("done Processing_Naming_Scheme");
8624          end if;
8625       end Recursive_Check;
8626 
8627       procedure Check_All_Projects is new For_Every_Project_Imported_Context
8628         (Tree_Processing_Data, Recursive_Check);
8629       --  Comment required???
8630 
8631       --  Local Variables
8632 
8633       Data : Tree_Processing_Data;
8634 
8635    --  Start of processing for Process_Naming_Scheme
8636 
8637    begin
8638       Lib_Data_Table.Init;
8639       Initialize (Data, Tree => Tree, Node_Tree => Node_Tree, Flags => Flags);
8640       Check_All_Projects (Root_Project, Tree, Data, Imported_First => True);
8641       Free (Data);
8642 
8643       --  Adjust language configs for projects that are extended
8644 
8645       declare
8646          List : Project_List;
8647          Proj : Project_Id;
8648          Exte : Project_Id;
8649          Lang : Language_Ptr;
8650          Elng : Language_Ptr;
8651 
8652       begin
8653          List := Tree.Projects;
8654          while List /= null loop
8655             Proj := List.Project;
8656 
8657             Exte := Proj;
8658             while Exte.Extended_By /= No_Project loop
8659                Exte := Exte.Extended_By;
8660             end loop;
8661 
8662             if Exte /= Proj then
8663                Lang := Proj.Languages;
8664 
8665                if Lang /= No_Language_Index then
8666                   loop
8667                      Elng := Get_Language_From_Name
8668                        (Exte, Get_Name_String (Lang.Name));
8669                      exit when Elng /= No_Language_Index;
8670                      Exte := Exte.Extends;
8671                   end loop;
8672 
8673                   if Elng /= Lang then
8674                      Lang.Config := Elng.Config;
8675                   end if;
8676                end if;
8677             end if;
8678 
8679             List := List.Next;
8680          end loop;
8681       end;
8682    end Process_Naming_Scheme;
8683 
8684 end Prj.Nmsc;