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