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