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