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