gcc/ada/prj-nmsc.adb

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