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