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