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