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