gcc/ada/prj-nmsc.adb

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