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