gcc/ada/prj-nmsc.adb

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