gcc/ada/prj-nmsc.adb

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