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