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