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