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