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