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