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