gcc/ada/prj-nmsc.adb

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