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