gcc/ada/prj-nmsc.adb

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