gcc/ada/prj-nmsc.adb

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