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