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