gcc/ada/prj-nmsc.adb

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