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