gcc/ada/prj-nmsc.adb

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