gcc/ada/prj-nmsc.adb

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