gcc/ada/prj-nmsc.adb

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