gcc/ada/prj-nmsc.adb

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