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