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