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