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