gcc/ada/prj-nmsc.adb

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