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