gcc/ada/prj-nmsc.adb

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