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