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