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-2008, 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.HTable;
  29
  30 with Err_Vars; use Err_Vars;
  31 with Fmap;     use Fmap;
  32 with Hostparm;
  33 with MLib.Tgt;
  34 with Opt;      use Opt;
  35 with Osint;    use Osint;
  36 with Output;   use Output;
  37 with Prj.Env;  use Prj.Env;
  38 with Prj.Err;
  39 with Prj.Util; use Prj.Util;
  40 with Sinput.P;
  41 with Snames;   use Snames;
  42 with Table;    use Table;
  43 with Targparm; use Targparm;
  44
  45 with Ada.Characters.Handling;    use Ada.Characters.Handling;
  46 with Ada.Directories;            use Ada.Directories;
  47 with Ada.Strings;                use Ada.Strings;
  48 with Ada.Strings.Fixed;          use Ada.Strings.Fixed;
  49 with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
  50
  51 package body Prj.Nmsc is
  52
  53    No_Continuation_String : aliased String := "";
  54    Continuation_String    : aliased String := "\";
  55    --  Used in Check_Library for continuation error messages at the same
  56    --  location.
  57
  58    Error_Report : Put_Line_Access := null;
  59    --  Set to point to error reporting procedure
  60
  61    When_No_Sources : Error_Warning := Error;
  62    --  Indicates what should be done when there is no Ada sources in a non
  63    --  extending Ada project.
  64
  65    ALI_Suffix   : constant String := ".ali";
  66    --  File suffix for ali files
  67
  68    type Name_Location is record
  69       Name     : File_Name_Type;
  70       Location : Source_Ptr;
  71       Source   : Source_Id := No_Source;
  72       Except   : Boolean := False;
  73       Found    : Boolean := False;
  74    end record;
  75    --  Information about file names found in string list attribute
  76    --  Source_Files or in a source list file, stored in hash table
  77    --  Source_Names, used by procedure Get_Path_Names_And_Record_Sources.
  78
  79    No_Name_Location : constant Name_Location :=
  80                         (Name     => No_File,
  81                          Location => No_Location,
  82                          Source   => No_Source,
  83                          Except   => False,
  84                          Found    => False);
  85
  86    package Source_Names is new GNAT.HTable.Simple_HTable
  87      (Header_Num => Header_Num,
  88       Element    => Name_Location,
  89       No_Element => No_Name_Location,
  90       Key        => File_Name_Type,
  91       Hash       => Hash,
  92       Equal      => "=");
  93    --  Hash table to store file names found in string list attribute
  94    --  Source_Files or in a source list file, stored in hash table
  95    --  Source_Names, used by procedure Get_Path_Names_And_Record_Sources.
  96
  97    --  More documentation needed on what unit exceptions are about ???
  98
  99    type Unit_Exception is record
 100       Name : Name_Id;
 101       Spec : File_Name_Type;
 102       Impl : File_Name_Type;
 103    end record;
 104
 105    No_Unit_Exception : constant Unit_Exception :=
 106                          (Name => No_Name,
 107                           Spec => No_File,
 108                           Impl => No_File);
 109
 110    package Unit_Exceptions is new GNAT.HTable.Simple_HTable
 111      (Header_Num => Header_Num,
 112       Element    => Unit_Exception,
 113       No_Element => No_Unit_Exception,
 114       Key        => Name_Id,
 115       Hash       => Hash,
 116       Equal      => "=");
 117    --  Hash table to store the unit exceptions
 118
 119    package Recursive_Dirs is new GNAT.HTable.Simple_HTable
 120      (Header_Num => Header_Num,
 121       Element    => Boolean,
 122       No_Element => False,
 123       Key        => Name_Id,
 124       Hash       => Hash,
 125       Equal      => "=");
 126    --  Hash table to store recursive source directories, to avoid looking
 127    --  several times, and to avoid cycles that may be introduced by symbolic
 128    --  links.
 129
 130    type Ada_Naming_Exception_Id is new Nat;
 131    No_Ada_Naming_Exception : constant Ada_Naming_Exception_Id := 0;
 132
 133    type Unit_Info is record
 134       Kind : Spec_Or_Body;
 135       Unit : Name_Id;
 136       Next : Ada_Naming_Exception_Id := No_Ada_Naming_Exception;
 137    end record;
 138    --  Comment needed???
 139
 140    --  Why is the following commented out ???
 141    --  No_Unit : constant Unit_Info :=
 142    --              (Specification, No_Name, No_Ada_Naming_Exception);
 143
 144    package Ada_Naming_Exception_Table is new Table.Table
 145      (Table_Component_Type => Unit_Info,
 146       Table_Index_Type     => Ada_Naming_Exception_Id,
 147       Table_Low_Bound      => 1,
 148       Table_Initial        => 20,
 149       Table_Increment      => 100,
 150       Table_Name           => "Prj.Nmsc.Ada_Naming_Exception_Table");
 151
 152    package Ada_Naming_Exceptions is new GNAT.HTable.Simple_HTable
 153      (Header_Num => Header_Num,
 154       Element    => Ada_Naming_Exception_Id,
 155       No_Element => No_Ada_Naming_Exception,
 156       Key        => File_Name_Type,
 157       Hash       => Hash,
 158       Equal      => "=");
 159    --  A hash table to store naming exceptions for Ada. For each file name
 160    --  there is one or several unit in table Ada_Naming_Exception_Table.
 161
 162    package Object_File_Names is new GNAT.HTable.Simple_HTable
 163      (Header_Num => Header_Num,
 164       Element    => File_Name_Type,
 165       No_Element => No_File,
 166       Key        => File_Name_Type,
 167       Hash       => Hash,
 168       Equal      => "=");
 169    --  A hash table to store the object file names for a project, to check that
 170    --  two different sources have different object file names.
 171
 172    type File_Found is record
 173       File     : File_Name_Type  := No_File;
 174       Found    : Boolean         := False;
 175       Location : Source_Ptr      := No_Location;
 176    end record;
 177    No_File_Found : constant File_Found := (No_File, False, No_Location);
 178    --  Comments needed ???
 179
 180    package Excluded_Sources_Htable is new GNAT.HTable.Simple_HTable
 181      (Header_Num => Header_Num,
 182       Element    => File_Found,
 183       No_Element => No_File_Found,
 184       Key        => File_Name_Type,
 185       Hash       => Hash,
 186       Equal      => "=");
 187    --  A hash table to store the excluded files, if any. This is filled by
 188    --  Find_Excluded_Sources below.
 189
 190    procedure Find_Excluded_Sources
 191      (Project : Project_Id;
 192       In_Tree : Project_Tree_Ref;
 193       Data    : Project_Data);
 194    --  Find the list of files that should not be considered as source files
 195    --  for this project. Sets the list in the Excluded_Sources_Htable.
 196
 197    function Hash (Unit : Unit_Info) return Header_Num;
 198
 199    type Name_And_Index is record
 200       Name  : Name_Id := No_Name;
 201       Index : Int     := 0;
 202    end record;
 203    No_Name_And_Index : constant Name_And_Index :=
 204                          (Name => No_Name, Index => 0);
 205
 206    package Reverse_Ada_Naming_Exceptions is new GNAT.HTable.Simple_HTable
 207      (Header_Num => Header_Num,
 208       Element    => Name_And_Index,
 209       No_Element => No_Name_And_Index,
 210       Key        => Unit_Info,
 211       Hash       => Hash,
 212       Equal      => "=");
 213    --  A table to check if a unit with an exceptional name will hide a source
 214    --  with a file name following the naming convention.
 215
 216    procedure Add_Source
 217      (Id                  : out Source_Id;
 218       Data                : in out Project_Data;
 219       In_Tree             : Project_Tree_Ref;
 220       Project             : Project_Id;
 221       Lang                : Name_Id;
 222       Lang_Id             : Language_Index;
 223       Kind                : Source_Kind;
 224       File_Name           : File_Name_Type;
 225       Display_File        : File_Name_Type;
 226       Lang_Kind           : Language_Kind;
 227       Naming_Exception    : Boolean := False;
 228       Path                : Path_Name_Type := No_Path;
 229       Display_Path        : Path_Name_Type := No_Path;
 230       Alternate_Languages : Alternate_Language_Id := No_Alternate_Language;
 231       Other_Part          : Source_Id := No_Source;
 232       Unit                : Name_Id   := No_Name;
 233       Index               : Int       := 0;
 234       Source_To_Replace   : Source_Id := No_Source);
 235    --  Add a new source to the different lists: list of all sources in the
 236    --  project tree, list of source of a project and list of sources of a
 237    --  language.
 238    --
 239    --  If Path is specified, the file is also added to Source_Paths_HT.
 240    --  If Source_To_Replace is specified, it points to the source in the
 241    --  extended project that the new file is overriding.
 242
 243    function ALI_File_Name (Source : String) return String;
 244    --  Return the ALI file name corresponding to a source
 245
 246    procedure Check_Ada_Name (Name : String; Unit : out Name_Id);
 247    --  Check that a name is a valid Ada unit name
 248
 249    procedure Check_Naming_Schemes
 250      (Data    : in out Project_Data;
 251       Project : Project_Id;
 252       In_Tree : Project_Tree_Ref);
 253    --  Check the naming scheme part of Data
 254
 255    procedure Check_Ada_Naming_Scheme_Validity
 256      (Project : Project_Id;
 257       In_Tree : Project_Tree_Ref;
 258       Naming  : Naming_Data);
 259    --  Check that the package Naming is correct
 260
 261    procedure Check_Configuration
 262      (Project : Project_Id;
 263       In_Tree : Project_Tree_Ref;
 264       Data    : in out Project_Data);
 265    --  Check the configuration attributes for the project
 266
 267    procedure Check_If_Externally_Built
 268      (Project : Project_Id;
 269       In_Tree : Project_Tree_Ref;
 270       Data    : in out Project_Data);
 271    --  Check attribute Externally_Built of project Project in project tree
 272    --  In_Tree and modify its data Data if it has the value "true".
 273
 274    procedure Check_Interfaces
 275      (Project : Project_Id;
 276       In_Tree : Project_Tree_Ref;
 277       Data    : in out Project_Data);
 278    --  If a list of sources is specified in attribute Interfaces, set
 279    --  In_Interfaces only for the sources specified in the list.
 280
 281    procedure Check_Library_Attributes
 282      (Project     : Project_Id;
 283       In_Tree     : Project_Tree_Ref;
 284       Current_Dir : String;
 285       Data        : in out Project_Data);
 286    --  Check the library attributes of project Project in project tree In_Tree
 287    --  and modify its data Data accordingly.
 288    --  Current_Dir should represent the current directory, and is passed for
 289    --  efficiency to avoid system calls to recompute it.
 290
 291    procedure Check_Package_Naming
 292      (Project : Project_Id;
 293       In_Tree : Project_Tree_Ref;
 294       Data    : in out Project_Data);
 295    --  Check package Naming of project Project in project tree In_Tree and
 296    --  modify its data Data accordingly.
 297
 298    procedure Check_Programming_Languages
 299      (In_Tree : Project_Tree_Ref;
 300       Project : Project_Id;
 301       Data    : in out Project_Data);
 302    --  Check attribute Languages for the project with data Data in project
 303    --  tree In_Tree and set the components of Data for all the programming
 304    --  languages indicated in attribute Languages, if any.
 305
 306    function Check_Project
 307      (P            : Project_Id;
 308       Root_Project : Project_Id;
 309       In_Tree      : Project_Tree_Ref;
 310       Extending    : Boolean) return Boolean;
 311    --  Returns True if P is Root_Project or, if Extending is True, a project
 312    --  extended by Root_Project.
 313
 314    procedure Check_Stand_Alone_Library
 315      (Project     : Project_Id;
 316       In_Tree     : Project_Tree_Ref;
 317       Data        : in out Project_Data;
 318       Current_Dir : String;
 319       Extending   : Boolean);
 320    --  Check if project Project in project tree In_Tree is a Stand-Alone
 321    --  Library project, and modify its data Data accordingly if it is one.
 322    --  Current_Dir should represent the current directory, and is passed for
 323    --  efficiency to avoid system calls to recompute it.
 324
 325    procedure Get_Path_Names_And_Record_Ada_Sources
 326      (Project     : Project_Id;
 327       In_Tree     : Project_Tree_Ref;
 328       Data        : in out Project_Data;
 329       Current_Dir : String);
 330    --  Find the path names of the source files in the Source_Names table
 331    --  in the source directories and record those that are Ada sources.
 332
 333    function Compute_Directory_Last (Dir : String) return Natural;
 334    --  Return the index of the last significant character in Dir. This is used
 335    --  to avoid duplicate '/' (slash) characters at the end of directory names.
 336
 337    procedure Error_Msg
 338      (Project       : Project_Id;
 339       In_Tree       : Project_Tree_Ref;
 340       Msg           : String;
 341       Flag_Location : Source_Ptr);
 342    --  Output an error message. If Error_Report is null, simply call
 343    --  Prj.Err.Error_Msg. Otherwise, disregard Flag_Location and use
 344    --  Error_Report.
 345
 346    procedure Find_Ada_Sources
 347      (Project      : Project_Id;
 348       In_Tree      : Project_Tree_Ref;
 349       Data         : in out Project_Data;
 350       Current_Dir  : String);
 351    --  Find all the Ada sources in all of the source directories of a project
 352    --  Current_Dir should represent the current directory, and is passed for
 353    --  efficiency to avoid system calls to recompute it.
 354
 355    procedure Search_Directories
 356      (Project         : Project_Id;
 357       In_Tree         : Project_Tree_Ref;
 358       Data            : in out Project_Data;
 359       For_All_Sources : Boolean);
 360    --  Search the source directories to find the sources.
 361    --  If For_All_Sources is True, check each regular file name against the
 362    --  naming schemes of the different languages. Otherwise consider only the
 363    --  file names in the hash table Source_Names.
 364
 365    procedure Check_File
 366      (Project           : Project_Id;
 367       In_Tree           : Project_Tree_Ref;
 368       Data              : in out Project_Data;
 369       Name              : String;
 370       File_Name         : File_Name_Type;
 371       Display_File_Name : File_Name_Type;
 372       Source_Directory  : String;
 373       For_All_Sources   : Boolean);
 374    --  Check if file File_Name is a valid source of the project. This is used
 375    --  in multi-language mode only.
 376    --  When the file matches one of the naming schemes, it is added to
 377    --  various htables through Add_Source and to Source_Paths_Htable.
 378    --
 379    --  Name is the name of the candidate file. It hasn't been normalized yet
 380    --  and is the direct result of readdir().
 381    --
 382    --  File_Name is the same as Name, but has been normalized.
 383    --  Display_File_Name, however, has not been normalized.
 384    --
 385    --  Source_Directory is the directory in which the file
 386    --  was found. It hasn't been normalized (nor has had links resolved).
 387    --  It should not end with a directory separator, to avoid duplicates
 388    --  later on.
 389    --
 390    --  If For_All_Sources is True, then all possible file names are analyzed
 391    --  otherwise only those currently set in the Source_Names htable.
 392
 393    procedure Check_Naming_Schemes
 394      (In_Tree               : Project_Tree_Ref;
 395       Data                  : in out Project_Data;
 396       Filename              : String;
 397       File_Name             : File_Name_Type;
 398       Alternate_Languages   : out Alternate_Language_Id;
 399       Language              : out Language_Index;
 400       Language_Name         : out Name_Id;
 401       Display_Language_Name : out Name_Id;
 402       Unit                  : out Name_Id;
 403       Lang_Kind             : out Language_Kind;
 404       Kind                  : out Source_Kind);
 405    --  Check if the file name File_Name conforms to one of the naming
 406    --  schemes of the project.
 407    --
 408    --  If the file does not match one of the naming schemes, set Language
 409    --  to No_Language_Index.
 410    --
 411    --  Filename is the name of the file being investigated. It has been
 412    --  normalized (case-folded). File_Name is the same value.
 413
 414    procedure Free_Ada_Naming_Exceptions;
 415    --  Free the internal hash tables used for checking naming exceptions
 416
 417    procedure Get_Directories
 418      (Project : Project_Id;
 419       In_Tree : Project_Tree_Ref;
 420       Current_Dir : String;
 421       Data    : in out Project_Data);
 422    --  Get the object directory, the exec directory and the source directories
 423    --  of a project.
 424    --
 425    --  Current_Dir should represent the current directory, and is passed for
 426    --  efficiency to avoid system calls to recompute it.
 427
 428    procedure Get_Mains
 429      (Project : Project_Id;
 430       In_Tree : Project_Tree_Ref;
 431       Data    : in out Project_Data);
 432    --  Get the mains of a project from attribute Main, if it exists, and put
 433    --  them in the project data.
 434
 435    procedure Get_Sources_From_File
 436      (Path     : String;
 437       Location : Source_Ptr;
 438       Project  : Project_Id;
 439       In_Tree  : Project_Tree_Ref);
 440    --  Get the list of sources from a text file and put them in hash table
 441    --  Source_Names.
 442
 443    procedure Find_Explicit_Sources
 444      (Current_Dir : String;
 445       Project     : Project_Id;
 446       In_Tree     : Project_Tree_Ref;
 447       Data        : in out Project_Data);
 448    --  Process the Source_Files and Source_List_File attributes, and store
 449    --  the list of source files into the Source_Names htable.
 450    --
 451    --  Lang indicates which language is being processed when in Ada_Only mode
 452    --  (all languages are processed anyway when in Multi_Language mode).
 453
 454    procedure Get_Unit
 455      (In_Tree             : Project_Tree_Ref;
 456       Canonical_File_Name : File_Name_Type;
 457       Naming              : Naming_Data;
 458       Exception_Id        : out Ada_Naming_Exception_Id;
 459       Unit_Name           : out Name_Id;
 460       Unit_Kind           : out Spec_Or_Body;
 461       Needs_Pragma        : out Boolean);
 462    --  Find out, from a file name, the unit name, the unit kind and if a
 463    --  specific SFN pragma is needed. If the file name corresponds to no unit,
 464    --  then Unit_Name will be No_Name. If the file is a multi-unit source or an
 465    --  exception to the naming scheme, then Exception_Id is set to the unit or
 466    --  units that the source contains.
 467
 468    function Is_Illegal_Suffix
 469      (Suffix                          : String;
 470       Dot_Replacement_Is_A_Single_Dot : Boolean) return Boolean;
 471    --  Returns True if the string Suffix cannot be used as a spec suffix, a
 472    --  body suffix or a separate suffix.
 473
 474    procedure Locate_Directory
 475      (Project  : Project_Id;
 476       In_Tree  : Project_Tree_Ref;
 477       Name     : File_Name_Type;
 478       Parent   : Path_Name_Type;
 479       Dir      : out Path_Name_Type;
 480       Display  : out Path_Name_Type;
 481       Create   : String := "";
 482       Current_Dir : String;
 483       Location : Source_Ptr := No_Location);
 484    --  Locate a directory. Name is the directory name. Parent is the root
 485    --  directory, if Name a relative path name. Dir is set to the canonical
 486    --  case path name of the directory, and Display is the directory path name
 487    --  for display purposes. If the directory does not exist and Project_Setup
 488    --  is True and Create is a non null string, an attempt is made to create
 489    --  the directory. If the directory does not exist and Project_Setup is
 490    --  false, then Dir and Display are set to No_Name.
 491    --
 492    --  Current_Dir should represent the current directory, and is passed for
 493    --  efficiency to avoid system calls to recompute it.
 494
 495    procedure Look_For_Sources
 496      (Project     : Project_Id;
 497       In_Tree     : Project_Tree_Ref;
 498       Data        : in out Project_Data;
 499       Current_Dir : String);
 500    --  Find all the sources of project Project in project tree In_Tree and
 501    --  update its Data accordingly.
 502    --
 503    --  Current_Dir should represent the current directory, and is passed for
 504    --  efficiency to avoid system calls to recompute it.
 505
 506    function Path_Name_Of
 507      (File_Name : File_Name_Type;
 508       Directory : Path_Name_Type) return String;
 509    --  Returns the path name of a (non project) file. Returns an empty string
 510    --  if file cannot be found.
 511
 512    procedure Prepare_Ada_Naming_Exceptions
 513      (List    : Array_Element_Id;
 514       In_Tree : Project_Tree_Ref;
 515       Kind    : Spec_Or_Body);
 516    --  Prepare the internal hash tables used for checking naming exceptions
 517    --  for Ada. Insert all elements of List in the tables.
 518
 519    function Project_Extends
 520      (Extending : Project_Id;
 521       Extended  : Project_Id;
 522       In_Tree   : Project_Tree_Ref) return Boolean;
 523    --  Returns True if Extending is extending Extended either directly or
 524    --  indirectly.
 525
 526    procedure Record_Ada_Source
 527      (File_Name       : File_Name_Type;
 528       Path_Name       : Path_Name_Type;
 529       Project         : Project_Id;
 530       In_Tree         : Project_Tree_Ref;
 531       Data            : in out Project_Data;
 532       Location        : Source_Ptr;
 533       Current_Source  : in out String_List_Id;
 534       Source_Recorded : in out Boolean;
 535       Current_Dir     : String);
 536    --  Put a unit in the list of units of a project, if the file name
 537    --  corresponds to a valid unit name.
 538    --
 539    --  Current_Dir should represent the current directory, and is passed for
 540    --  efficiency to avoid system calls to recompute it.
 541
 542    procedure Remove_Source
 543      (Id          : Source_Id;
 544       Replaced_By : Source_Id;
 545       Project     : Project_Id;
 546       Data        : in out Project_Data;
 547       In_Tree     : Project_Tree_Ref);
 548    --  ??? needs comment
 549
 550    procedure Report_No_Sources
 551      (Project      : Project_Id;
 552       Lang_Name    : String;
 553       In_Tree      : Project_Tree_Ref;
 554       Location     : Source_Ptr;
 555       Continuation : Boolean := False);
 556    --  Report an error or a warning depending on the value of When_No_Sources
 557    --  when there are no sources for language Lang_Name.
 558
 559    procedure Show_Source_Dirs
 560      (Data : Project_Data; In_Tree : Project_Tree_Ref);
 561    --  List all the source directories of a project
 562
 563    procedure Warn_If_Not_Sources
 564      (Project     : Project_Id;
 565       In_Tree     : Project_Tree_Ref;
 566       Conventions : Array_Element_Id;
 567       Specs       : Boolean;
 568       Extending   : Boolean);
 569    --  Check that individual naming conventions apply to immediate sources of
 570    --  the project. If not, issue a warning.
 571
 572    ----------------
 573    -- Add_Source --
 574    ----------------
 575
 576    procedure Add_Source
 577      (Id                  : out Source_Id;
 578       Data                : in out Project_Data;
 579       In_Tree             : Project_Tree_Ref;
 580       Project             : Project_Id;
 581       Lang                : Name_Id;
 582       Lang_Id             : Language_Index;
 583       Kind                : Source_Kind;
 584       File_Name           : File_Name_Type;
 585       Display_File        : File_Name_Type;
 586       Lang_Kind           : Language_Kind;
 587       Naming_Exception    : Boolean := False;
 588       Path                : Path_Name_Type := No_Path;
 589       Display_Path        : Path_Name_Type := No_Path;
 590       Alternate_Languages : Alternate_Language_Id := No_Alternate_Language;
 591       Other_Part          : Source_Id := No_Source;
 592       Unit                : Name_Id   := No_Name;
 593       Index               : Int       := 0;
 594       Source_To_Replace   : Source_Id := No_Source)
 595    is
 596       Source   : constant Source_Id := Data.Last_Source;
 597       Src_Data : Source_Data := No_Source_Data;
 598       Config   : constant Language_Config :=
 599                    In_Tree.Languages_Data.Table (Lang_Id).Config;
 600
 601    begin
 602       --  This is a new source so create an entry for it in the Sources table
 603
 604       Source_Data_Table.Increment_Last (In_Tree.Sources);
 605       Id := Source_Data_Table.Last (In_Tree.Sources);
 606
 607       if Current_Verbosity = High then
 608          Write_Str ("Adding source #");
 609          Write_Str (Id'Img);
 610          Write_Str (", File : ");
 611          Write_Str (Get_Name_String (File_Name));
 612
 613          if Lang_Kind = Unit_Based then
 614             Write_Str (", Unit : ");
 615             Write_Str (Get_Name_String (Unit));
 616          end if;
 617
 618          Write_Eol;
 619       end if;
 620
 621       Src_Data.Project             := Project;
 622       Src_Data.Language_Name       := Lang;
 623       Src_Data.Language            := Lang_Id;
 624       Src_Data.Lang_Kind           := Lang_Kind;
 625       Src_Data.Compiled            := In_Tree.Languages_Data.Table
 626                                         (Lang_Id).Config.Compiler_Driver /=
 627                                                               Empty_File_Name;
 628       Src_Data.Kind                := Kind;
 629       Src_Data.Alternate_Languages := Alternate_Languages;
 630       Src_Data.Other_Part          := Other_Part;
 631
 632       Src_Data.Object_Exists := Config.Object_Generated;
 633       Src_Data.Object_Linked := Config.Objects_Linked;
 634
 635       if Other_Part /= No_Source then
 636          In_Tree.Sources.Table (Other_Part).Other_Part := Id;
 637       end if;
 638
 639       Src_Data.Unit                := Unit;
 640       Src_Data.Index               := Index;
 641       Src_Data.File                := File_Name;
 642       Src_Data.Display_File        := Display_File;
 643       Src_Data.Dependency          := In_Tree.Languages_Data.Table
 644                                         (Lang_Id).Config.Dependency_Kind;
 645       Src_Data.Naming_Exception    := Naming_Exception;
 646
 647       if Src_Data.Compiled and then Src_Data.Object_Exists then
 648          Src_Data.Object   := Object_Name (File_Name);
 649          Src_Data.Dep_Name :=
 650            Dependency_Name (File_Name, Src_Data.Dependency);
 651          Src_Data.Switches := Switches_Name (File_Name);
 652       end if;
 653
 654       if Path /= No_Path then
 655          Src_Data.Path := (Path, Display_Path);
 656          Source_Paths_Htable.Set (In_Tree.Source_Paths_HT, Path, Id);
 657       end if;
 658
 659       --  Add the source id to the Unit_Sources_HT hash table, if the unit name
 660       --  is not null.
 661
 662       if Unit /= No_Name then
 663          Unit_Sources_Htable.Set (In_Tree.Unit_Sources_HT, Unit, Id);
 664       end if;
 665
 666       --  Add the source to the global list
 667
 668       Src_Data.Next_In_Sources := In_Tree.First_Source;
 669       In_Tree.First_Source := Id;
 670
 671       --  Add the source to the project list
 672
 673       if Source = No_Source then
 674          Data.First_Source := Id;
 675       else
 676          In_Tree.Sources.Table (Source).Next_In_Project := Id;
 677       end if;
 678
 679       Data.Last_Source := Id;
 680
 681       --  Add the source to the language list
 682
 683       Src_Data.Next_In_Lang :=
 684         In_Tree.Languages_Data.Table (Lang_Id).First_Source;
 685       In_Tree.Languages_Data.Table (Lang_Id).First_Source := Id;
 686
 687       In_Tree.Sources.Table (Id) := Src_Data;
 688
 689       if Source_To_Replace /= No_Source then
 690          Remove_Source (Source_To_Replace, Id, Project, Data, In_Tree);
 691       end if;
 692    end Add_Source;
 693
 694    -------------------
 695    -- ALI_File_Name --
 696    -------------------
 697
 698    function ALI_File_Name (Source : String) return String is
 699    begin
 700       --  If the source name has an extension, then replace it with
 701       --  the ALI suffix.
 702
 703       for Index in reverse Source'First + 1 .. Source'Last loop
 704          if Source (Index) = '.' then
 705             return Source (Source'First .. Index - 1) & ALI_Suffix;
 706          end if;
 707       end loop;
 708
 709       --  If there is no dot, or if it is the first character, just add the
 710       --  ALI suffix.
 711
 712       return Source & ALI_Suffix;
 713    end ALI_File_Name;
 714
 715    -----------
 716    -- Check --
 717    -----------
 718
 719    procedure Check
 720      (Project         : Project_Id;
 721       In_Tree         : Project_Tree_Ref;
 722       Report_Error    : Put_Line_Access;
 723       When_No_Sources : Error_Warning;
 724       Current_Dir     : String)
 725    is
 726       Data      : Project_Data := In_Tree.Projects.Table (Project);
 727       Extending : Boolean := False;
 728
 729    begin
 730       Nmsc.When_No_Sources := When_No_Sources;
 731       Error_Report := Report_Error;
 732
 733       Recursive_Dirs.Reset;
 734
 735       Check_If_Externally_Built (Project, In_Tree, Data);
 736
 737       --  Object, exec and source directories
 738
 739       Get_Directories (Project, In_Tree, Current_Dir, Data);
 740
 741       --  Get the programming languages
 742
 743       Check_Programming_Languages (In_Tree, Project, Data);
 744
 745       if Data.Qualifier = Dry and then Data.Source_Dirs /= Nil_String then
 746          Error_Msg
 747            (Project, In_Tree,
 748             "an abstract project need to have no language, no sources or no " &
 749             "source directories",
 750             Data.Location);
 751       end if;
 752
 753       --  Check configuration in multi language mode
 754
 755       if Must_Check_Configuration then
 756          Check_Configuration (Project, In_Tree, Data);
 757       end if;
 758
 759       --  Library attributes
 760
 761       Check_Library_Attributes (Project, In_Tree, Current_Dir, Data);
 762
 763       if Current_Verbosity = High then
 764          Show_Source_Dirs (Data, In_Tree);
 765       end if;
 766
 767       Check_Package_Naming (Project, In_Tree, Data);
 768
 769       Extending := Data.Extends /= No_Project;
 770
 771       Check_Naming_Schemes (Data, Project, In_Tree);
 772
 773       if Get_Mode = Ada_Only then
 774          Prepare_Ada_Naming_Exceptions
 775            (Data.Naming.Bodies, In_Tree, Body_Part);
 776          Prepare_Ada_Naming_Exceptions
 777            (Data.Naming.Specs, In_Tree, Specification);
 778       end if;
 779
 780       --  Find the sources
 781
 782       if Data.Source_Dirs /= Nil_String then
 783          Look_For_Sources (Project, In_Tree, Data, Current_Dir);
 784
 785          if Get_Mode = Ada_Only then
 786
 787             --  Check that all individual naming conventions apply to sources
 788             --  of this project file.
 789
 790             Warn_If_Not_Sources
 791               (Project, In_Tree, Data.Naming.Bodies,
 792                Specs     => False,
 793                Extending => Extending);
 794             Warn_If_Not_Sources
 795               (Project, In_Tree, Data.Naming.Specs,
 796                Specs     => True,
 797                Extending => Extending);
 798
 799          elsif Get_Mode = Multi_Language and then
 800                (not Data.Externally_Built) and then
 801                (not Extending)
 802          then
 803             declare
 804                Language      : Language_Index;
 805                Source        : Source_Id;
 806                Alt_Lang      : Alternate_Language_Id;
 807                Alt_Lang_Data : Alternate_Language_Data;
 808                Continuation  : Boolean := False;
 809
 810             begin
 811                Language := Data.First_Language_Processing;
 812                while Language /= No_Language_Index loop
 813                   Source := Data.First_Source;
 814                   Source_Loop : while Source /= No_Source loop
 815                      declare
 816                         Src_Data : Source_Data renames
 817                                      In_Tree.Sources.Table (Source);
 818
 819                      begin
 820                         exit Source_Loop when Src_Data.Language = Language;
 821
 822                         Alt_Lang := Src_Data.Alternate_Languages;
 823
 824                         Alternate_Loop :
 825                         while Alt_Lang /= No_Alternate_Language loop
 826                            Alt_Lang_Data :=
 827                              In_Tree.Alt_Langs.Table (Alt_Lang);
 828                            exit Source_Loop
 829                            when Alt_Lang_Data.Language = Language;
 830                            Alt_Lang := Alt_Lang_Data.Next;
 831                         end loop Alternate_Loop;
 832
 833                         Source := Src_Data.Next_In_Project;
 834                      end;
 835                   end loop Source_Loop;
 836
 837                   if Source = No_Source then
 838                      Report_No_Sources
 839                        (Project,
 840                         Get_Name_String
 841                           (In_Tree.Languages_Data.Table
 842                              (Language).Display_Name),
 843                         In_Tree,
 844                         Data.Location,
 845                         Continuation);
 846                      Continuation := True;
 847                   end if;
 848
 849                   Language := In_Tree.Languages_Data.Table (Language).Next;
 850                end loop;
 851             end;
 852          end if;
 853       end if;
 854
 855       if Get_Mode = Multi_Language then
 856
 857          --  If a list of sources is specified in attribute Interfaces, set
 858          --  In_Interfaces only for the sources specified in the list.
 859
 860          Check_Interfaces (Project, In_Tree, Data);
 861       end if;
 862
 863       --  If it is a library project file, check if it is a standalone library
 864
 865       if Data.Library then
 866          Check_Stand_Alone_Library
 867            (Project, In_Tree, Data, Current_Dir, Extending);
 868       end if;
 869
 870       --  Put the list of Mains, if any, in the project data
 871
 872       Get_Mains (Project, In_Tree, Data);
 873
 874       --  Update the project data in the Projects table
 875
 876       In_Tree.Projects.Table (Project) := Data;
 877
 878       Free_Ada_Naming_Exceptions;
 879    end Check;
 880
 881    --------------------
 882    -- Check_Ada_Name --
 883    --------------------
 884
 885    procedure Check_Ada_Name (Name : String; Unit : out Name_Id) is
 886       The_Name        : String := Name;
 887       Real_Name       : Name_Id;
 888       Need_Letter     : Boolean := True;
 889       Last_Underscore : Boolean := False;
 890       OK              : Boolean := The_Name'Length > 0;
 891       First           : Positive;
 892
 893       function Is_Reserved (Name : Name_Id) return Boolean;
 894       function Is_Reserved (S    : String)  return Boolean;
 895       --  Check that the given name is not an Ada 95 reserved word. The reason
 896       --  for the Ada 95 here is that we do not want to exclude the case of an
 897       --  Ada 95 unit called Interface (for example). In Ada 2005, such a unit
 898       --  name would be rejected anyway by the compiler. That means there is no
 899       --  requirement that the project file parser reject this.
 900
 901       -----------------
 902       -- Is_Reserved --
 903       -----------------
 904
 905       function Is_Reserved (S : String) return Boolean is
 906       begin
 907          Name_Len := 0;
 908          Add_Str_To_Name_Buffer (S);
 909          return Is_Reserved (Name_Find);
 910       end Is_Reserved;
 911
 912       -----------------
 913       -- Is_Reserved --
 914       -----------------
 915
 916       function Is_Reserved (Name : Name_Id) return Boolean is
 917       begin
 918          if Get_Name_Table_Byte (Name) /= 0
 919            and then Name /= Name_Project
 920            and then Name /= Name_Extends
 921            and then Name /= Name_External
 922            and then Name not in Ada_2005_Reserved_Words
 923          then
 924             Unit := No_Name;
 925
 926             if Current_Verbosity = High then
 927                Write_Str (The_Name);
 928                Write_Line (" is an Ada reserved word.");
 929             end if;
 930
 931             return True;
 932
 933          else
 934             return False;
 935          end if;
 936       end Is_Reserved;
 937
 938    --  Start of processing for Check_Ada_Name
 939
 940    begin
 941       To_Lower (The_Name);
 942
 943       Name_Len := The_Name'Length;
 944       Name_Buffer (1 .. Name_Len) := The_Name;
 945
 946       --  Special cases of children of packages A, G, I and S on VMS
 947
 948       if OpenVMS_On_Target
 949         and then Name_Len > 3
 950         and then Name_Buffer (2 .. 3) = "__"
 951         and then
 952           ((Name_Buffer (1) = 'a') or else
 953            (Name_Buffer (1) = 'g') or else
 954            (Name_Buffer (1) = 'i') or else
 955            (Name_Buffer (1) = 's'))
 956       then
 957          Name_Buffer (2) := '.';
 958          Name_Buffer (3 .. Name_Len - 1) := Name_Buffer (4 .. Name_Len);
 959          Name_Len := Name_Len - 1;
 960       end if;
 961
 962       Real_Name := Name_Find;
 963
 964       if Is_Reserved (Real_Name) then
 965          return;
 966       end if;
 967
 968       First := The_Name'First;
 969
 970       for Index in The_Name'Range loop
 971          if Need_Letter then
 972
 973             --  We need a letter (at the beginning, and following a dot),
 974             --  but we don't have one.
 975
 976             if Is_Letter (The_Name (Index)) then
 977                Need_Letter := False;
 978
 979             else
 980                OK := False;
 981
 982                if Current_Verbosity = High then
 983                   Write_Int  (Types.Int (Index));
 984                   Write_Str  (": '");
 985                   Write_Char (The_Name (Index));
 986                   Write_Line ("' is not a letter.");
 987                end if;
 988
 989                exit;
 990             end if;
 991
 992          elsif Last_Underscore
 993            and then (The_Name (Index) = '_' or else The_Name (Index) = '.')
 994          then
 995             --  Two underscores are illegal, and a dot cannot follow
 996             --  an underscore.
 997
 998             OK := False;
 999
1000             if Current_Verbosity = High then
1001                Write_Int  (Types.Int (Index));
1002                Write_Str  (": '");
1003                Write_Char (The_Name (Index));
1004                Write_Line ("' is illegal here.");
1005             end if;
1006
1007             exit;
1008
1009          elsif The_Name (Index) = '.' then
1010
1011             --  First, check if the name before the dot is not a reserved word
1012             if Is_Reserved (The_Name (First .. Index - 1)) then
1013                return;
1014             end if;
1015
1016             First := Index + 1;
1017
1018             --  We need a letter after a dot
1019
1020             Need_Letter := True;
1021
1022          elsif The_Name (Index) = '_' then
1023             Last_Underscore := True;
1024
1025          else
1026             --  We need an letter or a digit
1027
1028             Last_Underscore := False;
1029
1030             if not Is_Alphanumeric (The_Name (Index)) then
1031                OK := False;
1032
1033                if Current_Verbosity = High then
1034                   Write_Int  (Types.Int (Index));
1035                   Write_Str  (": '");
1036                   Write_Char (The_Name (Index));
1037                   Write_Line ("' is not alphanumeric.");
1038                end if;
1039
1040                exit;
1041             end if;
1042          end if;
1043       end loop;
1044
1045       --  Cannot end with an underscore or a dot
1046
1047       OK := OK and then not Need_Letter and then not Last_Underscore;
1048
1049       if OK then
1050          if First /= Name'First and then
1051            Is_Reserved (The_Name (First .. The_Name'Last))
1052          then
1053             return;
1054          end if;
1055
1056          Unit := Real_Name;
1057
1058       else
1059          --  Signal a problem with No_Name
1060
1061          Unit := No_Name;
1062       end if;
1063    end Check_Ada_Name;
1064
1065    --------------------------------------
1066    -- Check_Ada_Naming_Scheme_Validity --
1067    --------------------------------------
1068
1069    procedure Check_Ada_Naming_Scheme_Validity
1070      (Project : Project_Id;
1071       In_Tree : Project_Tree_Ref;
1072       Naming  : Naming_Data)
1073    is
1074    begin
1075       --  Only check if we are not using the Default naming scheme
1076
1077       if Naming /= In_Tree.Private_Part.Default_Naming then
1078          declare
1079             Dot_Replacement : constant String :=
1080                                 Get_Name_String
1081                                   (Naming.Dot_Replacement);
1082
1083             Spec_Suffix : constant String :=
1084                                   Spec_Suffix_Of (In_Tree, "ada", Naming);
1085
1086             Body_Suffix : constant String :=
1087                                   Body_Suffix_Of (In_Tree, "ada", Naming);
1088
1089             Separate_Suffix : constant String :=
1090                                 Get_Name_String
1091                                   (Naming.Separate_Suffix);
1092
1093          begin
1094             --  Dot_Replacement cannot
1095
1096             --   - be empty
1097             --   - start or end with an alphanumeric
1098             --   - be a single '_'
1099             --   - start with an '_' followed by an alphanumeric
1100             --   - contain a '.' except if it is "."
1101
1102             if Dot_Replacement'Length = 0
1103               or else Is_Alphanumeric
1104                         (Dot_Replacement (Dot_Replacement'First))
1105               or else Is_Alphanumeric
1106                         (Dot_Replacement (Dot_Replacement'Last))
1107               or else (Dot_Replacement (Dot_Replacement'First) = '_'
1108                         and then
1109                         (Dot_Replacement'Length = 1
1110                           or else
1111                            Is_Alphanumeric
1112                              (Dot_Replacement (Dot_Replacement'First + 1))))
1113               or else (Dot_Replacement'Length > 1
1114                          and then
1115                            Index (Source => Dot_Replacement,
1116                                   Pattern => ".") /= 0)
1117             then
1118                Error_Msg
1119                  (Project, In_Tree,
1120                   '"' & Dot_Replacement &
1121                   """ is illegal for Dot_Replacement.",
1122                   Naming.Dot_Repl_Loc);
1123             end if;
1124
1125             --  Suffixes cannot
1126             --   - be empty
1127
1128             if Is_Illegal_Suffix
1129                  (Spec_Suffix, Dot_Replacement = ".")
1130             then
1131                Err_Vars.Error_Msg_File_1 :=
1132                  Spec_Suffix_Id_Of (In_Tree, Name_Ada, Naming);
1133                Error_Msg
1134                  (Project, In_Tree,
1135                   "{ is illegal for Spec_Suffix",
1136                   Naming.Ada_Spec_Suffix_Loc);
1137             end if;
1138
1139             if Is_Illegal_Suffix
1140                  (Body_Suffix, Dot_Replacement = ".")
1141             then
1142                Err_Vars.Error_Msg_File_1 :=
1143                  Body_Suffix_Id_Of (In_Tree, Name_Ada, Naming);
1144                Error_Msg
1145                  (Project, In_Tree,
1146                   "{ is illegal for Body_Suffix",
1147                   Naming.Ada_Body_Suffix_Loc);
1148             end if;
1149
1150             if Body_Suffix /= Separate_Suffix then
1151                if Is_Illegal_Suffix
1152                     (Separate_Suffix, Dot_Replacement = ".")
1153                then
1154                   Err_Vars.Error_Msg_File_1 := Naming.Separate_Suffix;
1155                   Error_Msg
1156                     (Project, In_Tree,
1157                      "{ is illegal for Separate_Suffix",
1158                      Naming.Sep_Suffix_Loc);
1159                end if;
1160             end if;
1161
1162             --  Spec_Suffix cannot be equal to Body_Suffix Separate_Suffix,
1163             --  since that would cause a clear ambiguity. Note that we do
1164             --  allow a Spec_Suffix to have the same termination as one of
1165             --  these, which causes a potential ambiguity, but we resolve
1166             --  that my matching the longest possible suffix.
1167
1168             if Spec_Suffix = Body_Suffix then
1169                Error_Msg
1170                  (Project, In_Tree,
1171                   "Body_Suffix (""" &
1172                   Body_Suffix &
1173                   """) cannot be the same as Spec_Suffix.",
1174                   Naming.Ada_Body_Suffix_Loc);
1175             end if;
1176
1177             if Body_Suffix /= Separate_Suffix
1178               and then Spec_Suffix = Separate_Suffix
1179             then
1180                Error_Msg
1181                  (Project, In_Tree,
1182                   "Separate_Suffix (""" &
1183                   Separate_Suffix &
1184                   """) cannot be the same as Spec_Suffix.",
1185                   Naming.Sep_Suffix_Loc);
1186             end if;
1187          end;
1188       end if;
1189    end Check_Ada_Naming_Scheme_Validity;
1190
1191    -------------------------
1192    -- Check_Configuration --
1193    -------------------------
1194
1195    procedure Check_Configuration
1196      (Project : Project_Id;
1197       In_Tree : Project_Tree_Ref;
1198       Data    : in out Project_Data)
1199    is
1200       Dot_Replacement : File_Name_Type := No_File;
1201       Casing          : Casing_Type    := All_Lower_Case;
1202       Separate_Suffix : File_Name_Type := No_File;
1203
1204       Lang_Index : Language_Index := No_Language_Index;
1205       --  The index of the language data being checked
1206
1207       Prev_Index : Language_Index := No_Language_Index;
1208       --  The index of the previous language
1209
1210       Current_Language : Name_Id := No_Name;
1211       --  The name of the language
1212
1213       Lang_Data : Language_Data;
1214       --  The data of the language being checked
1215
1216       procedure Get_Language_Index_Of (Language : Name_Id);
1217       --  Get the language index of Language, if Language is one of the
1218       --  languages of the project.
1219
1220       procedure Process_Project_Level_Simple_Attributes;
1221       --  Process the simple attributes at the project level
1222
1223       procedure Process_Project_Level_Array_Attributes;
1224       --  Process the associate array attributes at the project level
1225
1226       procedure Process_Packages;
1227       --  Read the packages of the project
1228
1229       ---------------------------
1230       -- Get_Language_Index_Of --
1231       ---------------------------
1232
1233       procedure Get_Language_Index_Of (Language : Name_Id) is
1234          Real_Language : Name_Id;
1235
1236       begin
1237          Get_Name_String (Language);
1238          To_Lower (Name_Buffer (1 .. Name_Len));
1239          Real_Language := Name_Find;
1240
1241          --  Nothing to do if the language is the same as the current language
1242
1243          if Current_Language /= Real_Language then
1244             Lang_Index := Data.First_Language_Processing;
1245             while Lang_Index /= No_Language_Index loop
1246                exit when In_Tree.Languages_Data.Table (Lang_Index).Name =
1247                  Real_Language;
1248                Lang_Index :=
1249                  In_Tree.Languages_Data.Table (Lang_Index).Next;
1250             end loop;
1251
1252             if Lang_Index = No_Language_Index then
1253                Current_Language := No_Name;
1254             else
1255                Current_Language := Real_Language;
1256             end if;
1257          end if;
1258       end Get_Language_Index_Of;
1259
1260       ----------------------
1261       -- Process_Packages --
1262       ----------------------
1263
1264       procedure Process_Packages is
1265          Packages : Package_Id;
1266          Element  : Package_Element;
1267
1268          procedure Process_Binder (Arrays : Array_Id);
1269          --  Process the associate array attributes of package Binder
1270
1271          procedure Process_Builder (Attributes : Variable_Id);
1272          --  Process the simple attributes of package Builder
1273
1274          procedure Process_Compiler (Arrays : Array_Id);
1275          --  Process the associate array attributes of package Compiler
1276
1277          procedure Process_Naming (Attributes : Variable_Id);
1278          --  Process the simple attributes of package Naming
1279
1280          procedure Process_Naming (Arrays : Array_Id);
1281          --  Process the associate array attributes of package Naming
1282
1283          procedure Process_Linker (Attributes : Variable_Id);
1284          --  Process the simple attributes of package Linker of a
1285          --  configuration project.
1286
1287          --------------------
1288          -- Process_Binder --
1289          --------------------
1290
1291          procedure Process_Binder (Arrays : Array_Id) is
1292             Current_Array_Id : Array_Id;
1293             Current_Array    : Array_Data;
1294             Element_Id       : Array_Element_Id;
1295             Element          : Array_Element;
1296
1297          begin
1298             --  Process the associative array attribute of package Binder
1299
1300             Current_Array_Id := Arrays;
1301             while Current_Array_Id /= No_Array loop
1302                Current_Array := In_Tree.Arrays.Table (Current_Array_Id);
1303
1304                Element_Id := Current_Array.Value;
1305                while Element_Id /= No_Array_Element loop
1306                   Element := In_Tree.Array_Elements.Table (Element_Id);
1307
1308                   if Element.Index /= All_Other_Names then
1309
1310                      --  Get the name of the language
1311
1312                      Get_Language_Index_Of (Element.Index);
1313
1314                      if Lang_Index /= No_Language_Index then
1315                         case Current_Array.Name is
1316                         when Name_Driver =>
1317
1318                            --  Attribute Driver (<language>)
1319
1320                            In_Tree.Languages_Data.Table
1321                              (Lang_Index).Config.Binder_Driver :=
1322                              File_Name_Type (Element.Value.Value);
1323
1324                         when Name_Required_Switches =>
1325                            Put (Into_List =>
1326                                 In_Tree.Languages_Data.Table
1327                                   (Lang_Index).Config.Binder_Required_Switches,
1328                                 From_List => Element.Value.Values,
1329                                 In_Tree   => In_Tree);
1330
1331                         when Name_Prefix =>
1332
1333                            --  Attribute Prefix (<language>)
1334
1335                            In_Tree.Languages_Data.Table
1336                              (Lang_Index).Config.Binder_Prefix :=
1337                              Element.Value.Value;
1338
1339                         when Name_Objects_Path =>
1340
1341                            --  Attribute Objects_Path (<language>)
1342
1343                            In_Tree.Languages_Data.Table
1344                              (Lang_Index).Config.Objects_Path :=
1345                              Element.Value.Value;
1346
1347                         when Name_Objects_Path_File =>
1348
1349                            --  Attribute Objects_Path (<language>)
1350
1351                            In_Tree.Languages_Data.Table
1352                              (Lang_Index).Config.Objects_Path_File :=
1353                              Element.Value.Value;
1354
1355                         when others =>
1356                            null;
1357                         end case;
1358                      end if;
1359                   end if;
1360
1361                   Element_Id := Element.Next;
1362                end loop;
1363
1364                Current_Array_Id := Current_Array.Next;
1365             end loop;
1366          end Process_Binder;
1367
1368          ---------------------
1369          -- Process_Builder --
1370          ---------------------
1371
1372          procedure Process_Builder (Attributes : Variable_Id) is
1373             Attribute_Id : Variable_Id;
1374             Attribute    : Variable;
1375
1376          begin
1377             --  Process non associated array attribute from package Builder
1378
1379             Attribute_Id := Attributes;
1380             while Attribute_Id /= No_Variable loop
1381                Attribute :=
1382                  In_Tree.Variable_Elements.Table (Attribute_Id);
1383
1384                if not Attribute.Value.Default then
1385                   if Attribute.Name = Name_Executable_Suffix then
1386
1387                      --  Attribute Executable_Suffix: the suffix of the
1388                      --  executables.
1389
1390                      Data.Config.Executable_Suffix :=
1391                        Attribute.Value.Value;
1392                   end if;
1393                end if;
1394
1395                Attribute_Id := Attribute.Next;
1396             end loop;
1397          end Process_Builder;
1398
1399          ----------------------
1400          -- Process_Compiler --
1401          ----------------------
1402
1403          procedure Process_Compiler (Arrays : Array_Id) is
1404             Current_Array_Id : Array_Id;
1405             Current_Array    : Array_Data;
1406             Element_Id       : Array_Element_Id;
1407             Element          : Array_Element;
1408             List             : String_List_Id;
1409
1410          begin
1411             --  Process the associative array attribute of package Compiler
1412
1413             Current_Array_Id := Arrays;
1414             while Current_Array_Id /= No_Array loop
1415                Current_Array := In_Tree.Arrays.Table (Current_Array_Id);
1416
1417                Element_Id := Current_Array.Value;
1418                while Element_Id /= No_Array_Element loop
1419                   Element := In_Tree.Array_Elements.Table (Element_Id);
1420
1421                   if Element.Index /= All_Other_Names then
1422
1423                      --  Get the name of the language
1424
1425                      Get_Language_Index_Of (Element.Index);
1426
1427                      if Lang_Index /= No_Language_Index then
1428                         case Current_Array.Name is
1429                         when Name_Dependency_Switches =>
1430
1431                            --  Attribute Dependency_Switches (<language>)
1432
1433                            if In_Tree.Languages_Data.Table
1434                                (Lang_Index).Config.Dependency_Kind = None
1435                            then
1436                               In_Tree.Languages_Data.Table
1437                                 (Lang_Index).Config.Dependency_Kind :=
1438                                   Makefile;
1439                            end if;
1440
1441                            List := Element.Value.Values;
1442
1443                            if List /= Nil_String then
1444                               Put (Into_List =>
1445                                      In_Tree.Languages_Data.Table
1446                                        (Lang_Index).Config.Dependency_Option,
1447                                    From_List => List,
1448                                    In_Tree   => In_Tree);
1449                            end if;
1450
1451                         when Name_Dependency_Driver =>
1452
1453                            --  Attribute Dependency_Driver (<language>)
1454
1455                            if In_Tree.Languages_Data.Table
1456                                (Lang_Index).Config.Dependency_Kind = None
1457                            then
1458                               In_Tree.Languages_Data.Table
1459                                 (Lang_Index).Config.Dependency_Kind :=
1460                                   Makefile;
1461                            end if;
1462
1463                            List := Element.Value.Values;
1464
1465                            if List /= Nil_String then
1466                               Put (Into_List =>
1467                                      In_Tree.Languages_Data.Table
1468                                        (Lang_Index).Config.Compute_Dependency,
1469                                    From_List => List,
1470                                    In_Tree   => In_Tree);
1471                            end if;
1472
1473                         when Name_Include_Switches =>
1474
1475                            --  Attribute Include_Switches (<language>)
1476
1477                            List := Element.Value.Values;
1478
1479                            if List = Nil_String then
1480                               Error_Msg
1481                                 (Project,
1482                                  In_Tree,
1483                                  "include option cannot be null",
1484                                  Element.Value.Location);
1485                            end if;
1486
1487                            Put (Into_List =>
1488                                 In_Tree.Languages_Data.Table
1489                                   (Lang_Index).Config.Include_Option,
1490                                 From_List => List,
1491                                 In_Tree   => In_Tree);
1492
1493                         when Name_Include_Path =>
1494
1495                            --  Attribute Include_Path (<language>)
1496
1497                            In_Tree.Languages_Data.Table
1498                              (Lang_Index).Config.Include_Path :=
1499                              Element.Value.Value;
1500
1501                         when Name_Include_Path_File =>
1502
1503                            --  Attribute Include_Path_File (<language>)
1504
1505                            In_Tree.Languages_Data.Table
1506                              (Lang_Index).Config.Include_Path_File :=
1507                                Element.Value.Value;
1508
1509                         when Name_Driver =>
1510
1511                            --  Attribute Driver (<language>)
1512
1513                            Get_Name_String (Element.Value.Value);
1514
1515                            In_Tree.Languages_Data.Table
1516                              (Lang_Index).Config.Compiler_Driver :=
1517                                File_Name_Type (Element.Value.Value);
1518
1519                         when Name_Required_Switches =>
1520                            Put (Into_List =>
1521                                 In_Tree.Languages_Data.Table
1522                                   (Lang_Index).Config.
1523                                     Compiler_Required_Switches,
1524                                 From_List => Element.Value.Values,
1525                                 In_Tree   => In_Tree);
1526
1527                         when Name_Path_Syntax =>
1528                            begin
1529                               In_Tree.Languages_Data.Table
1530                                 (Lang_Index).Config.Path_Syntax :=
1531                                   Path_Syntax_Kind'Value
1532                                     (Get_Name_String (Element.Value.Value));
1533
1534                            exception
1535                               when Constraint_Error =>
1536                                  Error_Msg
1537                                    (Project,
1538                                     In_Tree,
1539                                     "invalid value for Path_Syntax",
1540                                     Element.Value.Location);
1541                            end;
1542
1543                         when Name_Pic_Option =>
1544
1545                            --  Attribute Compiler_Pic_Option (<language>)
1546
1547                            List := Element.Value.Values;
1548
1549                            if List = Nil_String then
1550                               Error_Msg
1551                                 (Project,
1552                                  In_Tree,
1553                                  "compiler PIC option cannot be null",
1554                                  Element.Value.Location);
1555                            end if;
1556
1557                            Put (Into_List =>
1558                                 In_Tree.Languages_Data.Table
1559                                   (Lang_Index).Config.Compilation_PIC_Option,
1560                                 From_List => List,
1561                                 In_Tree   => In_Tree);
1562
1563                         when Name_Mapping_File_Switches =>
1564
1565                            --  Attribute Mapping_File_Switches (<language>)
1566
1567                            List := Element.Value.Values;
1568
1569                            if List = Nil_String then
1570                               Error_Msg
1571                                 (Project,
1572                                  In_Tree,
1573                                  "mapping file switches cannot be null",
1574                                  Element.Value.Location);
1575                            end if;
1576
1577                            Put (Into_List =>
1578                                 In_Tree.Languages_Data.Table
1579                                   (Lang_Index).Config.Mapping_File_Switches,
1580                                 From_List => List,
1581                                 In_Tree   => In_Tree);
1582
1583                         when Name_Mapping_Spec_Suffix =>
1584
1585                            --  Attribute Mapping_Spec_Suffix (<language>)
1586
1587                            In_Tree.Languages_Data.Table
1588                              (Lang_Index).Config.Mapping_Spec_Suffix :=
1589                                File_Name_Type (Element.Value.Value);
1590
1591                         when Name_Mapping_Body_Suffix =>
1592
1593                            --  Attribute Mapping_Body_Suffix (<language>)
1594
1595                            In_Tree.Languages_Data.Table
1596                              (Lang_Index).Config.Mapping_Body_Suffix :=
1597                                File_Name_Type (Element.Value.Value);
1598
1599                         when Name_Config_File_Switches =>
1600
1601                            --  Attribute Config_File_Switches (<language>)
1602
1603                            List := Element.Value.Values;
1604
1605                            if List = Nil_String then
1606                               Error_Msg
1607                                 (Project,
1608                                  In_Tree,
1609                                  "config file switches cannot be null",
1610                                  Element.Value.Location);
1611                            end if;
1612
1613                            Put (Into_List =>
1614                                   In_Tree.Languages_Data.Table
1615                                     (Lang_Index).Config.Config_File_Switches,
1616                                 From_List => List,
1617                                 In_Tree   => In_Tree);
1618
1619                         when Name_Objects_Path =>
1620
1621                            --  Attribute Objects_Path (<language>)
1622
1623                            In_Tree.Languages_Data.Table
1624                              (Lang_Index).Config.Objects_Path :=
1625                                Element.Value.Value;
1626
1627                         when Name_Objects_Path_File =>
1628
1629                            --  Attribute Objects_Path_File (<language>)
1630
1631                            In_Tree.Languages_Data.Table
1632                              (Lang_Index).Config.Objects_Path_File :=
1633                                Element.Value.Value;
1634
1635                         when Name_Config_Body_File_Name =>
1636
1637                            --  Attribute Config_Body_File_Name (<language>)
1638
1639                            In_Tree.Languages_Data.Table
1640                              (Lang_Index).Config.Config_Body :=
1641                                Element.Value.Value;
1642
1643                         when Name_Config_Body_File_Name_Pattern =>
1644
1645                            --  Attribute Config_Body_File_Name_Pattern
1646                            --  (<language>)
1647
1648                            In_Tree.Languages_Data.Table
1649                              (Lang_Index).Config.Config_Body_Pattern :=
1650                                Element.Value.Value;
1651
1652                         when Name_Config_Spec_File_Name =>
1653
1654                            --  Attribute Config_Spec_File_Name (<language>)
1655
1656                            In_Tree.Languages_Data.Table
1657                              (Lang_Index).Config.Config_Spec :=
1658                                Element.Value.Value;
1659
1660                         when Name_Config_Spec_File_Name_Pattern =>
1661
1662                            --  Attribute Config_Spec_File_Name_Pattern
1663                            --  (<language>)
1664
1665                            In_Tree.Languages_Data.Table
1666                              (Lang_Index).Config.Config_Spec_Pattern :=
1667                              Element.Value.Value;
1668
1669                         when Name_Config_File_Unique =>
1670
1671                            --  Attribute Config_File_Unique (<language>)
1672
1673                            begin
1674                               In_Tree.Languages_Data.Table
1675                                 (Lang_Index).Config.Config_File_Unique :=
1676                                   Boolean'Value
1677                                     (Get_Name_String (Element.Value.Value));
1678                            exception
1679                               when Constraint_Error =>
1680                                  Error_Msg
1681                                    (Project,
1682                                     In_Tree,
1683                                     "illegal value for Config_File_Unique",
1684                                     Element.Value.Location);
1685                            end;
1686
1687                         when others =>
1688                            null;
1689                         end case;
1690                      end if;
1691                   end if;
1692
1693                   Element_Id := Element.Next;
1694                end loop;
1695
1696                Current_Array_Id := Current_Array.Next;
1697             end loop;
1698          end Process_Compiler;
1699
1700          --------------------
1701          -- Process_Naming --
1702          --------------------
1703
1704          procedure Process_Naming (Attributes : Variable_Id) is
1705             Attribute_Id : Variable_Id;
1706             Attribute    : Variable;
1707
1708          begin
1709             --  Process non associated array attribute from package Naming
1710
1711             Attribute_Id := Attributes;
1712             while Attribute_Id /= No_Variable loop
1713                Attribute := In_Tree.Variable_Elements.Table (Attribute_Id);
1714
1715                if not Attribute.Value.Default then
1716                   if Attribute.Name = Name_Separate_Suffix then
1717
1718                      --  Attribute Separate_Suffix
1719
1720                      Separate_Suffix := File_Name_Type (Attribute.Value.Value);
1721
1722                   elsif Attribute.Name = Name_Casing then
1723
1724                      --  Attribute Casing
1725
1726                      begin
1727                         Casing :=
1728                           Value (Get_Name_String (Attribute.Value.Value));
1729
1730                      exception
1731                         when Constraint_Error =>
1732                            Error_Msg
1733                              (Project,
1734                               In_Tree,
1735                               "invalid value for Casing",
1736                               Attribute.Value.Location);
1737                      end;
1738
1739                   elsif Attribute.Name = Name_Dot_Replacement then
1740
1741                      --  Attribute Dot_Replacement
1742
1743                      Dot_Replacement := File_Name_Type (Attribute.Value.Value);
1744
1745                   end if;
1746                end if;
1747
1748                Attribute_Id := Attribute.Next;
1749             end loop;
1750          end Process_Naming;
1751
1752          procedure Process_Naming (Arrays : Array_Id) is
1753             Current_Array_Id : Array_Id;
1754             Current_Array    : Array_Data;
1755             Element_Id       : Array_Element_Id;
1756             Element          : Array_Element;
1757          begin
1758             --  Process the associative array attribute of package Naming
1759
1760             Current_Array_Id := Arrays;
1761             while Current_Array_Id /= No_Array loop
1762                Current_Array := In_Tree.Arrays.Table (Current_Array_Id);
1763
1764                Element_Id := Current_Array.Value;
1765                while Element_Id /= No_Array_Element loop
1766                   Element := In_Tree.Array_Elements.Table (Element_Id);
1767
1768                   --  Get the name of the language
1769
1770                   Get_Language_Index_Of (Element.Index);
1771
1772                   if Lang_Index /= No_Language_Index then
1773                      case Current_Array.Name is
1774                         when Name_Specification_Suffix | Name_Spec_Suffix =>
1775
1776                            --  Attribute Spec_Suffix (<language>)
1777
1778                            In_Tree.Languages_Data.Table
1779                              (Lang_Index).Config.Naming_Data.Spec_Suffix :=
1780                                File_Name_Type (Element.Value.Value);
1781
1782                         when Name_Implementation_Suffix | Name_Body_Suffix =>
1783
1784                            --  Attribute Body_Suffix (<language>)
1785
1786                            In_Tree.Languages_Data.Table
1787                              (Lang_Index).Config.Naming_Data.Body_Suffix :=
1788                                File_Name_Type (Element.Value.Value);
1789
1790                            In_Tree.Languages_Data.Table
1791                              (Lang_Index).Config.Naming_Data.Separate_Suffix :=
1792                                File_Name_Type (Element.Value.Value);
1793
1794                         when others =>
1795                            null;
1796                      end case;
1797                   end if;
1798
1799                   Element_Id := Element.Next;
1800                end loop;
1801
1802                Current_Array_Id := Current_Array.Next;
1803             end loop;
1804          end Process_Naming;
1805
1806          --------------------
1807          -- Process_Linker --
1808          --------------------
1809
1810          procedure Process_Linker (Attributes : Variable_Id) is
1811             Attribute_Id : Variable_Id;
1812             Attribute    : Variable;
1813
1814          begin
1815             --  Process non associated array attribute from package Linker
1816
1817             Attribute_Id := Attributes;
1818             while Attribute_Id /= No_Variable loop
1819                Attribute :=
1820                  In_Tree.Variable_Elements.Table (Attribute_Id);
1821
1822                if not Attribute.Value.Default then
1823                   if Attribute.Name = Name_Driver then
1824
1825                      --  Attribute Linker'Driver: the default linker to use
1826
1827                      Data.Config.Linker :=
1828                        Path_Name_Type (Attribute.Value.Value);
1829
1830                   elsif Attribute.Name = Name_Required_Switches then
1831
1832                      --  Attribute Required_Switches: the minimum
1833                      --  options to use when invoking the linker
1834
1835                      Put (Into_List =>
1836                             Data.Config.Minimum_Linker_Options,
1837                           From_List => Attribute.Value.Values,
1838                           In_Tree   => In_Tree);
1839
1840                   elsif Attribute.Name = Name_Map_File_Option then
1841                      Data.Config.Map_File_Option := Attribute.Value.Value;
1842                   end if;
1843                end if;
1844
1845                Attribute_Id := Attribute.Next;
1846             end loop;
1847          end Process_Linker;
1848
1849       --  Start of processing for Process_Packages
1850
1851       begin
1852          Packages := Data.Decl.Packages;
1853          while Packages /= No_Package loop
1854             Element := In_Tree.Packages.Table (Packages);
1855
1856             case Element.Name is
1857                when Name_Binder =>
1858
1859                   --  Process attributes of package Binder
1860
1861                   Process_Binder (Element.Decl.Arrays);
1862
1863                when Name_Builder =>
1864
1865                   --  Process attributes of package Builder
1866
1867                   Process_Builder (Element.Decl.Attributes);
1868
1869                when Name_Compiler =>
1870
1871                   --  Process attributes of package Compiler
1872
1873                   Process_Compiler (Element.Decl.Arrays);
1874
1875                when Name_Linker =>
1876
1877                   --  Process attributes of package Linker
1878
1879                   Process_Linker (Element.Decl.Attributes);
1880
1881                when Name_Naming =>
1882
1883                   --  Process attributes of package Naming
1884
1885                   Process_Naming (Element.Decl.Attributes);
1886                   Process_Naming (Element.Decl.Arrays);
1887
1888                when others =>
1889                   null;
1890             end case;
1891
1892             Packages := Element.Next;
1893          end loop;
1894       end Process_Packages;
1895
1896       ---------------------------------------------
1897       -- Process_Project_Level_Simple_Attributes --
1898       ---------------------------------------------
1899
1900       procedure Process_Project_Level_Simple_Attributes is
1901          Attribute_Id : Variable_Id;
1902          Attribute    : Variable;
1903          List         : String_List_Id;
1904
1905       begin
1906          --  Process non associated array attribute at project level
1907
1908          Attribute_Id := Data.Decl.Attributes;
1909          while Attribute_Id /= No_Variable loop
1910             Attribute :=
1911               In_Tree.Variable_Elements.Table (Attribute_Id);
1912
1913             if not Attribute.Value.Default then
1914                if Attribute.Name = Name_Library_Builder then
1915
1916                   --  Attribute Library_Builder: the application to invoke
1917                   --  to build libraries.
1918
1919                   Data.Config.Library_Builder :=
1920                     Path_Name_Type (Attribute.Value.Value);
1921
1922                elsif Attribute.Name = Name_Archive_Builder then
1923
1924                   --  Attribute Archive_Builder: the archive builder
1925                   --  (usually "ar") and its minimum options (usually "cr").
1926
1927                   List := Attribute.Value.Values;
1928
1929                   if List = Nil_String then
1930                      Error_Msg
1931                        (Project,
1932                         In_Tree,
1933                         "archive builder cannot be null",
1934                         Attribute.Value.Location);
1935                   end if;
1936
1937                   Put (Into_List => Data.Config.Archive_Builder,
1938                        From_List => List,
1939                        In_Tree   => In_Tree);
1940
1941                elsif Attribute.Name = Name_Archive_Builder_Append_Option then
1942
1943                   --  Attribute Archive_Builder: the archive builder
1944                   --  (usually "ar") and its minimum options (usually "cr").
1945
1946                   List := Attribute.Value.Values;
1947
1948                   if List /= Nil_String then
1949                      Put
1950                        (Into_List => Data.Config.Archive_Builder_Append_Option,
1951                         From_List => List,
1952                         In_Tree   => In_Tree);
1953                   end if;
1954
1955                elsif Attribute.Name = Name_Archive_Indexer then
1956
1957                   --  Attribute Archive_Indexer: the optional archive
1958                   --  indexer (usually "ranlib") with its minimum options
1959                   --  (usually none).
1960
1961                   List := Attribute.Value.Values;
1962
1963                   if List = Nil_String then
1964                      Error_Msg
1965                        (Project,
1966                         In_Tree,
1967                         "archive indexer cannot be null",
1968                         Attribute.Value.Location);
1969                   end if;
1970
1971                   Put (Into_List => Data.Config.Archive_Indexer,
1972                        From_List => List,
1973                        In_Tree   => In_Tree);
1974
1975                elsif Attribute.Name = Name_Library_Partial_Linker then
1976
1977                   --  Attribute Library_Partial_Linker: the optional linker
1978                   --  driver with its minimum options, to partially link
1979                   --  archives.
1980
1981                   List := Attribute.Value.Values;
1982
1983                   if List = Nil_String then
1984                      Error_Msg
1985                        (Project,
1986                         In_Tree,
1987                         "partial linker cannot be null",
1988                         Attribute.Value.Location);
1989                   end if;
1990
1991                   Put (Into_List => Data.Config.Lib_Partial_Linker,
1992                        From_List => List,
1993                        In_Tree   => In_Tree);
1994
1995                elsif Attribute.Name = Name_Library_GCC then
1996                   Data.Config.Shared_Lib_Driver :=
1997                     File_Name_Type (Attribute.Value.Value);
1998
1999                elsif Attribute.Name = Name_Archive_Suffix then
2000                   Data.Config.Archive_Suffix :=
2001                     File_Name_Type (Attribute.Value.Value);
2002
2003                elsif Attribute.Name = Name_Linker_Executable_Option then
2004
2005                   --  Attribute Linker_Executable_Option: optional options
2006                   --  to specify an executable name. Defaults to "-o".
2007
2008                   List := Attribute.Value.Values;
2009
2010                   if List = Nil_String then
2011                      Error_Msg
2012                        (Project,
2013                         In_Tree,
2014                         "linker executable option cannot be null",
2015                         Attribute.Value.Location);
2016                   end if;
2017
2018                   Put (Into_List => Data.Config.Linker_Executable_Option,
2019                        From_List => List,
2020                        In_Tree   => In_Tree);
2021
2022                elsif Attribute.Name = Name_Linker_Lib_Dir_Option then
2023
2024                   --  Attribute Linker_Lib_Dir_Option: optional options
2025                   --  to specify a library search directory. Defaults to
2026                   --  "-L".
2027
2028                   Get_Name_String (Attribute.Value.Value);
2029
2030                   if Name_Len = 0 then
2031                      Error_Msg
2032                        (Project,
2033                         In_Tree,
2034                         "linker library directory option cannot be empty",
2035                         Attribute.Value.Location);
2036                   end if;
2037
2038                   Data.Config.Linker_Lib_Dir_Option := Attribute.Value.Value;
2039
2040                elsif Attribute.Name = Name_Linker_Lib_Name_Option then
2041
2042                   --  Attribute Linker_Lib_Name_Option: optional options
2043                   --  to specify the name of a library to be linked in.
2044                   --  Defaults to "-l".
2045
2046                   Get_Name_String (Attribute.Value.Value);
2047
2048                   if Name_Len = 0 then
2049                      Error_Msg
2050                        (Project,
2051                         In_Tree,
2052                         "linker library name option cannot be empty",
2053                         Attribute.Value.Location);
2054                   end if;
2055
2056                   Data.Config.Linker_Lib_Name_Option := Attribute.Value.Value;
2057
2058                elsif Attribute.Name = Name_Run_Path_Option then
2059
2060                   --  Attribute Run_Path_Option: optional options to
2061                   --  specify a path for libraries.
2062
2063                   List := Attribute.Value.Values;
2064
2065                   if List /= Nil_String then
2066                      Put (Into_List => Data.Config.Run_Path_Option,
2067                           From_List => List,
2068                           In_Tree   => In_Tree);
2069                   end if;
2070
2071                elsif Attribute.Name = Name_Library_Support then
2072                   declare
2073                      pragma Unsuppress (All_Checks);
2074                   begin
2075                      Data.Config.Lib_Support :=
2076                        Library_Support'Value (Get_Name_String
2077                                               (Attribute.Value.Value));
2078                   exception
2079                      when Constraint_Error =>
2080                         Error_Msg
2081                           (Project,
2082                            In_Tree,
2083                            "invalid value """ &
2084                            Get_Name_String (Attribute.Value.Value) &
2085                            """ for Library_Support",
2086                            Attribute.Value.Location);
2087                   end;
2088
2089                elsif Attribute.Name = Name_Shared_Library_Prefix then
2090                   Data.Config.Shared_Lib_Prefix :=
2091                     File_Name_Type (Attribute.Value.Value);
2092
2093                elsif Attribute.Name = Name_Shared_Library_Suffix then
2094                   Data.Config.Shared_Lib_Suffix :=
2095                     File_Name_Type (Attribute.Value.Value);
2096
2097                elsif Attribute.Name = Name_Symbolic_Link_Supported then
2098                   declare
2099                      pragma Unsuppress (All_Checks);
2100                   begin
2101                      Data.Config.Symbolic_Link_Supported :=
2102                        Boolean'Value (Get_Name_String
2103                                       (Attribute.Value.Value));
2104                   exception
2105                      when Constraint_Error =>
2106                         Error_Msg
2107                           (Project,
2108                            In_Tree,
2109                            "invalid value """
2110                              & Get_Name_String (Attribute.Value.Value)
2111                              & """ for Symbolic_Link_Supported",
2112                            Attribute.Value.Location);
2113                   end;
2114
2115                elsif
2116                  Attribute.Name = Name_Library_Major_Minor_Id_Supported
2117                then
2118                   declare
2119                      pragma Unsuppress (All_Checks);
2120                   begin
2121                      Data.Config.Lib_Maj_Min_Id_Supported :=
2122                        Boolean'Value (Get_Name_String
2123                                       (Attribute.Value.Value));
2124                   exception
2125                      when Constraint_Error =>
2126                         Error_Msg
2127                           (Project,
2128                            In_Tree,
2129                            "invalid value """ &
2130                            Get_Name_String (Attribute.Value.Value) &
2131                            """ for Library_Major_Minor_Id_Supported",
2132                            Attribute.Value.Location);
2133                   end;
2134
2135                elsif Attribute.Name = Name_Library_Auto_Init_Supported then
2136                   declare
2137                      pragma Unsuppress (All_Checks);
2138                   begin
2139                      Data.Config.Auto_Init_Supported :=
2140                        Boolean'Value (Get_Name_String (Attribute.Value.Value));
2141                   exception
2142                      when Constraint_Error =>
2143                         Error_Msg
2144                           (Project,
2145                            In_Tree,
2146                            "invalid value """
2147                              & Get_Name_String (Attribute.Value.Value)
2148                              & """ for Library_Auto_Init_Supported",
2149                            Attribute.Value.Location);
2150                   end;
2151
2152                elsif Attribute.Name = Name_Shared_Library_Minimum_Switches then
2153                   List := Attribute.Value.Values;
2154
2155                   if List /= Nil_String then
2156                      Put (Into_List => Data.Config.Shared_Lib_Min_Options,
2157                           From_List => List,
2158                           In_Tree   => In_Tree);
2159                   end if;
2160
2161                elsif Attribute.Name = Name_Library_Version_Switches then
2162                   List := Attribute.Value.Values;
2163
2164                   if List /= Nil_String then
2165                      Put (Into_List => Data.Config.Lib_Version_Options,
2166                           From_List => List,
2167                           In_Tree   => In_Tree);
2168                   end if;
2169                end if;
2170             end if;
2171
2172             Attribute_Id := Attribute.Next;
2173          end loop;
2174       end Process_Project_Level_Simple_Attributes;
2175
2176       --------------------------------------------
2177       -- Process_Project_Level_Array_Attributes --
2178       --------------------------------------------
2179
2180       procedure Process_Project_Level_Array_Attributes is
2181          Current_Array_Id : Array_Id;
2182          Current_Array    : Array_Data;
2183          Element_Id       : Array_Element_Id;
2184          Element          : Array_Element;
2185          List             : String_List_Id;
2186
2187       begin
2188          --  Process the associative array attributes at project level
2189
2190          Current_Array_Id := Data.Decl.Arrays;
2191          while Current_Array_Id /= No_Array loop
2192             Current_Array := In_Tree.Arrays.Table (Current_Array_Id);
2193
2194             Element_Id := Current_Array.Value;
2195             while Element_Id /= No_Array_Element loop
2196                Element := In_Tree.Array_Elements.Table (Element_Id);
2197
2198                --  Get the name of the language
2199
2200                Get_Language_Index_Of (Element.Index);
2201
2202                if Lang_Index /= No_Language_Index then
2203                   case Current_Array.Name is
2204                      when Name_Inherit_Source_Path =>
2205                         List := Element.Value.Values;
2206
2207                         if List /= Nil_String then
2208                            Put
2209                              (Into_List  =>
2210                                 In_Tree.Languages_Data.Table (Lang_Index).
2211                                   Config.Include_Compatible_Languages,
2212                               From_List  => List,
2213                               In_Tree    => In_Tree,
2214                               Lower_Case => True);
2215                         end if;
2216
2217                      when Name_Toolchain_Description =>
2218
2219                         --  Attribute Toolchain_Description (<language>)
2220
2221                         In_Tree.Languages_Data.Table
2222                           (Lang_Index).Config.Toolchain_Description :=
2223                           Element.Value.Value;
2224
2225                      when Name_Toolchain_Version =>
2226
2227                         --  Attribute Toolchain_Version (<language>)
2228
2229                         In_Tree.Languages_Data.Table
2230                           (Lang_Index).Config.Toolchain_Version :=
2231                           Element.Value.Value;
2232
2233                      when Name_Runtime_Library_Dir =>
2234
2235                         --  Attribute Runtime_Library_Dir (<language>)
2236
2237                         In_Tree.Languages_Data.Table
2238                           (Lang_Index).Config.Runtime_Library_Dir :=
2239                           Element.Value.Value;
2240
2241                      when Name_Object_Generated =>
2242                         declare
2243                            pragma Unsuppress (All_Checks);
2244                            Value : Boolean;
2245
2246                         begin
2247                            Value :=
2248                              Boolean'Value
2249                                (Get_Name_String (Element.Value.Value));
2250
2251                            In_Tree.Languages_Data.Table
2252                              (Lang_Index).Config.Object_Generated := Value;
2253
2254                            --  If no object is generated, no object may be
2255                            --  linked.
2256
2257                            if not Value then
2258                               In_Tree.Languages_Data.Table
2259                                 (Lang_Index).Config.Objects_Linked := False;
2260                            end if;
2261
2262                         exception
2263                            when Constraint_Error =>
2264                               Error_Msg
2265                                 (Project,
2266                                  In_Tree,
2267                                  "invalid value """
2268                                  & Get_Name_String (Element.Value.Value)
2269                                  & """ for Object_Generated",
2270                                  Element.Value.Location);
2271                         end;
2272
2273                      when Name_Objects_Linked =>
2274                         declare
2275                            pragma Unsuppress (All_Checks);
2276                            Value : Boolean;
2277
2278                         begin
2279                            Value :=
2280                              Boolean'Value
2281                                (Get_Name_String (Element.Value.Value));
2282
2283                            --  No change if Object_Generated is False, as this
2284                            --  forces Objects_Linked to be False too.
2285
2286                            if In_Tree.Languages_Data.Table
2287                              (Lang_Index).Config.Object_Generated
2288                            then
2289                               In_Tree.Languages_Data.Table
2290                                 (Lang_Index).Config.Objects_Linked :=
2291                                 Value;
2292                            end if;
2293
2294                         exception
2295                            when Constraint_Error =>
2296                               Error_Msg
2297                                 (Project,
2298                                  In_Tree,
2299                                  "invalid value """
2300                                  & Get_Name_String (Element.Value.Value)
2301                                  & """ for Objects_Linked",
2302                                  Element.Value.Location);
2303                         end;
2304                      when others =>
2305                         null;
2306                   end case;
2307                end if;
2308
2309                Element_Id := Element.Next;
2310             end loop;
2311
2312             Current_Array_Id := Current_Array.Next;
2313          end loop;
2314       end Process_Project_Level_Array_Attributes;
2315
2316    begin
2317       Process_Project_Level_Simple_Attributes;
2318       Process_Project_Level_Array_Attributes;
2319       Process_Packages;
2320
2321       --  For unit based languages, set Casing, Dot_Replacement and
2322       --  Separate_Suffix in Naming_Data.
2323
2324       Lang_Index := Data.First_Language_Processing;
2325       while Lang_Index /= No_Language_Index loop
2326          if In_Tree.Languages_Data.Table
2327            (Lang_Index).Name = Name_Ada
2328          then
2329             In_Tree.Languages_Data.Table
2330               (Lang_Index).Config.Naming_Data.Casing := Casing;
2331             In_Tree.Languages_Data.Table
2332               (Lang_Index).Config.Naming_Data.Dot_Replacement :=
2333               Dot_Replacement;
2334
2335             if Separate_Suffix /= No_File then
2336                In_Tree.Languages_Data.Table
2337                  (Lang_Index).Config.Naming_Data.Separate_Suffix :=
2338                  Separate_Suffix;
2339             end if;
2340
2341             exit;
2342          end if;
2343
2344          Lang_Index := In_Tree.Languages_Data.Table (Lang_Index).Next;
2345       end loop;
2346
2347       --  Give empty names to various prefixes/suffixes, if they have not
2348       --  been specified in the configuration.
2349
2350       if Data.Config.Archive_Suffix = No_File then
2351          Data.Config.Archive_Suffix := Empty_File;
2352       end if;
2353
2354       if Data.Config.Shared_Lib_Prefix = No_File then
2355          Data.Config.Shared_Lib_Prefix := Empty_File;
2356       end if;
2357
2358       if Data.Config.Shared_Lib_Suffix = No_File then
2359          Data.Config.Shared_Lib_Suffix := Empty_File;
2360       end if;
2361
2362       Lang_Index := Data.First_Language_Processing;
2363       while Lang_Index /= No_Language_Index loop
2364          Lang_Data := In_Tree.Languages_Data.Table (Lang_Index);
2365
2366          Current_Language := Lang_Data.Display_Name;
2367
2368          --  For all languages, Compiler_Driver needs to be specified
2369
2370          if Lang_Data.Config.Compiler_Driver = No_File then
2371             Error_Msg_Name_1 := Current_Language;
2372             Error_Msg
2373               (Project,
2374                In_Tree,
2375                "?no compiler specified for language %%" &
2376                ", ignoring all its sources",
2377                No_Location);
2378
2379             if Lang_Index = Data.First_Language_Processing then
2380                Data.First_Language_Processing :=
2381                  Lang_Data.Next;
2382             else
2383                In_Tree.Languages_Data.Table (Prev_Index).Next :=
2384                  Lang_Data.Next;
2385             end if;
2386
2387          elsif Lang_Data.Name = Name_Ada then
2388             Prev_Index := Lang_Index;
2389
2390             --  For unit based languages, Dot_Replacement, Spec_Suffix and
2391             --  Body_Suffix need to be specified.
2392
2393             if Lang_Data.Config.Naming_Data.Dot_Replacement = No_File then
2394                Error_Msg
2395                  (Project,
2396                   In_Tree,
2397                   "Dot_Replacement not specified for Ada",
2398                   No_Location);
2399             end if;
2400
2401             if Lang_Data.Config.Naming_Data.Spec_Suffix = No_File then
2402                Error_Msg
2403                  (Project,
2404                   In_Tree,
2405                   "Spec_Suffix not specified for Ada",
2406                   No_Location);
2407             end if;
2408
2409             if Lang_Data.Config.Naming_Data.Body_Suffix = No_File then
2410                Error_Msg
2411                  (Project,
2412                   In_Tree,
2413                   "Body_Suffix not specified for Ada",
2414                   No_Location);
2415             end if;
2416
2417          else
2418             Prev_Index := Lang_Index;
2419
2420             --  For file based languages, either Spec_Suffix or Body_Suffix
2421             --  need to be specified.
2422
2423             if Lang_Data.Config.Naming_Data.Spec_Suffix = No_File and then
2424               Lang_Data.Config.Naming_Data.Body_Suffix = No_File
2425             then
2426                Error_Msg_Name_1 := Current_Language;
2427                Error_Msg
2428                  (Project,
2429                   In_Tree,
2430                   "no suffixes specified for %%",
2431                   No_Location);
2432             end if;
2433          end if;
2434
2435          Lang_Index := Lang_Data.Next;
2436       end loop;
2437    end Check_Configuration;
2438
2439    -------------------------------
2440    -- Check_If_Externally_Built --
2441    -------------------------------
2442
2443    procedure Check_If_Externally_Built
2444      (Project : Project_Id;
2445       In_Tree : Project_Tree_Ref;
2446       Data    : in out Project_Data)
2447    is
2448       Externally_Built : constant Variable_Value :=
2449                            Util.Value_Of
2450                             (Name_Externally_Built,
2451                              Data.Decl.Attributes, In_Tree);
2452
2453    begin
2454       if not Externally_Built.Default then
2455          Get_Name_String (Externally_Built.Value);
2456          To_Lower (Name_Buffer (1 .. Name_Len));
2457
2458          if Name_Buffer (1 .. Name_Len) = "true" then
2459             Data.Externally_Built := True;
2460
2461          elsif Name_Buffer (1 .. Name_Len) /= "false" then
2462             Error_Msg (Project, In_Tree,
2463                        "Externally_Built may only be true or false",
2464                        Externally_Built.Location);
2465          end if;
2466       end if;
2467
2468       --  A virtual project extending an externally built project is itself
2469       --  externally built.
2470
2471       if Data.Virtual and then Data.Extends /= No_Project then
2472          Data.Externally_Built :=
2473            In_Tree.Projects.Table (Data.Extends).Externally_Built;
2474       end if;
2475
2476       if Current_Verbosity = High then
2477          Write_Str ("Project is ");
2478
2479          if not Data.Externally_Built then
2480             Write_Str ("not ");
2481          end if;
2482
2483          Write_Line ("externally built.");
2484       end if;
2485    end Check_If_Externally_Built;
2486
2487    ----------------------
2488    -- Check_Interfaces --
2489    ----------------------
2490
2491    procedure Check_Interfaces
2492      (Project : Project_Id;
2493       In_Tree : Project_Tree_Ref;
2494       Data    : in out Project_Data)
2495    is
2496       Interfaces : constant Prj.Variable_Value :=
2497                      Prj.Util.Value_Of
2498                        (Snames.Name_Interfaces,
2499                         Data.Decl.Attributes,
2500                         In_Tree);
2501
2502       List    : String_List_Id;
2503       Element : String_Element;
2504       Name    : File_Name_Type;
2505
2506       Source   : Source_Id;
2507
2508       Project_2 : Project_Id;
2509       Data_2     : Project_Data;
2510
2511    begin
2512       if not Interfaces.Default then
2513
2514          --  Set In_Interfaces to False for all sources. It will be set to True
2515          --  later for the sources in the Interfaces list.
2516
2517          Project_2 := Project;
2518          Data_2    := Data;
2519          loop
2520             Source := Data_2.First_Source;
2521             while Source /= No_Source loop
2522                declare
2523                   Src_Data : Source_Data renames
2524                                In_Tree.Sources.Table (Source);
2525                begin
2526                   Src_Data.In_Interfaces := False;
2527                   Source := Src_Data.Next_In_Project;
2528                end;
2529             end loop;
2530
2531             Project_2 := Data_2.Extends;
2532
2533             exit when Project_2 = No_Project;
2534
2535             Data_2 := In_Tree.Projects.Table (Project_2);
2536          end loop;
2537
2538          List := Interfaces.Values;
2539          while List /= Nil_String loop
2540             Element := In_Tree.String_Elements.Table (List);
2541             Get_Name_String (Element.Value);
2542             Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2543             Name := Name_Find;
2544
2545             Project_2 := Project;
2546             Data_2 := Data;
2547             Big_Loop :
2548             loop
2549                Source := Data_2.First_Source;
2550                while Source /= No_Source loop
2551                   declare
2552                      Src_Data : Source_Data renames
2553                                   In_Tree.Sources.Table (Source);
2554
2555                   begin
2556                      if Src_Data.File = Name then
2557                         if not Src_Data.Locally_Removed then
2558                            Src_Data.In_Interfaces := True;
2559                            Src_Data.Declared_In_Interfaces := True;
2560
2561                            if Src_Data.Other_Part /= No_Source then
2562                               In_Tree.Sources.Table
2563                                 (Src_Data.Other_Part).In_Interfaces := True;
2564                               In_Tree.Sources.Table
2565                                 (Src_Data.Other_Part).Declared_In_Interfaces :=
2566                                 True;
2567                            end if;
2568
2569                            if Current_Verbosity = High then
2570                               Write_Str ("   interface: ");
2571                               Write_Line
2572                                 (Get_Name_String (Src_Data.Path.Name));
2573                            end if;
2574                         end if;
2575
2576                         exit Big_Loop;
2577                      end if;
2578
2579                      Source := Src_Data.Next_In_Project;
2580                   end;
2581                end loop;
2582
2583                Project_2 := Data_2.Extends;
2584
2585                exit Big_Loop when Project_2 = No_Project;
2586
2587                Data_2 := In_Tree.Projects.Table (Project_2);
2588             end loop Big_Loop;
2589
2590             if Source = No_Source then
2591                Error_Msg_File_1 := File_Name_Type (Element.Value);
2592                Error_Msg_Name_1 := Data.Name;
2593
2594                Error_Msg
2595                  (Project,
2596                   In_Tree,
2597                   "{ cannot be an interface of project %% " &
2598                   "as it is not one of its sources",
2599                   Element.Location);
2600             end if;
2601
2602             List := Element.Next;
2603          end loop;
2604
2605          Data.Interfaces_Defined := True;
2606
2607       elsif Data.Extends /= No_Project then
2608          Data.Interfaces_Defined :=
2609            In_Tree.Projects.Table (Data.Extends).Interfaces_Defined;
2610
2611          if Data.Interfaces_Defined then
2612             Source := Data.First_Source;
2613             while Source /= No_Source loop
2614                declare
2615                   Src_Data : Source_Data renames
2616                                In_Tree.Sources.Table (Source);
2617
2618                begin
2619                   if not Src_Data.Declared_In_Interfaces then
2620                      Src_Data.In_Interfaces := False;
2621                   end if;
2622
2623                   Source := Src_Data.Next_In_Project;
2624                end;
2625             end loop;
2626          end if;
2627       end if;
2628    end Check_Interfaces;
2629
2630    --------------------------
2631    -- Check_Naming_Schemes --
2632    --------------------------
2633
2634    procedure Check_Naming_Schemes
2635      (Data    : in out Project_Data;
2636       Project : Project_Id;
2637       In_Tree : Project_Tree_Ref)
2638    is
2639       Naming_Id : constant Package_Id :=
2640                     Util.Value_Of (Name_Naming, Data.Decl.Packages, In_Tree);
2641       Naming    : Package_Element;
2642
2643       procedure Check_Unit_Names (List : Array_Element_Id);
2644       --  Check that a list of unit names contains only valid names
2645
2646       procedure Get_Exceptions (Kind : Source_Kind);
2647       --  Comment required ???
2648
2649       procedure Get_Unit_Exceptions (Kind : Source_Kind);
2650       --  Comment required ???
2651
2652       ----------------------
2653       -- Check_Unit_Names --
2654       ----------------------
2655
2656       procedure Check_Unit_Names (List : Array_Element_Id) is
2657          Current   : Array_Element_Id;
2658          Element   : Array_Element;
2659          Unit_Name : Name_Id;
2660
2661       begin
2662          --  Loop through elements of the string list
2663
2664          Current := List;
2665          while Current /= No_Array_Element loop
2666             Element := In_Tree.Array_Elements.Table (Current);
2667
2668             --  Put file name in canonical case
2669
2670             if not Osint.File_Names_Case_Sensitive then
2671                Get_Name_String (Element.Value.Value);
2672                Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2673                Element.Value.Value := Name_Find;
2674             end if;
2675
2676             --  Check that it contains a valid unit name
2677
2678             Get_Name_String (Element.Index);
2679             Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit_Name);
2680
2681             if Unit_Name = No_Name then
2682                Err_Vars.Error_Msg_Name_1 := Element.Index;
2683                Error_Msg
2684                  (Project, In_Tree,
2685                   "%% is not a valid unit name.",
2686                   Element.Value.Location);
2687
2688             else
2689                if Current_Verbosity = High then
2690                   Write_Str ("    Unit (""");
2691                   Write_Str (Get_Name_String (Unit_Name));
2692                   Write_Line (""")");
2693                end if;
2694
2695                Element.Index := Unit_Name;
2696                In_Tree.Array_Elements.Table (Current) := Element;
2697             end if;
2698
2699             Current := Element.Next;
2700          end loop;
2701       end Check_Unit_Names;
2702
2703       --------------------
2704       -- Get_Exceptions --
2705       --------------------
2706
2707       procedure Get_Exceptions (Kind : Source_Kind) is
2708          Exceptions     : Array_Element_Id;
2709          Exception_List : Variable_Value;
2710          Element_Id     : String_List_Id;
2711          Element        : String_Element;
2712          File_Name      : File_Name_Type;
2713          Lang_Id        : Language_Index;
2714          Lang           : Name_Id;
2715          Lang_Kind      : Language_Kind;
2716          Source         : Source_Id;
2717
2718       begin
2719          if Kind = Impl then
2720             Exceptions :=
2721               Value_Of
2722                 (Name_Implementation_Exceptions,
2723                  In_Arrays => Naming.Decl.Arrays,
2724                  In_Tree   => In_Tree);
2725
2726          else
2727             Exceptions :=
2728               Value_Of
2729                 (Name_Specification_Exceptions,
2730                  In_Arrays => Naming.Decl.Arrays,
2731                  In_Tree   => In_Tree);
2732          end if;
2733
2734          Lang_Id := Data.First_Language_Processing;
2735          while Lang_Id /= No_Language_Index loop
2736             if In_Tree.Languages_Data.Table (Lang_Id).Config.Kind =
2737                                                                File_Based
2738             then
2739                Lang := In_Tree.Languages_Data.Table (Lang_Id).Name;
2740                Lang_Kind :=
2741                  In_Tree.Languages_Data.Table (Lang_Id).Config.Kind;
2742
2743                Exception_List := Value_Of
2744                  (Index    => Lang,
2745                   In_Array => Exceptions,
2746                   In_Tree  => In_Tree);
2747
2748                if Exception_List /= Nil_Variable_Value then
2749                   Element_Id := Exception_List.Values;
2750                   while Element_Id /= Nil_String loop
2751                      Element := In_Tree.String_Elements.Table (Element_Id);
2752
2753                      if Osint.File_Names_Case_Sensitive then
2754                         File_Name := File_Name_Type (Element.Value);
2755                      else
2756                         Get_Name_String (Element.Value);
2757                         Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2758                         File_Name := Name_Find;
2759                      end if;
2760
2761                      Source := Data.First_Source;
2762                      while Source /= No_Source
2763                        and then
2764                        In_Tree.Sources.Table (Source).File /= File_Name
2765                      loop
2766                         Source :=
2767                           In_Tree.Sources.Table (Source).Next_In_Project;
2768                      end loop;
2769
2770                      if Source = No_Source then
2771                         Add_Source
2772                           (Id           => Source,
2773                            Data         => Data,
2774                            In_Tree      => In_Tree,
2775                            Project      => Project,
2776                            Lang         => Lang,
2777                            Lang_Id      => Lang_Id,
2778                            Kind         => Kind,
2779                            File_Name    => File_Name,
2780                            Display_File => File_Name_Type (Element.Value),
2781                            Naming_Exception => True,
2782                            Lang_Kind    => Lang_Kind);
2783
2784                      else
2785                         --  Check if the file name is already recorded for
2786                         --  another language or another kind.
2787
2788                         if
2789                           In_Tree.Sources.Table (Source).Language /= Lang_Id
2790                         then
2791                            Error_Msg
2792                              (Project,
2793                               In_Tree,
2794                               "the same file cannot be a source " &
2795                               "of two languages",
2796                               Element.Location);
2797
2798                         elsif In_Tree.Sources.Table (Source).Kind /= Kind then
2799                            Error_Msg
2800                              (Project,
2801                               In_Tree,
2802                               "the same file cannot be a source " &
2803                               "and a template",
2804                               Element.Location);
2805                         end if;
2806
2807                         --  If the file is already recorded for the same
2808                         --  language and the same kind, it means that the file
2809                         --  name appears several times in the *_Exceptions
2810                         --  attribute; so there is nothing to do.
2811
2812                      end if;
2813
2814                      Element_Id := Element.Next;
2815                   end loop;
2816                end if;
2817             end if;
2818
2819             Lang_Id := In_Tree.Languages_Data.Table (Lang_Id).Next;
2820          end loop;
2821       end Get_Exceptions;
2822
2823       -------------------------
2824       -- Get_Unit_Exceptions --
2825       -------------------------
2826
2827       procedure Get_Unit_Exceptions (Kind : Source_Kind) is
2828          Exceptions : Array_Element_Id;
2829          Element    : Array_Element;
2830          Unit       : Name_Id;
2831          Index      : Int;
2832          File_Name  : File_Name_Type;
2833          Lang_Id    : constant Language_Index :=
2834                         Data.Unit_Based_Language_Index;
2835          Lang       : constant Name_Id :=
2836                         Data.Unit_Based_Language_Name;
2837
2838          Source            : Source_Id;
2839          Source_To_Replace : Source_Id := No_Source;
2840
2841          Other_Project : Project_Id;
2842          Other_Part    : Source_Id := No_Source;
2843
2844       begin
2845          if Lang_Id = No_Language_Index or else Lang = No_Name then
2846             return;
2847          end if;
2848
2849          if Kind = Impl then
2850             Exceptions := Value_Of
2851               (Name_Body,
2852                In_Arrays => Naming.Decl.Arrays,
2853                In_Tree   => In_Tree);
2854
2855             if Exceptions = No_Array_Element then
2856                Exceptions :=
2857                  Value_Of
2858                    (Name_Implementation,
2859                     In_Arrays => Naming.Decl.Arrays,
2860                     In_Tree   => In_Tree);
2861             end if;
2862
2863          else
2864             Exceptions :=
2865               Value_Of
2866                 (Name_Spec,
2867                  In_Arrays => Naming.Decl.Arrays,
2868                  In_Tree   => In_Tree);
2869
2870             if Exceptions = No_Array_Element then
2871                Exceptions := Value_Of
2872                  (Name_Specification,
2873                   In_Arrays => Naming.Decl.Arrays,
2874                   In_Tree   => In_Tree);
2875             end if;
2876
2877          end if;
2878
2879          while Exceptions /= No_Array_Element loop
2880             Element := In_Tree.Array_Elements.Table (Exceptions);
2881
2882             if Osint.File_Names_Case_Sensitive then
2883                File_Name := File_Name_Type (Element.Value.Value);
2884             else
2885                Get_Name_String (Element.Value.Value);
2886                Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2887                File_Name := Name_Find;
2888             end if;
2889
2890             Get_Name_String (Element.Index);
2891             To_Lower (Name_Buffer (1 .. Name_Len));
2892             Unit := Name_Find;
2893
2894             Index := Element.Value.Index;
2895
2896             --  For Ada, check if it is a valid unit name
2897
2898             if Lang = Name_Ada then
2899                Get_Name_String (Element.Index);
2900                Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
2901
2902                if Unit = No_Name then
2903                   Err_Vars.Error_Msg_Name_1 := Element.Index;
2904                   Error_Msg
2905                     (Project, In_Tree,
2906                      "%% is not a valid unit name.",
2907                      Element.Value.Location);
2908                end if;
2909             end if;
2910
2911             if Unit /= No_Name then
2912
2913                --  Check if the source already exists
2914
2915                Source := In_Tree.First_Source;
2916                Source_To_Replace := No_Source;
2917
2918                while Source /= No_Source and then
2919                  (In_Tree.Sources.Table (Source).Unit /= Unit or else
2920                   In_Tree.Sources.Table (Source).Index /= Index)
2921                loop
2922                   Source := In_Tree.Sources.Table (Source).Next_In_Sources;
2923                end loop;
2924
2925                if Source /= No_Source then
2926                   if In_Tree.Sources.Table (Source).Kind /= Kind then
2927                      Other_Part := Source;
2928
2929                      loop
2930                         Source :=
2931                           In_Tree.Sources.Table (Source).Next_In_Sources;
2932
2933                         exit when Source = No_Source or else
2934                           (In_Tree.Sources.Table (Source).Unit = Unit
2935                            and then
2936                            In_Tree.Sources.Table (Source).Index = Index);
2937                      end loop;
2938                   end if;
2939
2940                   if Source /= No_Source then
2941                      Other_Project := In_Tree.Sources.Table (Source).Project;
2942
2943                      if Is_Extending (Project, Other_Project, In_Tree) then
2944                         Other_Part :=
2945                           In_Tree.Sources.Table (Source).Other_Part;
2946
2947                         --  Record the source to be removed
2948
2949                         Source_To_Replace := Source;
2950                         Source := No_Source;
2951
2952                      else
2953                         Error_Msg_Name_1 := Unit;
2954                         Error_Msg_Name_2 :=
2955                           In_Tree.Projects.Table (Other_Project).Name;
2956                         Error_Msg
2957                           (Project,
2958                            In_Tree,
2959                            "%% is already a source of project %%",
2960                            Element.Value.Location);
2961                      end if;
2962                   end if;
2963                end if;
2964
2965                if Source = No_Source then
2966                   Add_Source
2967                     (Id           => Source,
2968                      Data         => Data,
2969                      In_Tree      => In_Tree,
2970                      Project      => Project,
2971                      Lang         => Lang,
2972                      Lang_Id      => Lang_Id,
2973                      Kind         => Kind,
2974                      File_Name    => File_Name,
2975                      Display_File => File_Name_Type (Element.Value.Value),
2976                      Lang_Kind    => Unit_Based,
2977                      Other_Part   => Other_Part,
2978                      Unit         => Unit,
2979                      Index        => Index,
2980                      Naming_Exception => True,
2981                      Source_To_Replace => Source_To_Replace);
2982                end if;
2983             end if;
2984
2985             Exceptions := Element.Next;
2986          end loop;
2987
2988       end Get_Unit_Exceptions;
2989
2990    --  Start of processing for Check_Naming_Schemes
2991
2992    begin
2993       if Get_Mode = Ada_Only then
2994
2995          --  If there is a package Naming, we will put in Data.Naming what is
2996          --  in this package Naming.
2997
2998          if Naming_Id /= No_Package then
2999             Naming := In_Tree.Packages.Table (Naming_Id);
3000
3001             if Current_Verbosity = High then
3002                Write_Line ("Checking ""Naming"" for Ada.");
3003             end if;
3004
3005             declare
3006                Bodies : constant Array_Element_Id :=
3007                           Util.Value_Of
3008                             (Name_Body, Naming.Decl.Arrays, In_Tree);
3009
3010                Specs  : constant Array_Element_Id :=
3011                           Util.Value_Of
3012                             (Name_Spec, Naming.Decl.Arrays, In_Tree);
3013
3014             begin
3015                if Bodies /= No_Array_Element then
3016
3017                   --  We have elements in the array Body_Part
3018
3019                   if Current_Verbosity = High then
3020                      Write_Line ("Found Bodies.");
3021                   end if;
3022
3023                   Data.Naming.Bodies := Bodies;
3024                   Check_Unit_Names (Bodies);
3025
3026                else
3027                   if Current_Verbosity = High then
3028                      Write_Line ("No Bodies.");
3029                   end if;
3030                end if;
3031
3032                if Specs /= No_Array_Element then
3033
3034                   --  We have elements in the array Specs
3035
3036                   if Current_Verbosity = High then
3037                      Write_Line ("Found Specs.");
3038                   end if;
3039
3040                   Data.Naming.Specs := Specs;
3041                   Check_Unit_Names (Specs);
3042
3043                else
3044                   if Current_Verbosity = High then
3045                      Write_Line ("No Specs.");
3046                   end if;
3047                end if;
3048             end;
3049
3050             --  We are now checking if variables Dot_Replacement, Casing,
3051             --  Spec_Suffix, Body_Suffix and/or Separate_Suffix exist.
3052
3053             --  For each variable, if it does not exist, we do nothing,
3054             --  because we already have the default.
3055
3056             --  Check Dot_Replacement
3057
3058             declare
3059                Dot_Replacement : constant Variable_Value :=
3060                                    Util.Value_Of
3061                                      (Name_Dot_Replacement,
3062                                       Naming.Decl.Attributes, In_Tree);
3063
3064             begin
3065                pragma Assert (Dot_Replacement.Kind = Single,
3066                               "Dot_Replacement is not a single string");
3067
3068                if not Dot_Replacement.Default then
3069                   Get_Name_String (Dot_Replacement.Value);
3070
3071                   if Name_Len = 0 then
3072                      Error_Msg
3073                        (Project, In_Tree,
3074                         "Dot_Replacement cannot be empty",
3075                         Dot_Replacement.Location);
3076
3077                   else
3078                      if Osint.File_Names_Case_Sensitive then
3079                         Data.Naming.Dot_Replacement :=
3080                           File_Name_Type (Dot_Replacement.Value);
3081                      else
3082                         Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3083                         Data.Naming.Dot_Replacement := Name_Find;
3084                      end if;
3085                      Data.Naming.Dot_Repl_Loc := Dot_Replacement.Location;
3086                   end if;
3087                end if;
3088             end;
3089
3090             if Current_Verbosity = High then
3091                Write_Str  ("  Dot_Replacement = """);
3092                Write_Str  (Get_Name_String (Data.Naming.Dot_Replacement));
3093                Write_Char ('"');
3094                Write_Eol;
3095             end if;
3096
3097             --  Check Casing
3098
3099             declare
3100                Casing_String : constant Variable_Value :=
3101                                  Util.Value_Of
3102                                    (Name_Casing,
3103                                     Naming.Decl.Attributes,
3104                                     In_Tree);
3105
3106             begin
3107                pragma Assert (Casing_String.Kind = Single,
3108                               "Casing is not a single string");
3109
3110                if not Casing_String.Default then
3111                   declare
3112                      Casing_Image : constant String :=
3113                                       Get_Name_String (Casing_String.Value);
3114                   begin
3115                      declare
3116                         Casing_Value : constant Casing_Type :=
3117                                          Value (Casing_Image);
3118                      begin
3119                         Data.Naming.Casing := Casing_Value;
3120                      end;
3121
3122                   exception
3123                      when Constraint_Error =>
3124                         if Casing_Image'Length = 0 then
3125                            Error_Msg
3126                              (Project, In_Tree,
3127                               "Casing cannot be an empty string",
3128                               Casing_String.Location);
3129
3130                         else
3131                            Name_Len := Casing_Image'Length;
3132                            Name_Buffer (1 .. Name_Len) := Casing_Image;
3133                            Err_Vars.Error_Msg_Name_1 := Name_Find;
3134                            Error_Msg
3135                              (Project, In_Tree,
3136                               "%% is not a correct Casing",
3137                               Casing_String.Location);
3138                         end if;
3139                   end;
3140                end if;
3141             end;
3142
3143             if Current_Verbosity = High then
3144                Write_Str  ("  Casing = ");
3145                Write_Str  (Image (Data.Naming.Casing));
3146                Write_Char ('.');
3147                Write_Eol;
3148             end if;
3149
3150             --  Check Spec_Suffix
3151
3152             declare
3153                Ada_Spec_Suffix : constant Variable_Value :=
3154                                    Prj.Util.Value_Of
3155                                      (Index     => Name_Ada,
3156                                       Src_Index => 0,
3157                                       In_Array  => Data.Naming.Spec_Suffix,
3158                                       In_Tree   => In_Tree);
3159
3160             begin
3161                if Ada_Spec_Suffix.Kind = Single
3162                  and then Get_Name_String (Ada_Spec_Suffix.Value) /= ""
3163                then
3164                   Get_Name_String (Ada_Spec_Suffix.Value);
3165                   Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3166                   Set_Spec_Suffix (In_Tree, "ada", Data.Naming, Name_Find);
3167                   Data.Naming.Ada_Spec_Suffix_Loc := Ada_Spec_Suffix.Location;
3168
3169                else
3170                   Set_Spec_Suffix
3171                     (In_Tree,
3172                      "ada",
3173                      Data.Naming,
3174                      Default_Ada_Spec_Suffix);
3175                end if;
3176             end;
3177
3178             if Current_Verbosity = High then
3179                Write_Str  ("  Spec_Suffix = """);
3180                Write_Str  (Spec_Suffix_Of (In_Tree, "ada", Data.Naming));
3181                Write_Char ('"');
3182                Write_Eol;
3183             end if;
3184
3185             --  Check Body_Suffix
3186
3187             declare
3188                Ada_Body_Suffix : constant Variable_Value :=
3189                                    Prj.Util.Value_Of
3190                                      (Index     => Name_Ada,
3191                                       Src_Index => 0,
3192                                       In_Array  => Data.Naming.Body_Suffix,
3193                                       In_Tree   => In_Tree);
3194
3195             begin
3196                if Ada_Body_Suffix.Kind = Single
3197                  and then Get_Name_String (Ada_Body_Suffix.Value) /= ""
3198                then
3199                   Get_Name_String (Ada_Body_Suffix.Value);
3200                   Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3201                   Set_Body_Suffix (In_Tree, "ada", Data.Naming, Name_Find);
3202                   Data.Naming.Ada_Body_Suffix_Loc := Ada_Body_Suffix.Location;
3203
3204                else
3205                   Set_Body_Suffix
3206                     (In_Tree,
3207                      "ada",
3208                      Data.Naming,
3209                      Default_Ada_Body_Suffix);
3210                end if;
3211             end;
3212
3213             if Current_Verbosity = High then
3214                Write_Str  ("  Body_Suffix = """);
3215                Write_Str  (Body_Suffix_Of (In_Tree, "ada", Data.Naming));
3216                Write_Char ('"');
3217                Write_Eol;
3218             end if;
3219
3220             --  Check Separate_Suffix
3221
3222             declare
3223                Ada_Sep_Suffix : constant Variable_Value :=
3224                                   Prj.Util.Value_Of
3225                                     (Variable_Name => Name_Separate_Suffix,
3226                                      In_Variables  => Naming.Decl.Attributes,
3227                                      In_Tree       => In_Tree);
3228
3229             begin
3230                if Ada_Sep_Suffix.Default then
3231                   Data.Naming.Separate_Suffix :=
3232                     Body_Suffix_Id_Of (In_Tree, Name_Ada, Data.Naming);
3233
3234                else
3235                   Get_Name_String (Ada_Sep_Suffix.Value);
3236
3237                   if Name_Len = 0 then
3238                      Error_Msg
3239                        (Project, In_Tree,
3240                         "Separate_Suffix cannot be empty",
3241                         Ada_Sep_Suffix.Location);
3242
3243                   else
3244                      Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3245                      Data.Naming.Separate_Suffix := Name_Find;
3246                      Data.Naming.Sep_Suffix_Loc  := Ada_Sep_Suffix.Location;
3247                   end if;
3248                end if;
3249             end;
3250
3251             if Current_Verbosity = High then
3252                Write_Str  ("  Separate_Suffix = """);
3253                Write_Str  (Get_Name_String (Data.Naming.Separate_Suffix));
3254                Write_Char ('"');
3255                Write_Eol;
3256             end if;
3257
3258             --  Check if Data.Naming is valid
3259
3260             Check_Ada_Naming_Scheme_Validity (Project, In_Tree, Data.Naming);
3261          end if;
3262
3263       elsif not In_Configuration then
3264
3265          --  Look into package Naming, if there is one
3266
3267          if Naming_Id /= No_Package then
3268             Naming := In_Tree.Packages.Table (Naming_Id);
3269
3270             if Current_Verbosity = High then
3271                Write_Line ("Checking package Naming.");
3272             end if;
3273
3274             --  We are now checking if attribute Dot_Replacement, Casing,
3275             --  and/or Separate_Suffix exist.
3276
3277             --  For each attribute, if it does not exist, we do nothing,
3278             --  because we already have the default.
3279             --  Otherwise, for all unit-based languages, we put the declared
3280             --  value in the language config.
3281
3282             declare
3283                Dot_Repl        : constant Variable_Value :=
3284                                    Util.Value_Of
3285                                      (Name_Dot_Replacement,
3286                                       Naming.Decl.Attributes, In_Tree);
3287                Dot_Replacement : File_Name_Type := No_File;
3288
3289                Casing_String : constant Variable_Value :=
3290                                  Util.Value_Of
3291                                    (Name_Casing,
3292                                     Naming.Decl.Attributes,
3293                                     In_Tree);
3294
3295                Casing : Casing_Type := All_Lower_Case;
3296                --  Casing type (junk initialization to stop bad gcc warning)
3297
3298                Casing_Defined : Boolean := False;
3299
3300                Sep_Suffix : constant Variable_Value :=
3301                               Prj.Util.Value_Of
3302                                 (Variable_Name => Name_Separate_Suffix,
3303                                  In_Variables  => Naming.Decl.Attributes,
3304                                  In_Tree       => In_Tree);
3305
3306                Separate_Suffix : File_Name_Type := No_File;
3307                Lang_Id         : Language_Index;
3308
3309             begin
3310                --  Check attribute Dot_Replacement
3311
3312                if not Dot_Repl.Default then
3313                   Get_Name_String (Dot_Repl.Value);
3314
3315                   if Name_Len = 0 then
3316                      Error_Msg
3317                        (Project, In_Tree,
3318                         "Dot_Replacement cannot be empty",
3319                         Dot_Repl.Location);
3320
3321                   else
3322                      Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3323                      Dot_Replacement := Name_Find;
3324
3325                      if Current_Verbosity = High then
3326                         Write_Str  ("  Dot_Replacement = """);
3327                         Write_Str  (Get_Name_String (Dot_Replacement));
3328                         Write_Char ('"');
3329                         Write_Eol;
3330                      end if;
3331                   end if;
3332                end if;
3333
3334                --  Check attribute Casing
3335
3336                if not Casing_String.Default then
3337                   declare
3338                      Casing_Image : constant String :=
3339                                       Get_Name_String (Casing_String.Value);
3340                   begin
3341                      declare
3342                         Casing_Value : constant Casing_Type :=
3343                                          Value (Casing_Image);
3344                      begin
3345                         Casing := Casing_Value;
3346                         Casing_Defined := True;
3347
3348                         if Current_Verbosity = High then
3349                            Write_Str  ("  Casing = ");
3350                            Write_Str  (Image (Casing));
3351                            Write_Char ('.');
3352                            Write_Eol;
3353                         end if;
3354                      end;
3355
3356                   exception
3357                      when Constraint_Error =>
3358                         if Casing_Image'Length = 0 then
3359                            Error_Msg
3360                              (Project, In_Tree,
3361                               "Casing cannot be an empty string",
3362                               Casing_String.Location);
3363
3364                         else
3365                            Name_Len := Casing_Image'Length;
3366                            Name_Buffer (1 .. Name_Len) := Casing_Image;
3367                            Err_Vars.Error_Msg_Name_1 := Name_Find;
3368                            Error_Msg
3369                              (Project, In_Tree,
3370                               "%% is not a correct Casing",
3371                               Casing_String.Location);
3372                         end if;
3373                   end;
3374                end if;
3375
3376                if not Sep_Suffix.Default then
3377                   Get_Name_String (Sep_Suffix.Value);
3378
3379                   if Name_Len = 0 then
3380                      Error_Msg
3381                        (Project, In_Tree,
3382                         "Separate_Suffix cannot be empty",
3383                         Sep_Suffix.Location);
3384
3385                   else
3386                      Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3387                      Separate_Suffix := Name_Find;
3388
3389                      if Current_Verbosity = High then
3390                         Write_Str ("  Separate_Suffix = """);
3391                         Write_Str (Get_Name_String (Separate_Suffix));
3392                         Write_Char ('"');
3393                         Write_Eol;
3394                      end if;
3395                   end if;
3396                end if;
3397
3398                --  For all unit based languages, if any, set the specified
3399                --  value of Dot_Replacement, Casing and/or Separate_Suffix.
3400
3401                if Dot_Replacement /= No_File
3402                  or else Casing_Defined
3403                  or else Separate_Suffix /= No_File
3404                then
3405                   Lang_Id := Data.First_Language_Processing;
3406                   while Lang_Id /= No_Language_Index loop
3407                      if In_Tree.Languages_Data.Table
3408                        (Lang_Id).Config.Kind = Unit_Based
3409                      then
3410                         if Dot_Replacement /= No_File then
3411                            In_Tree.Languages_Data.Table
3412                              (Lang_Id).Config.Naming_Data.Dot_Replacement :=
3413                              Dot_Replacement;
3414                         end if;
3415
3416                         if Casing_Defined then
3417                            In_Tree.Languages_Data.Table
3418                              (Lang_Id).Config.Naming_Data.Casing := Casing;
3419                         end if;
3420
3421                         if Separate_Suffix /= No_File then
3422                            In_Tree.Languages_Data.Table
3423                              (Lang_Id).Config.Naming_Data.Separate_Suffix :=
3424                                Separate_Suffix;
3425                         end if;
3426                      end if;
3427
3428                      Lang_Id :=
3429                        In_Tree.Languages_Data.Table (Lang_Id).Next;
3430                   end loop;
3431                end if;
3432             end;
3433
3434             --  Next, get the spec and body suffixes
3435
3436             declare
3437                Suffix  : Variable_Value;
3438                Lang_Id : Language_Index;
3439                Lang    : Name_Id;
3440
3441             begin
3442                Lang_Id := Data.First_Language_Processing;
3443                while Lang_Id /= No_Language_Index loop
3444                   Lang := In_Tree.Languages_Data.Table (Lang_Id).Name;
3445
3446                   --  Spec_Suffix
3447
3448                   Suffix := Value_Of
3449                     (Name                    => Lang,
3450                      Attribute_Or_Array_Name => Name_Spec_Suffix,
3451                      In_Package              => Naming_Id,
3452                      In_Tree                 => In_Tree);
3453
3454                   if Suffix = Nil_Variable_Value then
3455                      Suffix := Value_Of
3456                        (Name                    => Lang,
3457                         Attribute_Or_Array_Name => Name_Specification_Suffix,
3458                         In_Package              => Naming_Id,
3459                         In_Tree                 => In_Tree);
3460                   end if;
3461
3462                   if Suffix /= Nil_Variable_Value then
3463                      In_Tree.Languages_Data.Table (Lang_Id).
3464                        Config.Naming_Data.Spec_Suffix :=
3465                          File_Name_Type (Suffix.Value);
3466                   end if;
3467
3468                   --  Body_Suffix
3469
3470                   Suffix := Value_Of
3471                     (Name                    => Lang,
3472                      Attribute_Or_Array_Name => Name_Body_Suffix,
3473                      In_Package              => Naming_Id,
3474                      In_Tree                 => In_Tree);
3475
3476                   if Suffix = Nil_Variable_Value then
3477                      Suffix := Value_Of
3478                        (Name                    => Lang,
3479                         Attribute_Or_Array_Name => Name_Implementation_Suffix,
3480                         In_Package              => Naming_Id,
3481                         In_Tree                 => In_Tree);
3482                   end if;
3483
3484                   if Suffix /= Nil_Variable_Value then
3485                      In_Tree.Languages_Data.Table (Lang_Id).
3486                        Config.Naming_Data.Body_Suffix :=
3487                          File_Name_Type (Suffix.Value);
3488                   end if;
3489
3490                   Lang_Id := In_Tree.Languages_Data.Table (Lang_Id).Next;
3491                end loop;
3492             end;
3493
3494             --  Get the exceptions for file based languages
3495
3496             Get_Exceptions (Spec);
3497             Get_Exceptions (Impl);
3498
3499             --  Get the exceptions for unit based languages
3500
3501             Get_Unit_Exceptions (Spec);
3502             Get_Unit_Exceptions (Impl);
3503
3504          end if;
3505       end if;
3506    end Check_Naming_Schemes;
3507
3508    ------------------------------
3509    -- Check_Library_Attributes --
3510    ------------------------------
3511
3512    procedure Check_Library_Attributes
3513      (Project : Project_Id;
3514       In_Tree : Project_Tree_Ref;
3515       Current_Dir : String;
3516       Data    : in out Project_Data)
3517    is
3518       Attributes   : constant Prj.Variable_Id := Data.Decl.Attributes;
3519
3520       Lib_Dir      : constant Prj.Variable_Value :=
3521                        Prj.Util.Value_Of
3522                          (Snames.Name_Library_Dir, Attributes, In_Tree);
3523
3524       Lib_Name     : constant Prj.Variable_Value :=
3525                        Prj.Util.Value_Of
3526                          (Snames.Name_Library_Name, Attributes, In_Tree);
3527
3528       Lib_Version  : constant Prj.Variable_Value :=
3529                        Prj.Util.Value_Of
3530                          (Snames.Name_Library_Version, Attributes, In_Tree);
3531
3532       Lib_ALI_Dir  : constant Prj.Variable_Value :=
3533                        Prj.Util.Value_Of
3534                          (Snames.Name_Library_Ali_Dir, Attributes, In_Tree);
3535
3536       The_Lib_Kind : constant Prj.Variable_Value :=
3537                        Prj.Util.Value_Of
3538                          (Snames.Name_Library_Kind, Attributes, In_Tree);
3539
3540       Imported_Project_List : Project_List := Empty_Project_List;
3541
3542       Continuation : String_Access := No_Continuation_String'Access;
3543
3544       Support_For_Libraries : Library_Support;
3545
3546       Library_Directory_Present : Boolean;
3547
3548       procedure Check_Library (Proj : Project_Id; Extends : Boolean);
3549       --  Check if an imported or extended project if also a library project
3550
3551       -------------------
3552       -- Check_Library --
3553       -------------------
3554
3555       procedure Check_Library (Proj : Project_Id; Extends : Boolean) is
3556          Proj_Data : Project_Data;
3557          Src_Id    : Source_Id;
3558
3559       begin
3560          if Proj /= No_Project then
3561             Proj_Data := In_Tree.Projects.Table (Proj);
3562
3563             if not Proj_Data.Library then
3564
3565                --  The only not library projects that are OK are those that
3566                --  have no sources. However, header files from non-Ada
3567                --  languages are OK, as there is nothing to compile.
3568
3569                Src_Id := Proj_Data.First_Source;
3570                while Src_Id /= No_Source loop
3571                   declare
3572                      Src : Source_Data renames In_Tree.Sources.Table (Src_Id);
3573                   begin
3574                      exit when Src.Lang_Kind /= File_Based
3575                        or else Src.Kind /= Spec;
3576                      Src_Id := Src.Next_In_Project;
3577                   end;
3578                end loop;
3579
3580                if Src_Id /= No_Source then
3581                   Error_Msg_Name_1 := Data.Name;
3582                   Error_Msg_Name_2 := Proj_Data.Name;
3583
3584                   if Extends then
3585                      if Data.Library_Kind /= Static then
3586                         Error_Msg
3587                           (Project, In_Tree,
3588                            Continuation.all &
3589                            "shared library project %% cannot extend " &
3590                            "project %% that is not a library project",
3591                            Data.Location);
3592                         Continuation := Continuation_String'Access;
3593                      end if;
3594
3595                   elsif Data.Library_Kind /= Static then
3596                      Error_Msg
3597                        (Project, In_Tree,
3598                         Continuation.all &
3599                         "shared library project %% cannot import project %% " &
3600                         "that is not a shared library project",
3601                         Data.Location);
3602                      Continuation := Continuation_String'Access;
3603                   end if;
3604                end if;
3605
3606             elsif Data.Library_Kind /= Static and then
3607                   Proj_Data.Library_Kind = Static
3608             then
3609                Error_Msg_Name_1 := Data.Name;
3610                Error_Msg_Name_2 := Proj_Data.Name;
3611
3612                if Extends then
3613                   Error_Msg
3614                     (Project, In_Tree,
3615                      Continuation.all &
3616                      "shared library project %% cannot extend static " &
3617                      "library project %%",
3618                      Data.Location);
3619
3620                else
3621                   Error_Msg
3622                     (Project, In_Tree,
3623                      Continuation.all &
3624                      "shared library project %% cannot import static " &
3625                      "library project %%",
3626                      Data.Location);
3627                end if;
3628
3629                Continuation := Continuation_String'Access;
3630             end if;
3631          end if;
3632       end Check_Library;
3633
3634    --  Start of processing for Check_Library_Attributes
3635
3636    begin
3637       Library_Directory_Present := Lib_Dir.Value /= Empty_String;
3638
3639       --  Special case of extending project
3640
3641       if Data.Extends /= No_Project then
3642          declare
3643             Extended_Data : constant Project_Data :=
3644                               In_Tree.Projects.Table (Data.Extends);
3645
3646          begin
3647             --  If the project extended is a library project, we inherit the
3648             --  library name, if it is not redefined; we check that the library
3649             --  directory is specified.
3650
3651             if Extended_Data.Library then
3652                if Data.Qualifier = Standard then
3653                   Error_Msg
3654                     (Project, In_Tree,
3655                      "a standard project cannot extend a library project",
3656                      Data.Location);
3657
3658                else
3659                   if Lib_Name.Default then
3660                      Data.Library_Name := Extended_Data.Library_Name;
3661                   end if;
3662
3663                   if Lib_Dir.Default then
3664                      if not Data.Virtual then
3665                         Error_Msg
3666                           (Project, In_Tree,
3667                            "a project extending a library project must " &
3668                            "specify an attribute Library_Dir",
3669                            Data.Location);
3670
3671                      else
3672                         --  For a virtual project extending a library project,
3673                         --  inherit library directory.
3674
3675                         Data.Library_Dir := Extended_Data.Library_Dir;
3676                         Library_Directory_Present := True;
3677                      end if;
3678                   end if;
3679                end if;
3680             end if;
3681          end;
3682       end if;
3683
3684       pragma Assert (Lib_Name.Kind = Single);
3685
3686       if Lib_Name.Value = Empty_String then
3687          if Current_Verbosity = High
3688            and then Data.Library_Name = No_Name
3689          then
3690             Write_Line ("No library name");
3691          end if;
3692
3693       else
3694          --  There is no restriction on the syntax of library names
3695
3696          Data.Library_Name := Lib_Name.Value;
3697       end if;
3698
3699       if Data.Library_Name /= No_Name then
3700          if Current_Verbosity = High then
3701             Write_Str ("Library name = """);
3702             Write_Str (Get_Name_String (Data.Library_Name));
3703             Write_Line ("""");
3704          end if;
3705
3706          pragma Assert (Lib_Dir.Kind = Single);
3707
3708          if not Library_Directory_Present then
3709             if Current_Verbosity = High then
3710                Write_Line ("No library directory");
3711             end if;
3712
3713          else
3714             --  Find path name (unless inherited), check that it is a directory
3715
3716             if Data.Library_Dir = No_Path_Information then
3717                Locate_Directory
3718                  (Project,
3719                   In_Tree,
3720                   File_Name_Type (Lib_Dir.Value),
3721                   Data.Directory.Display_Name,
3722                   Data.Library_Dir.Name,
3723                   Data.Library_Dir.Display_Name,
3724                   Create      => "library",
3725                   Current_Dir => Current_Dir,
3726                   Location    => Lib_Dir.Location);
3727             end if;
3728
3729             if Data.Library_Dir = No_Path_Information then
3730
3731                --  Get the absolute name of the library directory that
3732                --  does not exist, to report an error.
3733
3734                declare
3735                   Dir_Name : constant String :=
3736                                Get_Name_String (Lib_Dir.Value);
3737
3738                begin
3739                   if Is_Absolute_Path (Dir_Name) then
3740                      Err_Vars.Error_Msg_File_1 :=
3741                        File_Name_Type (Lib_Dir.Value);
3742
3743                   else
3744                      Get_Name_String (Data.Directory.Display_Name);
3745
3746                      if Name_Buffer (Name_Len) /= Directory_Separator then
3747                         Name_Len := Name_Len + 1;
3748                         Name_Buffer (Name_Len) := Directory_Separator;
3749                      end if;
3750
3751                      Name_Buffer
3752                        (Name_Len + 1 .. Name_Len + Dir_Name'Length) :=
3753                        Dir_Name;
3754                      Name_Len := Name_Len + Dir_Name'Length;
3755                      Err_Vars.Error_Msg_File_1 := Name_Find;
3756                   end if;
3757
3758                   --  Report the error
3759
3760                   Error_Msg
3761                     (Project, In_Tree,
3762                      "library directory { does not exist",
3763                      Lib_Dir.Location);
3764                end;
3765
3766                --  The library directory cannot be the same as the Object
3767                --  directory.
3768
3769             elsif Data.Library_Dir.Name = Data.Object_Directory.Name then
3770                Error_Msg
3771                  (Project, In_Tree,
3772                   "library directory cannot be the same " &
3773                   "as object directory",
3774                   Lib_Dir.Location);
3775                Data.Library_Dir := No_Path_Information;
3776
3777             else
3778                declare
3779                   OK       : Boolean := True;
3780                   Dirs_Id  : String_List_Id;
3781                   Dir_Elem : String_Element;
3782
3783                begin
3784                   --  The library directory cannot be the same as a source
3785                   --  directory of the current project.
3786
3787                   Dirs_Id := Data.Source_Dirs;
3788                   while Dirs_Id /= Nil_String loop
3789                      Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id);
3790                      Dirs_Id  := Dir_Elem.Next;
3791
3792                      if
3793                        Data.Library_Dir.Name = Path_Name_Type (Dir_Elem.Value)
3794                      then
3795                         Err_Vars.Error_Msg_File_1 :=
3796                           File_Name_Type (Dir_Elem.Value);
3797                         Error_Msg
3798                           (Project, In_Tree,
3799                            "library directory cannot be the same " &
3800                            "as source directory {",
3801                            Lib_Dir.Location);
3802                         OK := False;
3803                         exit;
3804                      end if;
3805                   end loop;
3806
3807                   if OK then
3808
3809                      --  The library directory cannot be the same as a source
3810                      --  directory of another project either.
3811
3812                      Project_Loop :
3813                      for Pid in 1 .. Project_Table.Last (In_Tree.Projects) loop
3814                         if Pid /= Project then
3815                            Dirs_Id := In_Tree.Projects.Table (Pid).Source_Dirs;
3816
3817                            Dir_Loop : while Dirs_Id /= Nil_String loop
3818                               Dir_Elem :=
3819                                 In_Tree.String_Elements.Table (Dirs_Id);
3820                               Dirs_Id  := Dir_Elem.Next;
3821
3822                               if Data.Library_Dir.Name =
3823                                 Path_Name_Type (Dir_Elem.Value)
3824                               then
3825                                  Err_Vars.Error_Msg_File_1 :=
3826                                    File_Name_Type (Dir_Elem.Value);
3827                                  Err_Vars.Error_Msg_Name_1 :=
3828                                    In_Tree.Projects.Table (Pid).Name;
3829
3830                                  Error_Msg
3831                                    (Project, In_Tree,
3832                                     "library directory cannot be the same " &
3833                                     "as source directory { of project %%",
3834                                     Lib_Dir.Location);
3835                                  OK := False;
3836                                  exit Project_Loop;
3837                               end if;
3838                            end loop Dir_Loop;
3839                         end if;
3840                      end loop Project_Loop;
3841                   end if;
3842
3843                   if not OK then
3844                      Data.Library_Dir := No_Path_Information;
3845
3846                   elsif Current_Verbosity = High then
3847
3848                      --  Display the Library directory in high verbosity
3849
3850                      Write_Str ("Library directory =""");
3851                      Write_Str
3852                        (Get_Name_String (Data.Library_Dir.Display_Name));
3853                      Write_Line ("""");
3854                   end if;
3855                end;
3856             end if;
3857          end if;
3858
3859       end if;
3860
3861       Data.Library :=
3862         Data.Library_Dir /= No_Path_Information
3863         and then
3864       Data.Library_Name /= No_Name;
3865
3866       if Data.Extends = No_Project then
3867          case Data.Qualifier is
3868             when Standard =>
3869                if Data.Library then
3870                   Error_Msg
3871                     (Project, In_Tree,
3872                      "a standard project cannot be a library project",
3873                      Lib_Name.Location);
3874                end if;
3875
3876             when Library =>
3877                if not Data.Library then
3878                   if Data.Library_Dir = No_Path_Information then
3879                      Error_Msg
3880                        (Project, In_Tree,
3881                         "\attribute Library_Dir not declared",
3882                         Data.Location);
3883                   end if;
3884
3885                   if Data.Library_Name = No_Name then
3886                      Error_Msg
3887                        (Project, In_Tree,
3888                         "\attribute Library_Name not declared",
3889                         Data.Location);
3890                   end if;
3891                end if;
3892
3893             when others =>
3894                null;
3895
3896          end case;
3897       end if;
3898
3899       if Data.Library then
3900          if Get_Mode = Multi_Language then
3901             Support_For_Libraries := Data.Config.Lib_Support;
3902
3903          else
3904             Support_For_Libraries := MLib.Tgt.Support_For_Libraries;
3905          end if;
3906
3907          if Support_For_Libraries = Prj.None then
3908             Error_Msg
3909               (Project, In_Tree,
3910                "?libraries are not supported on this platform",
3911                Lib_Name.Location);
3912             Data.Library := False;
3913
3914          else
3915             if Lib_ALI_Dir.Value = Empty_String then
3916                if Current_Verbosity = High then
3917                   Write_Line ("No library ALI directory specified");
3918                end if;
3919                Data.Library_ALI_Dir := Data.Library_Dir;
3920
3921             else
3922                --  Find path name, check that it is a directory
3923
3924                Locate_Directory
3925                  (Project,
3926                   In_Tree,
3927                   File_Name_Type (Lib_ALI_Dir.Value),
3928                   Data.Directory.Display_Name,
3929                   Data.Library_ALI_Dir.Name,
3930                   Data.Library_ALI_Dir.Display_Name,
3931                   Create   => "library ALI",
3932                   Current_Dir => Current_Dir,
3933                   Location => Lib_ALI_Dir.Location);
3934
3935                if Data.Library_ALI_Dir = No_Path_Information then
3936
3937                   --  Get the absolute name of the library ALI directory that
3938                   --  does not exist, to report an error.
3939
3940                   declare
3941                      Dir_Name : constant String :=
3942                                   Get_Name_String (Lib_ALI_Dir.Value);
3943
3944                   begin
3945                      if Is_Absolute_Path (Dir_Name) then
3946                         Err_Vars.Error_Msg_File_1 :=
3947                           File_Name_Type (Lib_Dir.Value);
3948
3949                      else
3950                         Get_Name_String (Data.Directory.Display_Name);
3951
3952                         if Name_Buffer (Name_Len) /= Directory_Separator then
3953                            Name_Len := Name_Len + 1;
3954                            Name_Buffer (Name_Len) := Directory_Separator;
3955                         end if;
3956
3957                         Name_Buffer
3958                           (Name_Len + 1 .. Name_Len + Dir_Name'Length) :=
3959                           Dir_Name;
3960                         Name_Len := Name_Len + Dir_Name'Length;
3961                         Err_Vars.Error_Msg_File_1 := Name_Find;
3962                      end if;
3963
3964                      --  Report the error
3965
3966                      Error_Msg
3967                        (Project, In_Tree,
3968                         "library 'A'L'I directory { does not exist",
3969                         Lib_ALI_Dir.Location);
3970                   end;
3971                end if;
3972
3973                if Data.Library_ALI_Dir /= Data.Library_Dir then
3974
3975                   --  The library ALI directory cannot be the same as the
3976                   --  Object directory.
3977
3978                   if Data.Library_ALI_Dir = Data.Object_Directory then
3979                      Error_Msg
3980                        (Project, In_Tree,
3981                         "library 'A'L'I directory cannot be the same " &
3982                         "as object directory",
3983                         Lib_ALI_Dir.Location);
3984                      Data.Library_ALI_Dir := No_Path_Information;
3985
3986                   else
3987                      declare
3988                         OK       : Boolean := True;
3989                         Dirs_Id  : String_List_Id;
3990                         Dir_Elem : String_Element;
3991
3992                      begin
3993                         --  The library ALI directory cannot be the same as
3994                         --  a source directory of the current project.
3995
3996                         Dirs_Id := Data.Source_Dirs;
3997                         while Dirs_Id /= Nil_String loop
3998                            Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id);
3999                            Dirs_Id  := Dir_Elem.Next;
4000
4001                            if Data.Library_ALI_Dir.Name =
4002                              Path_Name_Type (Dir_Elem.Value)
4003                            then
4004                               Err_Vars.Error_Msg_File_1 :=
4005                                 File_Name_Type (Dir_Elem.Value);
4006                               Error_Msg
4007                                 (Project, In_Tree,
4008                                  "library 'A'L'I directory cannot be " &
4009                                  "the same as source directory {",
4010                                  Lib_ALI_Dir.Location);
4011                               OK := False;
4012                               exit;
4013                            end if;
4014                         end loop;
4015
4016                         if OK then
4017
4018                            --  The library ALI directory cannot be the same as
4019                            --  a source directory of another project either.
4020
4021                            ALI_Project_Loop :
4022                            for
4023                              Pid in 1 .. Project_Table.Last (In_Tree.Projects)
4024                            loop
4025                               if Pid /= Project then
4026                                  Dirs_Id :=
4027                                    In_Tree.Projects.Table (Pid).Source_Dirs;
4028
4029                                  ALI_Dir_Loop :
4030                                  while Dirs_Id /= Nil_String loop
4031                                     Dir_Elem :=
4032                                       In_Tree.String_Elements.Table (Dirs_Id);
4033                                     Dirs_Id  := Dir_Elem.Next;
4034
4035                                     if Data.Library_ALI_Dir.Name =
4036                                         Path_Name_Type (Dir_Elem.Value)
4037                                     then
4038                                        Err_Vars.Error_Msg_File_1 :=
4039                                          File_Name_Type (Dir_Elem.Value);
4040                                        Err_Vars.Error_Msg_Name_1 :=
4041                                          In_Tree.Projects.Table (Pid).Name;
4042
4043                                        Error_Msg
4044                                          (Project, In_Tree,
4045                                           "library 'A'L'I directory cannot " &
4046                                           "be the same as source directory " &
4047                                           "{ of project %%",
4048                                           Lib_ALI_Dir.Location);
4049                                        OK := False;
4050                                        exit ALI_Project_Loop;
4051                                     end if;
4052                                  end loop ALI_Dir_Loop;
4053                               end if;
4054                            end loop ALI_Project_Loop;
4055                         end if;
4056
4057                         if not OK then
4058                            Data.Library_ALI_Dir := No_Path_Information;
4059
4060                         elsif Current_Verbosity = High then
4061
4062                            --  Display the Library ALI directory in high
4063                            --  verbosity.
4064
4065                            Write_Str ("Library ALI directory =""");
4066                            Write_Str
4067                              (Get_Name_String
4068                                 (Data.Library_ALI_Dir.Display_Name));
4069                            Write_Line ("""");
4070                         end if;
4071                      end;
4072                   end if;
4073                end if;
4074             end if;
4075
4076             pragma Assert (Lib_Version.Kind = Single);
4077
4078             if Lib_Version.Value = Empty_String then
4079                if Current_Verbosity = High then
4080                   Write_Line ("No library version specified");
4081                end if;
4082
4083             else
4084                Data.Lib_Internal_Name := Lib_Version.Value;
4085             end if;
4086
4087             pragma Assert (The_Lib_Kind.Kind = Single);
4088
4089             if The_Lib_Kind.Value = Empty_String then
4090                if Current_Verbosity = High then
4091                   Write_Line ("No library kind specified");
4092                end if;
4093
4094             else
4095                Get_Name_String (The_Lib_Kind.Value);
4096
4097                declare
4098                   Kind_Name : constant String :=
4099                                 To_Lower (Name_Buffer (1 .. Name_Len));
4100
4101                   OK : Boolean := True;
4102
4103                begin
4104                   if Kind_Name = "static" then
4105                      Data.Library_Kind := Static;
4106
4107                   elsif Kind_Name = "dynamic" then
4108                      Data.Library_Kind := Dynamic;
4109
4110                   elsif Kind_Name = "relocatable" then
4111                      Data.Library_Kind := Relocatable;
4112
4113                   else
4114                      Error_Msg
4115                        (Project, In_Tree,
4116                         "illegal value for Library_Kind",
4117                         The_Lib_Kind.Location);
4118                      OK := False;
4119                   end if;
4120
4121                   if Current_Verbosity = High and then OK then
4122                      Write_Str ("Library kind = ");
4123                      Write_Line (Kind_Name);
4124                   end if;
4125
4126                   if Data.Library_Kind /= Static and then
4127                     Support_For_Libraries = Prj.Static_Only
4128                   then
4129                      Error_Msg
4130                        (Project, In_Tree,
4131                         "only static libraries are supported " &
4132                         "on this platform",
4133                         The_Lib_Kind.Location);
4134                      Data.Library := False;
4135                   end if;
4136                end;
4137             end if;
4138
4139             if Data.Library then
4140                if Current_Verbosity = High then
4141                   Write_Line ("This is a library project file");
4142                end if;
4143
4144                if Get_Mode = Multi_Language then
4145                   Check_Library (Data.Extends, Extends => True);
4146
4147                   Imported_Project_List := Data.Imported_Projects;
4148                   while Imported_Project_List /= Empty_Project_List loop
4149                      Check_Library
4150                        (In_Tree.Project_Lists.Table
4151                           (Imported_Project_List).Project,
4152                         Extends => False);
4153                      Imported_Project_List :=
4154                        In_Tree.Project_Lists.Table
4155                          (Imported_Project_List).Next;
4156                   end loop;
4157                end if;
4158             end if;
4159
4160          end if;
4161       end if;
4162
4163       --  Check if Linker'Switches or Linker'Default_Switches are declared.
4164       --  Warn if they are declared, as it is a common error to think that
4165       --  library are "linked" with Linker switches.
4166
4167       if Data.Library then
4168          declare
4169             Linker_Package_Id : constant Package_Id :=
4170                                   Util.Value_Of
4171                                     (Name_Linker, Data.Decl.Packages, In_Tree);
4172             Linker_Package    : Package_Element;
4173             Switches          : Array_Element_Id := No_Array_Element;
4174
4175          begin
4176             if Linker_Package_Id /= No_Package then
4177                Linker_Package := In_Tree.Packages.Table (Linker_Package_Id);
4178
4179                Switches :=
4180                  Value_Of
4181                    (Name      => Name_Switches,
4182                     In_Arrays => Linker_Package.Decl.Arrays,
4183                     In_Tree   => In_Tree);
4184
4185                if Switches = No_Array_Element then
4186                   Switches :=
4187                     Value_Of
4188                       (Name      => Name_Default_Switches,
4189                        In_Arrays => Linker_Package.Decl.Arrays,
4190                        In_Tree   => In_Tree);
4191                end if;
4192
4193                if Switches /= No_Array_Element then
4194                   Error_Msg
4195                     (Project, In_Tree,
4196                      "?Linker switches not taken into account in library " &
4197                      "projects",
4198                      No_Location);
4199                end if;
4200             end if;
4201          end;
4202       end if;
4203
4204       if Data.Extends /= No_Project then
4205          In_Tree.Projects.Table (Data.Extends).Library := False;
4206       end if;
4207    end Check_Library_Attributes;
4208
4209    --------------------------
4210    -- Check_Package_Naming --
4211    --------------------------
4212
4213    procedure Check_Package_Naming
4214      (Project : Project_Id;
4215       In_Tree : Project_Tree_Ref;
4216       Data    : in out Project_Data)
4217    is
4218       Naming_Id : constant Package_Id :=
4219                     Util.Value_Of (Name_Naming, Data.Decl.Packages, In_Tree);
4220
4221       Naming    : Package_Element;
4222
4223    begin
4224       --  If there is a package Naming, we will put in Data.Naming
4225       --  what is in this package Naming.
4226
4227       if Naming_Id /= No_Package then
4228          Naming := In_Tree.Packages.Table (Naming_Id);
4229
4230          if Current_Verbosity = High then
4231             Write_Line ("Checking ""Naming"".");
4232          end if;
4233
4234          --  Check Spec_Suffix
4235
4236          declare
4237             Spec_Suffixs : Array_Element_Id :=
4238                              Util.Value_Of
4239                                (Name_Spec_Suffix,
4240                                 Naming.Decl.Arrays,
4241                                 In_Tree);
4242
4243             Suffix  : Array_Element_Id;
4244             Element : Array_Element;
4245             Suffix2 : Array_Element_Id;
4246
4247          begin
4248             --  If some suffixes have been specified, we make sure that
4249             --  for each language for which a default suffix has been
4250             --  specified, there is a suffix specified, either the one
4251             --  in the project file or if there were none, the default.
4252
4253             if Spec_Suffixs /= No_Array_Element then
4254                Suffix := Data.Naming.Spec_Suffix;
4255
4256                while Suffix /= No_Array_Element loop
4257                   Element :=
4258                     In_Tree.Array_Elements.Table (Suffix);
4259                   Suffix2 := Spec_Suffixs;
4260
4261                   while Suffix2 /= No_Array_Element loop
4262                      exit when In_Tree.Array_Elements.Table
4263                                 (Suffix2).Index = Element.Index;
4264                      Suffix2 := In_Tree.Array_Elements.Table
4265                                  (Suffix2).Next;
4266                   end loop;
4267
4268                   --  There is a registered default suffix, but no
4269                   --  suffix specified in the project file.
4270                   --  Add the default to the array.
4271
4272                   if Suffix2 = No_Array_Element then
4273                      Array_Element_Table.Increment_Last
4274                        (In_Tree.Array_Elements);
4275                      In_Tree.Array_Elements.Table
4276                        (Array_Element_Table.Last
4277                           (In_Tree.Array_Elements)) :=
4278                        (Index                => Element.Index,
4279                         Src_Index            => Element.Src_Index,
4280                         Index_Case_Sensitive => False,
4281                         Value                => Element.Value,
4282                         Next                 => Spec_Suffixs);
4283                      Spec_Suffixs := Array_Element_Table.Last
4284                                        (In_Tree.Array_Elements);
4285                   end if;
4286
4287                   Suffix := Element.Next;
4288                end loop;
4289
4290                --  Put the resulting array as the specification suffixes
4291
4292                Data.Naming.Spec_Suffix := Spec_Suffixs;
4293             end if;
4294          end;
4295
4296          declare
4297             Current : Array_Element_Id;
4298             Element : Array_Element;
4299
4300          begin
4301             Current := Data.Naming.Spec_Suffix;
4302             while Current /= No_Array_Element loop
4303                Element := In_Tree.Array_Elements.Table (Current);
4304                Get_Name_String (Element.Value.Value);
4305
4306                if Name_Len = 0 then
4307                   Error_Msg
4308                     (Project, In_Tree,
4309                      "Spec_Suffix cannot be empty",
4310                      Element.Value.Location);
4311                end if;
4312
4313                In_Tree.Array_Elements.Table (Current) := Element;
4314                Current := Element.Next;
4315             end loop;
4316          end;
4317
4318          --  Check Body_Suffix
4319
4320          declare
4321             Impl_Suffixs : Array_Element_Id :=
4322                              Util.Value_Of
4323                                (Name_Body_Suffix,
4324                                 Naming.Decl.Arrays,
4325                                 In_Tree);
4326
4327             Suffix  : Array_Element_Id;
4328             Element : Array_Element;
4329             Suffix2 : Array_Element_Id;
4330
4331          begin
4332             --  If some suffixes have been specified, we make sure that
4333             --  for each language for which a default suffix has been
4334             --  specified, there is a suffix specified, either the one
4335             --  in the project file or if there were none, the default.
4336
4337             if Impl_Suffixs /= No_Array_Element then
4338                Suffix := Data.Naming.Body_Suffix;
4339                while Suffix /= No_Array_Element loop
4340                   Element :=
4341                     In_Tree.Array_Elements.Table (Suffix);
4342
4343                   Suffix2 := Impl_Suffixs;
4344                   while Suffix2 /= No_Array_Element loop
4345                      exit when In_Tree.Array_Elements.Table
4346                                 (Suffix2).Index = Element.Index;
4347                      Suffix2 := In_Tree.Array_Elements.Table
4348                                   (Suffix2).Next;
4349                   end loop;
4350
4351                   --  There is a registered default suffix, but no suffix was
4352                   --  specified in the project file. Add default to the array.
4353
4354                   if Suffix2 = No_Array_Element then
4355                      Array_Element_Table.Increment_Last
4356                        (In_Tree.Array_Elements);
4357                      In_Tree.Array_Elements.Table
4358                        (Array_Element_Table.Last
4359                           (In_Tree.Array_Elements)) :=
4360                        (Index                => Element.Index,
4361                         Src_Index            => Element.Src_Index,
4362                         Index_Case_Sensitive => False,
4363                         Value                => Element.Value,
4364                         Next                 => Impl_Suffixs);
4365                      Impl_Suffixs := Array_Element_Table.Last
4366                                        (In_Tree.Array_Elements);
4367                   end if;
4368
4369                   Suffix := Element.Next;
4370                end loop;
4371
4372                --  Put the resulting array as the implementation suffixes
4373
4374                Data.Naming.Body_Suffix := Impl_Suffixs;
4375             end if;
4376          end;
4377
4378          declare
4379             Current : Array_Element_Id;
4380             Element : Array_Element;
4381
4382          begin
4383             Current := Data.Naming.Body_Suffix;
4384             while Current /= No_Array_Element loop
4385                Element := In_Tree.Array_Elements.Table (Current);
4386                Get_Name_String (Element.Value.Value);
4387
4388                if Name_Len = 0 then
4389                   Error_Msg
4390                     (Project, In_Tree,
4391                      "Body_Suffix cannot be empty",
4392                      Element.Value.Location);
4393                end if;
4394
4395                In_Tree.Array_Elements.Table (Current) := Element;
4396                Current := Element.Next;
4397             end loop;
4398          end;
4399
4400          --  Get the exceptions, if any
4401
4402          Data.Naming.Specification_Exceptions :=
4403            Util.Value_Of
4404              (Name_Specification_Exceptions,
4405               In_Arrays => Naming.Decl.Arrays,
4406               In_Tree   => In_Tree);
4407
4408          Data.Naming.Implementation_Exceptions :=
4409            Util.Value_Of
4410              (Name_Implementation_Exceptions,
4411               In_Arrays => Naming.Decl.Arrays,
4412               In_Tree   => In_Tree);
4413       end if;
4414    end Check_Package_Naming;
4415
4416    ---------------------------------
4417    -- Check_Programming_Languages --
4418    ---------------------------------
4419
4420    procedure Check_Programming_Languages
4421      (In_Tree : Project_Tree_Ref;
4422       Project : Project_Id;
4423       Data    : in out Project_Data)
4424    is
4425       Languages   : Variable_Value := Nil_Variable_Value;
4426       Def_Lang    : Variable_Value := Nil_Variable_Value;
4427       Def_Lang_Id : Name_Id;
4428
4429    begin
4430       Data.First_Language_Processing := No_Language_Index;
4431       Languages :=
4432         Prj.Util.Value_Of (Name_Languages, Data.Decl.Attributes, In_Tree);
4433       Def_Lang :=
4434         Prj.Util.Value_Of
4435           (Name_Default_Language, Data.Decl.Attributes, In_Tree);
4436       Data.Ada_Sources_Present   := Data.Source_Dirs /= Nil_String;
4437       Data.Other_Sources_Present := Data.Source_Dirs /= Nil_String;
4438
4439       if Data.Source_Dirs /= Nil_String then
4440
4441          --  Check if languages are specified in this project
4442
4443          if Languages.Default then
4444
4445             --  Attribute Languages is not specified. So, it defaults to
4446             --  a project of the default language only.
4447
4448             Name_List_Table.Increment_Last (In_Tree.Name_Lists);
4449             Data.Languages := Name_List_Table.Last (In_Tree.Name_Lists);
4450
4451             --  In Ada_Only mode, the default language is Ada
4452
4453             if Get_Mode = Ada_Only then
4454                In_Tree.Name_Lists.Table (Data.Languages) :=
4455                  (Name => Name_Ada, Next => No_Name_List);
4456
4457                --  Attribute Languages is not specified. So, it defaults to
4458                --  a project of language Ada only. No sources of languages
4459                --  other than Ada
4460
4461                Data.Other_Sources_Present := False;
4462
4463             else
4464                --  Fail if there is no default language defined
4465
4466                if Def_Lang.Default then
4467                   if not Default_Language_Is_Ada then
4468                      Error_Msg
4469                        (Project,
4470                         In_Tree,
4471                         "no languages defined for this project",
4472                         Data.Location);
4473                      Def_Lang_Id := No_Name;
4474                   else
4475                      Def_Lang_Id := Name_Ada;
4476                   end if;
4477
4478                else
4479                   Get_Name_String (Def_Lang.Value);
4480                   To_Lower (Name_Buffer (1 .. Name_Len));
4481                   Def_Lang_Id := Name_Find;
4482                end if;
4483
4484                if Def_Lang_Id /=  No_Name then
4485                   In_Tree.Name_Lists.Table (Data.Languages) :=
4486                     (Name => Def_Lang_Id, Next => No_Name_List);
4487
4488                   Language_Data_Table.Increment_Last (In_Tree.Languages_Data);
4489
4490                   Data.First_Language_Processing :=
4491                     Language_Data_Table.Last (In_Tree.Languages_Data);
4492                   In_Tree.Languages_Data.Table
4493                     (Data.First_Language_Processing) := No_Language_Data;
4494                   In_Tree.Languages_Data.Table
4495                     (Data.First_Language_Processing).Name := Def_Lang_Id;
4496                   Get_Name_String (Def_Lang_Id);
4497                   Name_Buffer (1) := GNAT.Case_Util.To_Upper (Name_Buffer (1));
4498                   In_Tree.Languages_Data.Table
4499                     (Data.First_Language_Processing).Display_Name := Name_Find;
4500
4501                   if Def_Lang_Id = Name_Ada then
4502                      In_Tree.Languages_Data.Table
4503                        (Data.First_Language_Processing).Config.Kind
4504                        := Unit_Based;
4505                      In_Tree.Languages_Data.Table
4506                        (Data.First_Language_Processing).Config.Dependency_Kind
4507                        := ALI_File;
4508                      Data.Unit_Based_Language_Name := Name_Ada;
4509                      Data.Unit_Based_Language_Index :=
4510                        Data.First_Language_Processing;
4511                   else
4512                      In_Tree.Languages_Data.Table
4513                        (Data.First_Language_Processing).Config.Kind
4514                        := File_Based;
4515                   end if;
4516                end if;
4517             end if;
4518
4519          else
4520             declare
4521                Current           : String_List_Id := Languages.Values;
4522                Element           : String_Element;
4523                Lang_Name         : Name_Id;
4524                Index             : Language_Index;
4525                Lang_Data         : Language_Data;
4526                NL_Id             : Name_List_Index := No_Name_List;
4527
4528             begin
4529                --  Assume there are no language declared
4530
4531                Data.Ada_Sources_Present := False;
4532                Data.Other_Sources_Present := False;
4533
4534                --  If there are no languages declared, there are no sources
4535
4536                if Current = Nil_String then
4537                   Data.Source_Dirs := Nil_String;
4538
4539                   if Data.Qualifier = Standard then
4540                      Error_Msg
4541                        (Project,
4542                         In_Tree,
4543                         "a standard project cannot have no language declared",
4544                         Languages.Location);
4545                   end if;
4546
4547                else
4548                   --  Look through all the languages specified in attribute
4549                   --  Languages.
4550
4551                   while Current /= Nil_String loop
4552                      Element :=
4553                        In_Tree.String_Elements.Table (Current);
4554                      Get_Name_String (Element.Value);
4555                      To_Lower (Name_Buffer (1 .. Name_Len));
4556                      Lang_Name := Name_Find;
4557
4558                      NL_Id := Data.Languages;
4559                      while NL_Id /= No_Name_List loop
4560                         exit when
4561                           Lang_Name = In_Tree.Name_Lists.Table (NL_Id).Name;
4562                         NL_Id := In_Tree.Name_Lists.Table (NL_Id).Next;
4563                      end loop;
4564
4565                      if NL_Id = No_Name_List then
4566                         Name_List_Table.Increment_Last (In_Tree.Name_Lists);
4567
4568                         if Data.Languages = No_Name_List then
4569                            Data.Languages :=
4570                              Name_List_Table.Last (In_Tree.Name_Lists);
4571
4572                         else
4573                            NL_Id := Data.Languages;
4574                            while In_Tree.Name_Lists.Table (NL_Id).Next /=
4575                                    No_Name_List
4576                            loop
4577                               NL_Id := In_Tree.Name_Lists.Table (NL_Id).Next;
4578                            end loop;
4579
4580                            In_Tree.Name_Lists.Table (NL_Id).Next :=
4581                              Name_List_Table.Last (In_Tree.Name_Lists);
4582                         end if;
4583
4584                         NL_Id := Name_List_Table.Last (In_Tree.Name_Lists);
4585                         In_Tree.Name_Lists.Table (NL_Id) :=
4586                           (Lang_Name, No_Name_List);
4587
4588                         if Get_Mode = Ada_Only then
4589                            --  Check for language Ada
4590
4591                            if Lang_Name = Name_Ada then
4592                               Data.Ada_Sources_Present := True;
4593
4594                            else
4595                               Data.Other_Sources_Present := True;
4596                            end if;
4597
4598                         else
4599                            Language_Data_Table.Increment_Last
4600                                                  (In_Tree.Languages_Data);
4601                            Index :=
4602                              Language_Data_Table.Last (In_Tree.Languages_Data);
4603                            Lang_Data.Name := Lang_Name;
4604                            Lang_Data.Display_Name := Element.Value;
4605                            Lang_Data.Next := Data.First_Language_Processing;
4606
4607                            if Lang_Name = Name_Ada then
4608                               Lang_Data.Config.Kind := Unit_Based;
4609                               Lang_Data.Config.Dependency_Kind := ALI_File;
4610                               Data.Unit_Based_Language_Name := Name_Ada;
4611                               Data.Unit_Based_Language_Index := Index;
4612
4613                            else
4614                               Lang_Data.Config.Kind := File_Based;
4615                               Lang_Data.Config.Dependency_Kind := None;
4616                            end if;
4617
4618                            In_Tree.Languages_Data.Table (Index) := Lang_Data;
4619                            Data.First_Language_Processing := Index;
4620                         end if;
4621                      end if;
4622
4623                      Current := Element.Next;
4624                   end loop;
4625                end if;
4626             end;
4627          end if;
4628       end if;
4629    end Check_Programming_Languages;
4630
4631    -------------------
4632    -- Check_Project --
4633    -------------------
4634
4635    function Check_Project
4636      (P            : Project_Id;
4637       Root_Project : Project_Id;
4638       In_Tree      : Project_Tree_Ref;
4639       Extending    : Boolean) return Boolean
4640    is
4641    begin
4642       if P = Root_Project then
4643          return True;
4644
4645       elsif Extending then
4646          declare
4647             Data : Project_Data := In_Tree.Projects.Table (Root_Project);
4648
4649          begin
4650             while Data.Extends /= No_Project loop
4651                if P = Data.Extends then
4652                   return True;
4653                end if;
4654
4655                Data := In_Tree.Projects.Table (Data.Extends);
4656             end loop;
4657          end;
4658       end if;
4659
4660       return False;
4661    end Check_Project;
4662
4663    -------------------------------
4664    -- Check_Stand_Alone_Library --
4665    -------------------------------
4666
4667    procedure Check_Stand_Alone_Library
4668      (Project     : Project_Id;
4669       In_Tree     : Project_Tree_Ref;
4670       Data        : in out Project_Data;
4671       Current_Dir : String;
4672       Extending   : Boolean)
4673    is
4674       Lib_Interfaces      : constant Prj.Variable_Value :=
4675                               Prj.Util.Value_Of
4676                                 (Snames.Name_Library_Interface,
4677                                  Data.Decl.Attributes,
4678                                  In_Tree);
4679
4680       Lib_Auto_Init       : constant Prj.Variable_Value :=
4681                               Prj.Util.Value_Of
4682                                 (Snames.Name_Library_Auto_Init,
4683                                  Data.Decl.Attributes,
4684                                  In_Tree);
4685
4686       Lib_Src_Dir         : constant Prj.Variable_Value :=
4687                               Prj.Util.Value_Of
4688                                 (Snames.Name_Library_Src_Dir,
4689                                  Data.Decl.Attributes,
4690                                  In_Tree);
4691
4692       Lib_Symbol_File     : constant Prj.Variable_Value :=
4693                               Prj.Util.Value_Of
4694                                 (Snames.Name_Library_Symbol_File,
4695                                  Data.Decl.Attributes,
4696                                  In_Tree);
4697
4698       Lib_Symbol_Policy   : constant Prj.Variable_Value :=
4699                               Prj.Util.Value_Of
4700                                 (Snames.Name_Library_Symbol_Policy,
4701                                  Data.Decl.Attributes,
4702                                  In_Tree);
4703
4704       Lib_Ref_Symbol_File : constant Prj.Variable_Value :=
4705                               Prj.Util.Value_Of
4706                                 (Snames.Name_Library_Reference_Symbol_File,
4707                                  Data.Decl.Attributes,
4708                                  In_Tree);
4709
4710       Auto_Init_Supported : Boolean;
4711       OK                  : Boolean := True;
4712       Source              : Source_Id;
4713       Next_Proj           : Project_Id;
4714
4715    begin
4716       if Get_Mode = Multi_Language then
4717          Auto_Init_Supported := Data.Config.Auto_Init_Supported;
4718       else
4719          Auto_Init_Supported :=
4720            MLib.Tgt.Standalone_Library_Auto_Init_Is_Supported;
4721       end if;
4722
4723       pragma Assert (Lib_Interfaces.Kind = List);
4724
4725       --  It is a stand-alone library project file if attribute
4726       --  Library_Interface is defined.
4727
4728       if not Lib_Interfaces.Default then
4729          SAL_Library : declare
4730             Interfaces     : String_List_Id := Lib_Interfaces.Values;
4731             Interface_ALIs : String_List_Id := Nil_String;
4732             Unit           : Name_Id;
4733             The_Unit_Id    : Unit_Index;
4734             The_Unit_Data  : Unit_Data;
4735
4736             procedure Add_ALI_For (Source : File_Name_Type);
4737             --  Add an ALI file name to the list of Interface ALIs
4738
4739             -----------------
4740             -- Add_ALI_For --
4741             -----------------
4742
4743             procedure Add_ALI_For (Source : File_Name_Type) is
4744             begin
4745                Get_Name_String (Source);
4746
4747                declare
4748                   ALI         : constant String :=
4749                                   ALI_File_Name (Name_Buffer (1 .. Name_Len));
4750                   ALI_Name_Id : Name_Id;
4751
4752                begin
4753                   Name_Len := ALI'Length;
4754                   Name_Buffer (1 .. Name_Len) := ALI;
4755                   ALI_Name_Id := Name_Find;
4756
4757                   String_Element_Table.Increment_Last
4758                     (In_Tree.String_Elements);
4759                   In_Tree.String_Elements.Table
4760                     (String_Element_Table.Last
4761                       (In_Tree.String_Elements)) :=
4762                     (Value         => ALI_Name_Id,
4763                      Index         => 0,
4764                      Display_Value => ALI_Name_Id,
4765                      Location      =>
4766                        In_Tree.String_Elements.Table
4767                          (Interfaces).Location,
4768                      Flag          => False,
4769                      Next          => Interface_ALIs);
4770                   Interface_ALIs := String_Element_Table.Last
4771                                       (In_Tree.String_Elements);
4772                end;
4773             end Add_ALI_For;
4774
4775          --  Start of processing for SAL_Library
4776
4777          begin
4778             Data.Standalone_Library := True;
4779
4780             --  Library_Interface cannot be an empty list
4781
4782             if Interfaces = Nil_String then
4783                Error_Msg
4784                  (Project, In_Tree,
4785                   "Library_Interface cannot be an empty list",
4786                   Lib_Interfaces.Location);
4787             end if;
4788
4789             --  Process each unit name specified in the attribute
4790             --  Library_Interface.
4791
4792             while Interfaces /= Nil_String loop
4793                Get_Name_String
4794                  (In_Tree.String_Elements.Table (Interfaces).Value);
4795                To_Lower (Name_Buffer (1 .. Name_Len));
4796
4797                if Name_Len = 0 then
4798                   Error_Msg
4799                     (Project, In_Tree,
4800                      "an interface cannot be an empty string",
4801                      In_Tree.String_Elements.Table (Interfaces).Location);
4802
4803                else
4804                   Unit := Name_Find;
4805                   Error_Msg_Name_1 := Unit;
4806
4807                   if Get_Mode = Ada_Only then
4808                      The_Unit_Id :=
4809                        Units_Htable.Get (In_Tree.Units_HT, Unit);
4810
4811                      if The_Unit_Id = No_Unit_Index then
4812                         Error_Msg
4813                           (Project, In_Tree,
4814                            "unknown unit %%",
4815                            In_Tree.String_Elements.Table
4816                              (Interfaces).Location);
4817
4818                      else
4819                         --  Check that the unit is part of the project
4820
4821                         The_Unit_Data :=
4822                           In_Tree.Units.Table (The_Unit_Id);
4823
4824                         if The_Unit_Data.File_Names (Body_Part).Name /= No_File
4825                           and then The_Unit_Data.File_Names
4826                                      (Body_Part).Path.Name /= Slash
4827                         then
4828                            if Check_Project
4829                              (The_Unit_Data.File_Names (Body_Part).Project,
4830                               Project, In_Tree, Extending)
4831                            then
4832                               --  There is a body for this unit.
4833                               --  If there is no spec, we need to check
4834                               --  that it is not a subunit.
4835
4836                               if The_Unit_Data.File_Names
4837                                 (Specification).Name = No_File
4838                               then
4839                                  declare
4840                                     Src_Ind : Source_File_Index;
4841
4842                                  begin
4843                                     Src_Ind := Sinput.P.Load_Project_File
4844                                       (Get_Name_String
4845                                          (The_Unit_Data.File_Names
4846                                             (Body_Part).Path.Name));
4847
4848                                     if Sinput.P.Source_File_Is_Subunit
4849                                       (Src_Ind)
4850                                     then
4851                                        Error_Msg
4852                                          (Project, In_Tree,
4853                                           "%% is a subunit; " &
4854                                           "it cannot be an interface",
4855                                           In_Tree.
4856                                             String_Elements.Table
4857                                               (Interfaces).Location);
4858                                     end if;
4859                                  end;
4860                               end if;
4861
4862                               --  The unit is not a subunit, so we add
4863                               --  to the Interface ALIs the ALI file
4864                               --  corresponding to the body.
4865
4866                               Add_ALI_For
4867                                 (The_Unit_Data.File_Names (Body_Part).Name);
4868
4869                            else
4870                               Error_Msg
4871                                 (Project, In_Tree,
4872                                  "%% is not an unit of this project",
4873                                  In_Tree.String_Elements.Table
4874                                    (Interfaces).Location);
4875                            end if;
4876
4877                         elsif The_Unit_Data.File_Names
4878                           (Specification).Name /= No_File
4879                           and then The_Unit_Data.File_Names
4880                             (Specification).Path.Name /= Slash
4881                           and then Check_Project
4882                             (The_Unit_Data.File_Names
4883                                  (Specification).Project,
4884                              Project, In_Tree, Extending)
4885
4886                         then
4887                            --  The unit is part of the project, it has
4888                            --  a spec, but no body. We add to the Interface
4889                            --  ALIs the ALI file corresponding to the spec.
4890
4891                            Add_ALI_For
4892                              (The_Unit_Data.File_Names (Specification).Name);
4893
4894                         else
4895                            Error_Msg
4896                              (Project, In_Tree,
4897                               "%% is not an unit of this project",
4898                               In_Tree.String_Elements.Table
4899                                 (Interfaces).Location);
4900                         end if;
4901                      end if;
4902
4903                   else
4904                      --  Multi_Language mode
4905
4906                      Next_Proj := Data.Extends;
4907                      Source := Data.First_Source;
4908
4909                      loop
4910                         while Source /= No_Source and then
4911                               In_Tree.Sources.Table (Source).Unit /= Unit
4912                         loop
4913                            Source :=
4914                              In_Tree.Sources.Table (Source).Next_In_Project;
4915                         end loop;
4916
4917                         exit when Source /= No_Source or else
4918                                   Next_Proj = No_Project;
4919
4920                         Source :=
4921                           In_Tree.Projects.Table (Next_Proj).First_Source;
4922                         Next_Proj :=
4923                           In_Tree.Projects.Table (Next_Proj).Extends;
4924                      end loop;
4925
4926                      if Source /= No_Source then
4927                         if In_Tree.Sources.Table (Source).Kind = Sep then
4928                            Source := No_Source;
4929
4930                         elsif In_Tree.Sources.Table (Source).Kind = Spec
4931                           and then
4932                           In_Tree.Sources.Table (Source).Other_Part /=
4933                           No_Source
4934                         then
4935                            Source := In_Tree.Sources.Table (Source).Other_Part;
4936                         end if;
4937                      end if;
4938
4939                      if Source /= No_Source then
4940                         if In_Tree.Sources.Table (Source).Project /= Project
4941                           and then
4942                             not Is_Extending
4943                               (Project,
4944                                In_Tree.Sources.Table (Source).Project,
4945                                In_Tree)
4946                         then
4947                            Source := No_Source;
4948                         end if;
4949                      end if;
4950
4951                      if Source = No_Source then
4952                            Error_Msg
4953                              (Project, In_Tree,
4954                               "%% is not an unit of this project",
4955                               In_Tree.String_Elements.Table
4956                                 (Interfaces).Location);
4957
4958                      else
4959                         if In_Tree.Sources.Table (Source).Kind = Spec and then
4960                           In_Tree.Sources.Table (Source).Other_Part /=
4961                             No_Source
4962                         then
4963                            Source := In_Tree.Sources.Table (Source).Other_Part;
4964                         end if;
4965
4966                         String_Element_Table.Increment_Last
4967                           (In_Tree.String_Elements);
4968                         In_Tree.String_Elements.Table
4969                           (String_Element_Table.Last
4970                              (In_Tree.String_Elements)) :=
4971                           (Value         =>
4972                              Name_Id (In_Tree.Sources.Table (Source).Dep_Name),
4973                            Index         => 0,
4974                            Display_Value =>
4975                              Name_Id (In_Tree.Sources.Table (Source).Dep_Name),
4976                            Location      =>
4977                              In_Tree.String_Elements.Table
4978                                (Interfaces).Location,
4979                            Flag          => False,
4980                            Next          => Interface_ALIs);
4981                         Interface_ALIs := String_Element_Table.Last
4982                           (In_Tree.String_Elements);
4983                      end if;
4984
4985                   end if;
4986
4987                end if;
4988
4989                Interfaces :=
4990                  In_Tree.String_Elements.Table (Interfaces).Next;
4991             end loop;
4992
4993             --  Put the list of Interface ALIs in the project data
4994
4995             Data.Lib_Interface_ALIs := Interface_ALIs;
4996
4997             --  Check value of attribute Library_Auto_Init and set
4998             --  Lib_Auto_Init accordingly.
4999
5000             if Lib_Auto_Init.Default then
5001
5002                --  If no attribute Library_Auto_Init is declared, then set auto
5003                --  init only if it is supported.
5004
5005                Data.Lib_Auto_Init := Auto_Init_Supported;
5006
5007             else
5008                Get_Name_String (Lib_Auto_Init.Value);
5009                To_Lower (Name_Buffer (1 .. Name_Len));
5010
5011                if Name_Buffer (1 .. Name_Len) = "false" then
5012                   Data.Lib_Auto_Init := False;
5013
5014                elsif Name_Buffer (1 .. Name_Len) = "true" then
5015                   if Auto_Init_Supported then
5016                      Data.Lib_Auto_Init := True;
5017
5018                   else
5019                      --  Library_Auto_Init cannot be "true" if auto init is not
5020                      --  supported
5021
5022                      Error_Msg
5023                        (Project, In_Tree,
5024                         "library auto init not supported " &
5025                         "on this platform",
5026                         Lib_Auto_Init.Location);
5027                   end if;
5028
5029                else
5030                   Error_Msg
5031                     (Project, In_Tree,
5032                      "invalid value for attribute Library_Auto_Init",
5033                      Lib_Auto_Init.Location);
5034                end if;
5035             end if;
5036          end SAL_Library;
5037
5038          --  If attribute Library_Src_Dir is defined and not the empty string,
5039          --  check if the directory exist and is not the object directory or
5040          --  one of the source directories. This is the directory where copies
5041          --  of the interface sources will be copied. Note that this directory
5042          --  may be the library directory.
5043
5044          if Lib_Src_Dir.Value /= Empty_String then
5045             declare
5046                Dir_Id : constant File_Name_Type :=
5047                           File_Name_Type (Lib_Src_Dir.Value);
5048
5049             begin
5050                Locate_Directory
5051                  (Project,
5052                   In_Tree,
5053                   Dir_Id,
5054                   Data.Directory.Display_Name,
5055                   Data.Library_Src_Dir.Name,
5056                   Data.Library_Src_Dir.Display_Name,
5057                   Create => "library source copy",
5058                   Current_Dir => Current_Dir,
5059                   Location => Lib_Src_Dir.Location);
5060
5061                --  If directory does not exist, report an error
5062
5063                if Data.Library_Src_Dir = No_Path_Information then
5064
5065                   --  Get the absolute name of the library directory that does
5066                   --  not exist, to report an error.
5067
5068                   declare
5069                      Dir_Name : constant String :=
5070                                   Get_Name_String (Dir_Id);
5071
5072                   begin
5073                      if Is_Absolute_Path (Dir_Name) then
5074                         Err_Vars.Error_Msg_File_1 := Dir_Id;
5075
5076                      else
5077                         Get_Name_String (Data.Directory.Name);
5078
5079                         if Name_Buffer (Name_Len) /=
5080                           Directory_Separator
5081                         then
5082                            Name_Len := Name_Len + 1;
5083                            Name_Buffer (Name_Len) :=
5084                              Directory_Separator;
5085                         end if;
5086
5087                         Name_Buffer
5088                           (Name_Len + 1 ..
5089                              Name_Len + Dir_Name'Length) :=
5090                             Dir_Name;
5091                         Name_Len := Name_Len + Dir_Name'Length;
5092                         Err_Vars.Error_Msg_Name_1 := Name_Find;
5093                      end if;
5094
5095                      --  Report the error
5096
5097                      Error_Msg_File_1 := Dir_Id;
5098                      Error_Msg
5099                        (Project, In_Tree,
5100                         "Directory { does not exist",
5101                         Lib_Src_Dir.Location);
5102                   end;
5103
5104                   --  Report error if it is the same as the object directory
5105
5106                elsif Data.Library_Src_Dir = Data.Object_Directory then
5107                   Error_Msg
5108                     (Project, In_Tree,
5109                      "directory to copy interfaces cannot be " &
5110                      "the object directory",
5111                      Lib_Src_Dir.Location);
5112                   Data.Library_Src_Dir := No_Path_Information;
5113
5114                else
5115                   declare
5116                      Src_Dirs : String_List_Id;
5117                      Src_Dir  : String_Element;
5118
5119                   begin
5120                      --  Interface copy directory cannot be one of the source
5121                      --  directory of the current project.
5122
5123                      Src_Dirs := Data.Source_Dirs;
5124                      while Src_Dirs /= Nil_String loop
5125                         Src_Dir := In_Tree.String_Elements.Table (Src_Dirs);
5126
5127                         --  Report error if it is one of the source directories
5128
5129                         if Data.Library_Src_Dir.Name =
5130                           Path_Name_Type (Src_Dir.Value)
5131                         then
5132                            Error_Msg
5133                              (Project, In_Tree,
5134                               "directory to copy interfaces cannot " &
5135                               "be one of the source directories",
5136                               Lib_Src_Dir.Location);
5137                            Data.Library_Src_Dir := No_Path_Information;
5138                            exit;
5139                         end if;
5140
5141                         Src_Dirs := Src_Dir.Next;
5142                      end loop;
5143
5144                      if Data.Library_Src_Dir /= No_Path_Information then
5145
5146                         --  It cannot be a source directory of any other
5147                         --  project either.
5148
5149                         Project_Loop : for Pid in 1 ..
5150                           Project_Table.Last (In_Tree.Projects)
5151                         loop
5152                            Src_Dirs :=
5153                              In_Tree.Projects.Table (Pid).Source_Dirs;
5154                            Dir_Loop : while Src_Dirs /= Nil_String loop
5155                               Src_Dir :=
5156                                 In_Tree.String_Elements.Table (Src_Dirs);
5157
5158                               --  Report error if it is one of the source
5159                               --  directories
5160
5161                               if Data.Library_Src_Dir.Name =
5162                                 Path_Name_Type (Src_Dir.Value)
5163                               then
5164                                  Error_Msg_File_1 :=
5165                                    File_Name_Type (Src_Dir.Value);
5166                                  Error_Msg_Name_1 :=
5167                                    In_Tree.Projects.Table (Pid).Name;
5168                                  Error_Msg
5169                                    (Project, In_Tree,
5170                                     "directory to copy interfaces cannot " &
5171                                     "be the same as source directory { of " &
5172                                     "project %%",
5173                                     Lib_Src_Dir.Location);
5174                                  Data.Library_Src_Dir := No_Path_Information;
5175                                  exit Project_Loop;
5176                               end if;
5177
5178                               Src_Dirs := Src_Dir.Next;
5179                            end loop Dir_Loop;
5180                         end loop Project_Loop;
5181                      end if;
5182                   end;
5183
5184                   --  In high verbosity, if there is a valid Library_Src_Dir,
5185                   --  display its path name.
5186
5187                   if Data.Library_Src_Dir /= No_Path_Information
5188                     and then Current_Verbosity = High
5189                   then
5190                      Write_Str ("Directory to copy interfaces =""");
5191                      Write_Str (Get_Name_String (Data.Library_Src_Dir.Name));
5192                      Write_Line ("""");
5193                   end if;
5194                end if;
5195             end;
5196          end if;
5197
5198          --  Check the symbol related attributes
5199
5200          --  First, the symbol policy
5201
5202          if not Lib_Symbol_Policy.Default then
5203             declare
5204                Value : constant String :=
5205                  To_Lower
5206                    (Get_Name_String (Lib_Symbol_Policy.Value));
5207
5208             begin
5209                --  Symbol policy must hove one of a limited number of values
5210
5211                if Value = "autonomous" or else Value = "default" then
5212                   Data.Symbol_Data.Symbol_Policy := Autonomous;
5213
5214                elsif Value = "compliant" then
5215                   Data.Symbol_Data.Symbol_Policy := Compliant;
5216
5217                elsif Value = "controlled" then
5218                   Data.Symbol_Data.Symbol_Policy := Controlled;
5219
5220                elsif Value = "restricted" then
5221                   Data.Symbol_Data.Symbol_Policy := Restricted;
5222
5223                elsif Value = "direct" then
5224                   Data.Symbol_Data.Symbol_Policy := Direct;
5225
5226                else
5227                   Error_Msg
5228                     (Project, In_Tree,
5229                      "illegal value for Library_Symbol_Policy",
5230                      Lib_Symbol_Policy.Location);
5231                end if;
5232             end;
5233          end if;
5234
5235          --  If attribute Library_Symbol_File is not specified, symbol policy
5236          --  cannot be Restricted.
5237
5238          if Lib_Symbol_File.Default then
5239             if Data.Symbol_Data.Symbol_Policy = Restricted then
5240                Error_Msg
5241                  (Project, In_Tree,
5242                   "Library_Symbol_File needs to be defined when " &
5243                   "symbol policy is Restricted",
5244                   Lib_Symbol_Policy.Location);
5245             end if;
5246
5247          else
5248             --  Library_Symbol_File is defined
5249
5250             Data.Symbol_Data.Symbol_File :=
5251               Path_Name_Type (Lib_Symbol_File.Value);
5252
5253             Get_Name_String (Lib_Symbol_File.Value);
5254
5255             if Name_Len = 0 then
5256                Error_Msg
5257                  (Project, In_Tree,
5258                   "symbol file name cannot be an empty string",
5259                   Lib_Symbol_File.Location);
5260
5261             else
5262                OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len));
5263
5264                if OK then
5265                   for J in 1 .. Name_Len loop
5266                      if Name_Buffer (J) = '/'
5267                        or else Name_Buffer (J) = Directory_Separator
5268                      then
5269                         OK := False;
5270                         exit;
5271                      end if;
5272                   end loop;
5273                end if;
5274
5275                if not OK then
5276                   Error_Msg_File_1 := File_Name_Type (Lib_Symbol_File.Value);
5277                   Error_Msg
5278                     (Project, In_Tree,
5279                      "symbol file name { is illegal. " &
5280                      "Name cannot include directory info.",
5281                      Lib_Symbol_File.Location);
5282                end if;
5283             end if;
5284          end if;
5285
5286          --  If attribute Library_Reference_Symbol_File is not defined,
5287          --  symbol policy cannot be Compliant or Controlled.
5288
5289          if Lib_Ref_Symbol_File.Default then
5290             if Data.Symbol_Data.Symbol_Policy = Compliant
5291               or else Data.Symbol_Data.Symbol_Policy = Controlled
5292             then
5293                Error_Msg
5294                  (Project, In_Tree,
5295                   "a reference symbol file need to be defined",
5296                   Lib_Symbol_Policy.Location);
5297             end if;
5298
5299          else
5300             --  Library_Reference_Symbol_File is defined, check file exists
5301
5302             Data.Symbol_Data.Reference :=
5303               Path_Name_Type (Lib_Ref_Symbol_File.Value);
5304
5305             Get_Name_String (Lib_Ref_Symbol_File.Value);
5306
5307             if Name_Len = 0 then
5308                Error_Msg
5309                  (Project, In_Tree,
5310                   "reference symbol file name cannot be an empty string",
5311                   Lib_Symbol_File.Location);
5312
5313             else
5314                if not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)) then
5315                   Name_Len := 0;
5316                   Add_Str_To_Name_Buffer
5317                     (Get_Name_String (Data.Directory.Name));
5318                   Add_Char_To_Name_Buffer (Directory_Separator);
5319                   Add_Str_To_Name_Buffer
5320                     (Get_Name_String (Lib_Ref_Symbol_File.Value));
5321                   Data.Symbol_Data.Reference := Name_Find;
5322                end if;
5323
5324                if not Is_Regular_File
5325                  (Get_Name_String (Data.Symbol_Data.Reference))
5326                then
5327                   Error_Msg_File_1 :=
5328                     File_Name_Type (Lib_Ref_Symbol_File.Value);
5329
5330                   --  For controlled and direct symbol policies, it is an error
5331                   --  if the reference symbol file does not exist. For other
5332                   --  symbol policies, this is just a warning
5333
5334                   Error_Msg_Warn :=
5335                     Data.Symbol_Data.Symbol_Policy /= Controlled
5336                     and then Data.Symbol_Data.Symbol_Policy /= Direct;
5337
5338                   Error_Msg
5339                     (Project, In_Tree,
5340                      "<library reference symbol file { does not exist",
5341                      Lib_Ref_Symbol_File.Location);
5342
5343                   --  In addition in the non-controlled case, if symbol policy
5344                   --  is Compliant, it is changed to Autonomous, because there
5345                   --  is no reference to check against, and we don't want to
5346                   --  fail in this case.
5347
5348                   if Data.Symbol_Data.Symbol_Policy /= Controlled then
5349                      if Data.Symbol_Data.Symbol_Policy = Compliant then
5350                         Data.Symbol_Data.Symbol_Policy := Autonomous;
5351                      end if;
5352                   end if;
5353                end if;
5354
5355                --  If both the reference symbol file and the symbol file are
5356                --  defined, then check that they are not the same file.
5357
5358                if Data.Symbol_Data.Symbol_File /= No_Path then
5359                   Get_Name_String (Data.Symbol_Data.Symbol_File);
5360
5361                   if Name_Len > 0 then
5362                      declare
5363                         Symb_Path : constant String :=
5364                                       Normalize_Pathname
5365                                         (Get_Name_String
5366                                            (Data.Object_Directory.Name) &
5367                                          Directory_Separator &
5368                                          Name_Buffer (1 .. Name_Len),
5369                                          Directory     => Current_Dir,
5370                                          Resolve_Links =>
5371                                            Opt.Follow_Links_For_Files);
5372                         Ref_Path  : constant String :=
5373                                       Normalize_Pathname
5374                                         (Get_Name_String
5375                                            (Data.Symbol_Data.Reference),
5376                                          Directory     => Current_Dir,
5377                                          Resolve_Links =>
5378                                            Opt.Follow_Links_For_Files);
5379                      begin
5380                         if Symb_Path = Ref_Path then
5381                            Error_Msg
5382                              (Project, In_Tree,
5383                               "library reference symbol file and library" &
5384                               " symbol file cannot be the same file",
5385                               Lib_Ref_Symbol_File.Location);
5386                         end if;
5387                      end;
5388                   end if;
5389                end if;
5390             end if;
5391          end if;
5392       end if;
5393    end Check_Stand_Alone_Library;
5394
5395    ----------------------------
5396    -- Compute_Directory_Last --
5397    ----------------------------
5398
5399    function Compute_Directory_Last (Dir : String) return Natural is
5400    begin
5401       if Dir'Length > 1
5402         and then (Dir (Dir'Last - 1) = Directory_Separator
5403                   or else Dir (Dir'Last - 1) = '/')
5404       then
5405          return Dir'Last - 1;
5406       else
5407          return Dir'Last;
5408       end if;
5409    end Compute_Directory_Last;
5410
5411    ---------------
5412    -- Error_Msg --
5413    ---------------
5414
5415    procedure Error_Msg
5416      (Project       : Project_Id;
5417       In_Tree       : Project_Tree_Ref;
5418       Msg           : String;
5419       Flag_Location : Source_Ptr)
5420    is
5421       Real_Location : Source_Ptr := Flag_Location;
5422       Error_Buffer  : String (1 .. 5_000);
5423       Error_Last    : Natural := 0;
5424       Name_Number   : Natural := 0;
5425       File_Number   : Natural := 0;
5426       First         : Positive := Msg'First;
5427       Index         : Positive;
5428
5429       procedure Add (C : Character);
5430       --  Add a character to the buffer
5431
5432       procedure Add (S : String);
5433       --  Add a string to the buffer
5434
5435       procedure Add_Name;
5436       --  Add a name to the buffer
5437
5438       procedure Add_File;
5439       --  Add a file name to the buffer
5440
5441       ---------
5442       -- Add --
5443       ---------
5444
5445       procedure Add (C : Character) is
5446       begin
5447          Error_Last := Error_Last + 1;
5448          Error_Buffer (Error_Last) := C;
5449       end Add;
5450
5451       procedure Add (S : String) is
5452       begin
5453          Error_Buffer (Error_Last + 1 .. Error_Last + S'Length) := S;
5454          Error_Last := Error_Last + S'Length;
5455       end Add;
5456
5457       --------------
5458       -- Add_File --
5459       --------------
5460
5461       procedure Add_File is
5462          File : File_Name_Type;
5463
5464       begin
5465          Add ('"');
5466          File_Number := File_Number + 1;
5467
5468          case File_Number is
5469             when 1 =>
5470                File := Err_Vars.Error_Msg_File_1;
5471             when 2 =>
5472                File := Err_Vars.Error_Msg_File_2;
5473             when 3 =>
5474                File := Err_Vars.Error_Msg_File_3;
5475             when others =>
5476                null;
5477          end case;
5478
5479          Get_Name_String (File);
5480          Add (Name_Buffer (1 .. Name_Len));
5481          Add ('"');
5482       end Add_File;
5483
5484       --------------
5485       -- Add_Name --
5486       --------------
5487
5488       procedure Add_Name is
5489          Name : Name_Id;
5490
5491       begin
5492          Add ('"');
5493          Name_Number := Name_Number + 1;
5494
5495          case Name_Number is
5496             when 1 =>
5497                Name := Err_Vars.Error_Msg_Name_1;
5498             when 2 =>
5499                Name := Err_Vars.Error_Msg_Name_2;
5500             when 3 =>
5501                Name := Err_Vars.Error_Msg_Name_3;
5502             when others =>
5503                null;
5504          end case;
5505
5506          Get_Name_String (Name);
5507          Add (Name_Buffer (1 .. Name_Len));
5508          Add ('"');
5509       end Add_Name;
5510
5511    --  Start of processing for Error_Msg
5512
5513    begin
5514       --  If location of error is unknown, use the location of the project
5515
5516       if Real_Location = No_Location then
5517          Real_Location := In_Tree.Projects.Table (Project).Location;
5518       end if;
5519
5520       if Error_Report = null then
5521          Prj.Err.Error_Msg (Msg, Real_Location);
5522          return;
5523       end if;
5524
5525       --  Ignore continuation character
5526
5527       if Msg (First) = '\' then
5528          First := First + 1;
5529       end if;
5530
5531       --  Warning character is always the first one in this package
5532       --  this is an undocumented kludge???
5533
5534       if Msg (First) = '?' then
5535          First := First + 1;
5536          Add ("Warning: ");
5537
5538       elsif Msg (First) = '<' then
5539          First := First + 1;
5540
5541          if Err_Vars.Error_Msg_Warn then
5542             Add ("Warning: ");
5543          end if;
5544       end if;
5545
5546       Index := First;
5547       while Index <= Msg'Last loop
5548          if Msg (Index) = '{' then
5549             Add_File;
5550
5551          elsif Msg (Index) = '%' then
5552             if Index < Msg'Last and then Msg (Index + 1) = '%' then
5553                Index := Index + 1;
5554             end if;
5555
5556             Add_Name;
5557          else
5558             Add (Msg (Index));
5559          end if;
5560          Index := Index + 1;
5561
5562       end loop;
5563
5564       Error_Report (Error_Buffer (1 .. Error_Last), Project, In_Tree);
5565    end Error_Msg;
5566
5567    ----------------------
5568    -- Find_Ada_Sources --
5569    ----------------------
5570
5571    procedure Find_Ada_Sources
5572      (Project      : Project_Id;
5573       In_Tree      : Project_Tree_Ref;
5574       Data         : in out Project_Data;
5575       Current_Dir  : String)
5576    is
5577       Source_Dir      : String_List_Id := Data.Source_Dirs;
5578       Element         : String_Element;
5579       Dir             : Dir_Type;
5580       Current_Source  : String_List_Id := Nil_String;
5581       Source_Recorded : Boolean := False;
5582
5583    begin
5584       if Current_Verbosity = High then
5585          Write_Line ("Looking for sources:");
5586       end if;
5587
5588       --  For each subdirectory
5589
5590       while Source_Dir /= Nil_String loop
5591          begin
5592             Source_Recorded := False;
5593             Element := In_Tree.String_Elements.Table (Source_Dir);
5594             if Element.Value /= No_Name then
5595                Get_Name_String (Element.Display_Value);
5596
5597                declare
5598                   Source_Directory : constant String :=
5599                     Name_Buffer (1 .. Name_Len) & Directory_Separator;
5600                   Dir_Last  : constant Natural :=
5601                      Compute_Directory_Last (Source_Directory);
5602
5603                begin
5604                   if Current_Verbosity = High then
5605                      Write_Str ("Source_Dir = ");
5606                      Write_Line (Source_Directory);
5607                   end if;
5608
5609                   --  We look at every entry in the source directory
5610
5611                   Open (Dir,
5612                         Source_Directory (Source_Directory'First .. Dir_Last));
5613
5614                   loop
5615                      Read (Dir, Name_Buffer, Name_Len);
5616
5617                      if Current_Verbosity = High then
5618                         Write_Str  ("   Checking ");
5619                         Write_Line (Name_Buffer (1 .. Name_Len));
5620                      end if;
5621
5622                      exit when Name_Len = 0;
5623
5624                      declare
5625                         File_Name : constant File_Name_Type := Name_Find;
5626
5627                         --  ??? We could probably optimize the following call:
5628                         --  we need to resolve links only once for the
5629                         --  directory itself, and then do a single call to
5630                         --  readlink() for each file. Unfortunately that would
5631                         --  require a change in Normalize_Pathname so that it
5632                         --  has the option of not resolving links for its
5633                         --  Directory parameter, only for Name.
5634
5635                         Path : constant String :=
5636                                  Normalize_Pathname
5637                                    (Name      => Name_Buffer (1 .. Name_Len),
5638                                     Directory =>
5639                                       Source_Directory
5640                                         (Source_Directory'First .. Dir_Last),
5641                                     Resolve_Links =>
5642                                       Opt.Follow_Links_For_Files,
5643                                     Case_Sensitive => True);
5644
5645                         Path_Name : Path_Name_Type;
5646
5647                      begin
5648                         Name_Len := Path'Length;
5649                         Name_Buffer (1 .. Name_Len) := Path;
5650                         Path_Name := Name_Find;
5651
5652                         --  We attempt to register it as a source. However,
5653                         --  there is no error if the file does not contain a
5654                         --  valid source. But there is an error if we have a
5655                         --  duplicate unit name.
5656
5657                         Record_Ada_Source
5658                           (File_Name       => File_Name,
5659                            Path_Name       => Path_Name,
5660                            Project         => Project,
5661                            In_Tree         => In_Tree,
5662                            Data            => Data,
5663                            Location        => No_Location,
5664                            Current_Source  => Current_Source,
5665                            Source_Recorded => Source_Recorded,
5666                            Current_Dir     => Current_Dir);
5667                      end;
5668                   end loop;
5669
5670                   Close (Dir);
5671                end;
5672             end if;
5673
5674          exception
5675             when Directory_Error =>
5676                null;
5677          end;
5678
5679          if Source_Recorded then
5680             In_Tree.String_Elements.Table (Source_Dir).Flag :=
5681               True;
5682          end if;
5683
5684          Source_Dir := Element.Next;
5685       end loop;
5686
5687       if Current_Verbosity = High then
5688          Write_Line ("end Looking for sources.");
5689       end if;
5690
5691    end Find_Ada_Sources;
5692
5693    --------------------------------
5694    -- Free_Ada_Naming_Exceptions --
5695    --------------------------------
5696
5697    procedure Free_Ada_Naming_Exceptions is
5698    begin
5699       Ada_Naming_Exception_Table.Set_Last (0);
5700       Ada_Naming_Exceptions.Reset;
5701       Reverse_Ada_Naming_Exceptions.Reset;
5702    end Free_Ada_Naming_Exceptions;
5703
5704    ---------------------
5705    -- Get_Directories --
5706    ---------------------
5707
5708    procedure Get_Directories
5709      (Project     : Project_Id;
5710       In_Tree     : Project_Tree_Ref;
5711       Current_Dir : String;
5712       Data        : in out Project_Data)
5713    is
5714       Object_Dir  : constant Variable_Value :=
5715                       Util.Value_Of
5716                         (Name_Object_Dir, Data.Decl.Attributes, In_Tree);
5717
5718       Exec_Dir : constant Variable_Value :=
5719                    Util.Value_Of
5720                      (Name_Exec_Dir, Data.Decl.Attributes, In_Tree);
5721
5722       Source_Dirs : constant Variable_Value :=
5723                       Util.Value_Of
5724                         (Name_Source_Dirs, Data.Decl.Attributes, In_Tree);
5725
5726       Excluded_Source_Dirs : constant Variable_Value :=
5727                               Util.Value_Of
5728                                 (Name_Excluded_Source_Dirs,
5729                                  Data.Decl.Attributes,
5730                                  In_Tree);
5731
5732       Source_Files : constant Variable_Value :=
5733                       Util.Value_Of
5734                         (Name_Source_Files, Data.Decl.Attributes, In_Tree);
5735
5736       Last_Source_Dir : String_List_Id  := Nil_String;
5737
5738       procedure Find_Source_Dirs
5739         (From     : File_Name_Type;
5740          Location : Source_Ptr;
5741          Removed  : Boolean := False);
5742       --  Find one or several source directories, and add (or remove, if
5743       --  Removed is True) them to list of source directories of the project.
5744
5745       ----------------------
5746       -- Find_Source_Dirs --
5747       ----------------------
5748
5749       procedure Find_Source_Dirs
5750         (From     : File_Name_Type;
5751          Location : Source_Ptr;
5752          Removed  : Boolean := False)
5753       is
5754          Directory : constant String := Get_Name_String (From);
5755          Element   : String_Element;
5756
5757          procedure Recursive_Find_Dirs (Path : Name_Id);
5758          --  Find all the subdirectories (recursively) of Path and add them
5759          --  to the list of source directories of the project.
5760
5761          -------------------------
5762          -- Recursive_Find_Dirs --
5763          -------------------------
5764
5765          procedure Recursive_Find_Dirs (Path : Name_Id) is
5766             Dir     : Dir_Type;
5767             Name    : String (1 .. 250);
5768             Last    : Natural;
5769             List    : String_List_Id;
5770             Prev    : String_List_Id;
5771             Element : String_Element;
5772             Found   : Boolean := False;
5773
5774             Non_Canonical_Path : Name_Id := No_Name;
5775             Canonical_Path     : Name_Id := No_Name;
5776
5777             The_Path : constant String :=
5778                          Normalize_Pathname
5779                            (Get_Name_String (Path),
5780                             Directory     => Current_Dir,
5781                             Resolve_Links => Opt.Follow_Links_For_Dirs) &
5782                          Directory_Separator;
5783
5784             The_Path_Last : constant Natural :=
5785                               Compute_Directory_Last (The_Path);
5786
5787          begin
5788             Name_Len := The_Path_Last - The_Path'First + 1;
5789             Name_Buffer (1 .. Name_Len) :=
5790               The_Path (The_Path'First .. The_Path_Last);
5791             Non_Canonical_Path := Name_Find;
5792
5793             if Osint.File_Names_Case_Sensitive then
5794                Canonical_Path := Non_Canonical_Path;
5795             else
5796                Get_Name_String (Non_Canonical_Path);
5797                Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
5798                Canonical_Path := Name_Find;
5799             end if;
5800
5801             --  To avoid processing the same directory several times, check
5802             --  if the directory is already in Recursive_Dirs. If it is, then
5803             --  there is nothing to do, just return. If it is not, put it there
5804             --  and continue recursive processing.
5805
5806             if not Removed then
5807                if Recursive_Dirs.Get (Canonical_Path) then
5808                   return;
5809                else
5810                   Recursive_Dirs.Set (Canonical_Path, True);
5811                end if;
5812             end if;
5813
5814             --  Check if directory is already in list
5815
5816             List := Data.Source_Dirs;
5817             Prev := Nil_String;
5818             while List /= Nil_String loop
5819                Element := In_Tree.String_Elements.Table (List);
5820
5821                if Element.Value /= No_Name then
5822                   Found := Element.Value = Canonical_Path;
5823                   exit when Found;
5824                end if;
5825
5826                Prev := List;
5827                List := Element.Next;
5828             end loop;
5829
5830             --  If directory is not already in list, put it there
5831
5832             if (not Removed) and (not Found) then
5833                if Current_Verbosity = High then
5834                   Write_Str  ("   ");
5835                   Write_Line (The_Path (The_Path'First .. The_Path_Last));
5836                end if;
5837
5838                String_Element_Table.Increment_Last
5839                  (In_Tree.String_Elements);
5840                Element :=
5841                  (Value         => Canonical_Path,
5842                   Display_Value => Non_Canonical_Path,
5843                   Location      => No_Location,
5844                   Flag          => False,
5845                   Next          => Nil_String,
5846                   Index         => 0);
5847
5848                --  Case of first source directory
5849
5850                if Last_Source_Dir = Nil_String then
5851                   Data.Source_Dirs := String_Element_Table.Last
5852                                         (In_Tree.String_Elements);
5853
5854                   --  Here we already have source directories
5855
5856                else
5857                   --  Link the previous last to the new one
5858
5859                   In_Tree.String_Elements.Table
5860                     (Last_Source_Dir).Next :=
5861                       String_Element_Table.Last
5862                         (In_Tree.String_Elements);
5863                end if;
5864
5865                --  And register this source directory as the new last
5866
5867                Last_Source_Dir  := String_Element_Table.Last
5868                  (In_Tree.String_Elements);
5869                In_Tree.String_Elements.Table (Last_Source_Dir) :=
5870                  Element;
5871
5872             elsif Removed and Found then
5873                if Prev = Nil_String then
5874                   Data.Source_Dirs :=
5875                     In_Tree.String_Elements.Table (List).Next;
5876                else
5877                   In_Tree.String_Elements.Table (Prev).Next :=
5878                     In_Tree.String_Elements.Table (List).Next;
5879                end if;
5880             end if;
5881
5882             --  Now look for subdirectories. We do that even when this
5883             --  directory is already in the list, because some of its
5884             --  subdirectories may not be in the list yet.
5885
5886             Open (Dir, The_Path (The_Path'First .. The_Path_Last));
5887
5888             loop
5889                Read (Dir, Name, Last);
5890                exit when Last = 0;
5891
5892                if Name (1 .. Last) /= "."
5893                  and then Name (1 .. Last) /= ".."
5894                then
5895                   --  Avoid . and .. directories
5896
5897                   if Current_Verbosity = High then
5898                      Write_Str  ("   Checking ");
5899                      Write_Line (Name (1 .. Last));
5900                   end if;
5901
5902                   declare
5903                      Path_Name : constant String :=
5904                        Normalize_Pathname
5905                          (Name      => Name (1 .. Last),
5906                           Directory =>
5907                             The_Path (The_Path'First .. The_Path_Last),
5908                           Resolve_Links  => Opt.Follow_Links_For_Dirs,
5909                           Case_Sensitive => True);
5910
5911                   begin
5912                      if Is_Directory (Path_Name) then
5913                         --  We have found a new subdirectory, call self
5914
5915                         Name_Len := Path_Name'Length;
5916                         Name_Buffer (1 .. Name_Len) := Path_Name;
5917                         Recursive_Find_Dirs (Name_Find);
5918                      end if;
5919                   end;
5920                end if;
5921             end loop;
5922
5923             Close (Dir);
5924
5925          exception
5926             when Directory_Error =>
5927                null;
5928          end Recursive_Find_Dirs;
5929
5930       --  Start of processing for Find_Source_Dirs
5931
5932       begin
5933          if Current_Verbosity = High and then not Removed then
5934             Write_Str ("Find_Source_Dirs (""");
5935             Write_Str (Directory);
5936             Write_Line (""")");
5937          end if;
5938
5939          --  First, check if we are looking for a directory tree, indicated
5940          --  by "/**" at the end.
5941
5942          if Directory'Length >= 3
5943            and then Directory (Directory'Last - 1 .. Directory'Last) = "**"
5944            and then (Directory (Directory'Last - 2) = '/'
5945                        or else
5946                      Directory (Directory'Last - 2) = Directory_Separator)
5947          then
5948             if not Removed then
5949                Data.Known_Order_Of_Source_Dirs := False;
5950             end if;
5951
5952             Name_Len := Directory'Length - 3;
5953
5954             if Name_Len = 0 then
5955
5956                --  Case of "/**": all directories in file system
5957
5958                Name_Len := 1;
5959                Name_Buffer (1) := Directory (Directory'First);
5960
5961             else
5962                Name_Buffer (1 .. Name_Len) :=
5963                  Directory (Directory'First .. Directory'Last - 3);
5964             end if;
5965
5966             if Current_Verbosity = High then
5967                Write_Str ("Looking for all subdirectories of """);
5968                Write_Str (Name_Buffer (1 .. Name_Len));
5969                Write_Line ("""");
5970             end if;
5971
5972             declare
5973                Base_Dir : constant File_Name_Type := Name_Find;
5974                Root_Dir : constant String :=
5975                             Normalize_Pathname
5976                               (Name      => Get_Name_String (Base_Dir),
5977                                Directory =>
5978                                  Get_Name_String (Data.Directory.Display_Name),
5979                                Resolve_Links  => False,
5980                                Case_Sensitive => True);
5981
5982             begin
5983                if Root_Dir'Length = 0 then
5984                   Err_Vars.Error_Msg_File_1 := Base_Dir;
5985
5986                   if Location = No_Location then
5987                      Error_Msg
5988                        (Project, In_Tree,
5989                         "{ is not a valid directory.",
5990                         Data.Location);
5991                   else
5992                      Error_Msg
5993                        (Project, In_Tree,
5994                         "{ is not a valid directory.",
5995                         Location);
5996                   end if;
5997
5998                else
5999                   --  We have an existing directory, we register it and all of
6000                   --  its subdirectories.
6001
6002                   if Current_Verbosity = High then
6003                      Write_Line ("Looking for source directories:");
6004                   end if;
6005
6006                   Name_Len := Root_Dir'Length;
6007                   Name_Buffer (1 .. Name_Len) := Root_Dir;
6008                   Recursive_Find_Dirs (Name_Find);
6009
6010                   if Current_Verbosity = High then
6011                      Write_Line ("End of looking for source directories.");
6012                   end if;
6013                end if;
6014             end;
6015
6016          --  We have a single directory
6017
6018          else
6019             declare
6020                Path_Name         : Path_Name_Type;
6021                Display_Path_Name : Path_Name_Type;
6022                List              : String_List_Id;
6023                Prev              : String_List_Id;
6024
6025             begin
6026                Locate_Directory
6027                  (Project     => Project,
6028                   In_Tree     => In_Tree,
6029                   Name        => From,
6030                   Parent      => Data.Directory.Display_Name,
6031                   Dir         => Path_Name,
6032                   Display     => Display_Path_Name,
6033                   Current_Dir => Current_Dir);
6034
6035                if Path_Name = No_Path then
6036                   Err_Vars.Error_Msg_File_1 := From;
6037
6038                   if Location = No_Location then
6039                      Error_Msg
6040                        (Project, In_Tree,
6041                         "{ is not a valid directory",
6042                         Data.Location);
6043                   else
6044                      Error_Msg
6045                        (Project, In_Tree,
6046                         "{ is not a valid directory",
6047                         Location);
6048                   end if;
6049
6050                else
6051                   declare
6052                      Path              : constant String :=
6053                                            Get_Name_String (Path_Name) &
6054                                            Directory_Separator;
6055                      Last_Path         : constant Natural :=
6056                                            Compute_Directory_Last (Path);
6057                      Path_Id           : Name_Id;
6058                      Display_Path      : constant String :=
6059                                            Get_Name_String
6060                                              (Display_Path_Name) &
6061                                            Directory_Separator;
6062                      Last_Display_Path : constant Natural :=
6063                                            Compute_Directory_Last
6064                                              (Display_Path);
6065                      Display_Path_Id   : Name_Id;
6066
6067                   begin
6068                      Name_Len := 0;
6069                      Add_Str_To_Name_Buffer (Path (Path'First .. Last_Path));
6070                      Path_Id := Name_Find;
6071                      Name_Len := 0;
6072                      Add_Str_To_Name_Buffer
6073                        (Display_Path
6074                           (Display_Path'First .. Last_Display_Path));
6075                      Display_Path_Id := Name_Find;
6076
6077                      if not Removed then
6078
6079                         --  As it is an existing directory, we add it to the
6080                         --  list of directories.
6081
6082                         String_Element_Table.Increment_Last
6083                           (In_Tree.String_Elements);
6084                         Element :=
6085                           (Value         => Path_Id,
6086                            Index         => 0,
6087                            Display_Value => Display_Path_Id,
6088                            Location      => No_Location,
6089                            Flag          => False,
6090                            Next          => Nil_String);
6091
6092                         if Last_Source_Dir = Nil_String then
6093
6094                            --  This is the first source directory
6095
6096                            Data.Source_Dirs := String_Element_Table.Last
6097                              (In_Tree.String_Elements);
6098
6099                         else
6100                            --  We already have source directories, link the
6101                            --  previous last to the new one.
6102
6103                            In_Tree.String_Elements.Table
6104                              (Last_Source_Dir).Next :=
6105                              String_Element_Table.Last
6106                                (In_Tree.String_Elements);
6107                         end if;
6108
6109                         --  And register this source directory as the new last
6110
6111                         Last_Source_Dir := String_Element_Table.Last
6112                           (In_Tree.String_Elements);
6113                         In_Tree.String_Elements.Table
6114                           (Last_Source_Dir) := Element;
6115
6116                      else
6117                         --  Remove source dir, if present
6118
6119                         List := Data.Source_Dirs;
6120                         Prev := Nil_String;
6121
6122                         --  Look for source dir in current list
6123
6124                         while List /= Nil_String loop
6125                            Element := In_Tree.String_Elements.Table (List);
6126                            exit when Element.Value = Path_Id;
6127                            Prev := List;
6128                            List := Element.Next;
6129                         end loop;
6130
6131                         if List /= Nil_String then
6132                            --  Source dir was found, remove it from the list
6133
6134                            if Prev = Nil_String then
6135                               Data.Source_Dirs :=
6136                                 In_Tree.String_Elements.Table (List).Next;
6137
6138                            else
6139                               In_Tree.String_Elements.Table (Prev).Next :=
6140                                 In_Tree.String_Elements.Table (List).Next;
6141                            end if;
6142                         end if;
6143                      end if;
6144                   end;
6145                end if;
6146             end;
6147          end if;
6148       end Find_Source_Dirs;
6149
6150    --  Start of processing for Get_Directories
6151
6152    begin
6153       if Current_Verbosity = High then
6154          Write_Line ("Starting to look for directories");
6155       end if;
6156
6157       --  Check the object directory
6158
6159       pragma Assert (Object_Dir.Kind = Single,
6160                      "Object_Dir is not a single string");
6161
6162       --  We set the object directory to its default
6163
6164       Data.Object_Directory := Data.Directory;
6165
6166       if Object_Dir.Value /= Empty_String then
6167          Get_Name_String (Object_Dir.Value);
6168
6169          if Name_Len = 0 then
6170             Error_Msg
6171               (Project, In_Tree,
6172                "Object_Dir cannot be empty",
6173                Object_Dir.Location);
6174
6175          else
6176             --  We check that the specified object directory does exist
6177
6178             Locate_Directory
6179               (Project,
6180                In_Tree,
6181                File_Name_Type (Object_Dir.Value),
6182                Data.Directory.Display_Name,
6183                Data.Object_Directory.Name,
6184                Data.Object_Directory.Display_Name,
6185                Create   => "object",
6186                Location => Object_Dir.Location,
6187                Current_Dir => Current_Dir);
6188
6189             if Data.Object_Directory = No_Path_Information then
6190
6191                --  The object directory does not exist, report an error if the
6192                --  project is not externally built.
6193
6194                if not Data.Externally_Built then
6195                   Err_Vars.Error_Msg_File_1 :=
6196                     File_Name_Type (Object_Dir.Value);
6197                   Error_Msg
6198                     (Project, In_Tree,
6199                      "the object directory { cannot be found",
6200                      Data.Location);
6201                end if;
6202
6203                --  Do not keep a nil Object_Directory. Set it to the specified
6204                --  (relative or absolute) path. This is for the benefit of
6205                --  tools that recover from errors; for example, these tools
6206                --  could create the non existent directory.
6207
6208                Data.Object_Directory.Display_Name :=
6209                  Path_Name_Type (Object_Dir.Value);
6210
6211                if Osint.File_Names_Case_Sensitive then
6212                   Data.Object_Directory.Name :=
6213                     Path_Name_Type (Object_Dir.Value);
6214                else
6215                   Get_Name_String (Object_Dir.Value);
6216                   Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
6217                   Data.Object_Directory.Name := Name_Find;
6218                end if;
6219             end if;
6220          end if;
6221
6222       elsif Subdirs /= null then
6223          Name_Len := 1;
6224          Name_Buffer (1) := '.';
6225          Locate_Directory
6226            (Project,
6227             In_Tree,
6228             Name_Find,
6229             Data.Directory.Display_Name,
6230             Data.Object_Directory.Name,
6231             Data.Object_Directory.Display_Name,
6232             Create      => "object",
6233             Location    => Object_Dir.Location,
6234             Current_Dir => Current_Dir);
6235       end if;
6236
6237       if Current_Verbosity = High then
6238          if Data.Object_Directory = No_Path_Information then
6239             Write_Line ("No object directory");
6240          else
6241             Write_Str ("Object directory: """);
6242             Write_Str (Get_Name_String (Data.Object_Directory.Display_Name));
6243             Write_Line ("""");
6244          end if;
6245       end if;
6246
6247       --  Check the exec directory
6248
6249       pragma Assert (Exec_Dir.Kind = Single,
6250                      "Exec_Dir is not a single string");
6251
6252       --  We set the object directory to its default
6253
6254       Data.Exec_Directory   := Data.Object_Directory;
6255
6256       if Exec_Dir.Value /= Empty_String then
6257          Get_Name_String (Exec_Dir.Value);
6258
6259          if Name_Len = 0 then
6260             Error_Msg
6261               (Project, In_Tree,
6262                "Exec_Dir cannot be empty",
6263                Exec_Dir.Location);
6264
6265          else
6266             --  We check that the specified exec directory does exist
6267
6268             Locate_Directory
6269               (Project,
6270                In_Tree,
6271                File_Name_Type (Exec_Dir.Value),
6272                Data.Directory.Display_Name,
6273                Data.Exec_Directory.Name,
6274                Data.Exec_Directory.Display_Name,
6275                Create   => "exec",
6276                Location => Exec_Dir.Location,
6277                Current_Dir => Current_Dir);
6278
6279             if Data.Exec_Directory = No_Path_Information then
6280                Err_Vars.Error_Msg_File_1 := File_Name_Type (Exec_Dir.Value);
6281                Error_Msg
6282                  (Project, In_Tree,
6283                   "the exec directory { cannot be found",
6284                   Data.Location);
6285             end if;
6286          end if;
6287       end if;
6288
6289       if Current_Verbosity = High then
6290          if Data.Exec_Directory = No_Path_Information then
6291             Write_Line ("No exec directory");
6292          else
6293             Write_Str ("Exec directory: """);
6294             Write_Str (Get_Name_String (Data.Exec_Directory.Display_Name));
6295             Write_Line ("""");
6296          end if;
6297       end if;
6298
6299       --  Look for the source directories
6300
6301       if Current_Verbosity = High then
6302          Write_Line ("Starting to look for source directories");
6303       end if;
6304
6305       pragma Assert (Source_Dirs.Kind = List, "Source_Dirs is not a list");
6306
6307       if (not Source_Files.Default) and then
6308         Source_Files.Values = Nil_String
6309       then
6310          Data.Source_Dirs := Nil_String;
6311
6312          if Data.Qualifier = Standard then
6313             Error_Msg
6314               (Project,
6315                In_Tree,
6316                "a standard project cannot have no sources",
6317                Source_Files.Location);
6318          end if;
6319
6320          if Data.Extends = No_Project
6321            and then Data.Object_Directory = Data.Directory
6322          then
6323             Data.Object_Directory := No_Path_Information;
6324          end if;
6325
6326       elsif Source_Dirs.Default then
6327
6328          --  No Source_Dirs specified: the single source directory is the one
6329          --  containing the project file
6330
6331          String_Element_Table.Increment_Last
6332            (In_Tree.String_Elements);
6333          Data.Source_Dirs := String_Element_Table.Last
6334            (In_Tree.String_Elements);
6335          In_Tree.String_Elements.Table (Data.Source_Dirs) :=
6336            (Value         => Name_Id (Data.Directory.Name),
6337             Display_Value => Name_Id (Data.Directory.Display_Name),
6338             Location      => No_Location,
6339             Flag          => False,
6340             Next          => Nil_String,
6341             Index         => 0);
6342
6343          if Current_Verbosity = High then
6344             Write_Line ("Single source directory:");
6345             Write_Str ("    """);
6346             Write_Str (Get_Name_String (Data.Directory.Display_Name));
6347             Write_Line ("""");
6348          end if;
6349
6350       elsif Source_Dirs.Values = Nil_String then
6351          if Data.Qualifier = Standard then
6352             Error_Msg
6353               (Project,
6354                In_Tree,
6355                "a standard project cannot have no source directories",
6356                Source_Dirs.Location);
6357          end if;
6358
6359          --  If Source_Dirs is an empty string list, this means that this
6360          --  project contains no source. For projects that don't extend other
6361          --  projects, this also means that there is no need for an object
6362          --  directory, if not specified.
6363
6364          if Data.Extends = No_Project
6365            and then  Data.Object_Directory = Data.Directory
6366          then
6367             Data.Object_Directory := No_Path_Information;
6368          end if;
6369
6370          Data.Source_Dirs := Nil_String;
6371
6372       else
6373          declare
6374             Source_Dir : String_List_Id;
6375             Element    : String_Element;
6376
6377          begin
6378             --  Process the source directories for each element of the list
6379
6380             Source_Dir := Source_Dirs.Values;
6381             while Source_Dir /= Nil_String loop
6382                Element := In_Tree.String_Elements.Table (Source_Dir);
6383                Find_Source_Dirs
6384                  (File_Name_Type (Element.Value), Element.Location);
6385                Source_Dir := Element.Next;
6386             end loop;
6387          end;
6388       end if;
6389
6390       if not Excluded_Source_Dirs.Default
6391         and then Excluded_Source_Dirs.Values /= Nil_String
6392       then
6393          declare
6394             Source_Dir : String_List_Id;
6395             Element    : String_Element;
6396
6397          begin
6398             --  Process the source directories for each element of the list
6399
6400             Source_Dir := Excluded_Source_Dirs.Values;
6401             while Source_Dir /= Nil_String loop
6402                Element := In_Tree.String_Elements.Table (Source_Dir);
6403                Find_Source_Dirs
6404                  (File_Name_Type (Element.Value),
6405                   Element.Location,
6406                   Removed => True);
6407                Source_Dir := Element.Next;
6408             end loop;
6409          end;
6410       end if;
6411
6412       if Current_Verbosity = High then
6413          Write_Line ("Putting source directories in canonical cases");
6414       end if;
6415
6416       declare
6417          Current : String_List_Id := Data.Source_Dirs;
6418          Element : String_Element;
6419
6420       begin
6421          while Current /= Nil_String loop
6422             Element := In_Tree.String_Elements.Table (Current);
6423             if Element.Value /= No_Name then
6424                if not Osint.File_Names_Case_Sensitive then
6425                   Get_Name_String (Element.Value);
6426                   Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
6427                   Element.Value := Name_Find;
6428                end if;
6429
6430                In_Tree.String_Elements.Table (Current) := Element;
6431             end if;
6432
6433             Current := Element.Next;
6434          end loop;
6435       end;
6436
6437    end Get_Directories;
6438
6439    ---------------
6440    -- Get_Mains --
6441    ---------------
6442
6443    procedure Get_Mains
6444      (Project : Project_Id;
6445       In_Tree : Project_Tree_Ref;
6446       Data    : in out Project_Data)
6447    is
6448       Mains : constant Variable_Value :=
6449                 Prj.Util.Value_Of (Name_Main, Data.Decl.Attributes, In_Tree);
6450       List  : String_List_Id;
6451       Elem  : String_Element;
6452
6453    begin
6454       Data.Mains := Mains.Values;
6455
6456       --  If no Mains were specified, and if we are an extending project,
6457       --  inherit the Mains from the project we are extending.
6458
6459       if Mains.Default then
6460          if not Data.Library and then Data.Extends /= No_Project then
6461             Data.Mains :=
6462               In_Tree.Projects.Table (Data.Extends).Mains;
6463          end if;
6464
6465       --  In a library project file, Main cannot be specified
6466
6467       elsif Data.Library then
6468          Error_Msg
6469            (Project, In_Tree,
6470             "a library project file cannot have Main specified",
6471             Mains.Location);
6472
6473       else
6474          List := Mains.Values;
6475          while List /= Nil_String loop
6476             Elem := In_Tree.String_Elements.Table (List);
6477
6478             if Length_Of_Name (Elem.Value) = 0 then
6479                Error_Msg
6480                  (Project, In_Tree,
6481                   "?a main cannot have an empty name",
6482                   Elem.Location);
6483                exit;
6484             end if;
6485
6486             List := Elem.Next;
6487          end loop;
6488       end if;
6489    end Get_Mains;
6490
6491    ---------------------------
6492    -- Get_Sources_From_File --
6493    ---------------------------
6494
6495    procedure Get_Sources_From_File
6496      (Path     : String;
6497       Location : Source_Ptr;
6498       Project  : Project_Id;
6499       In_Tree  : Project_Tree_Ref)
6500    is
6501       File        : Prj.Util.Text_File;
6502       Line        : String (1 .. 250);
6503       Last        : Natural;
6504       Source_Name : File_Name_Type;
6505       Name_Loc    : Name_Location;
6506
6507    begin
6508       if Get_Mode = Ada_Only then
6509          Source_Names.Reset;
6510       end if;
6511
6512       if Current_Verbosity = High then
6513          Write_Str  ("Opening """);
6514          Write_Str  (Path);
6515          Write_Line (""".");
6516       end if;
6517
6518       --  Open the file
6519
6520       Prj.Util.Open (File, Path);
6521
6522       if not Prj.Util.Is_Valid (File) then
6523          Error_Msg (Project, In_Tree, "file does not exist", Location);
6524
6525       else
6526          --  Read the lines one by one
6527
6528          while not Prj.Util.End_Of_File (File) loop
6529             Prj.Util.Get_Line (File, Line, Last);
6530
6531             --  A non empty, non comment line should contain a file name
6532
6533             if Last /= 0
6534               and then (Last = 1 or else Line (1 .. 2) /= "--")
6535             then
6536                Name_Len := Last;
6537                Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
6538                Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
6539                Source_Name := Name_Find;
6540
6541                --  Check that there is no directory information
6542
6543                for J in 1 .. Last loop
6544                   if Line (J) = '/' or else Line (J) = Directory_Separator then
6545                      Error_Msg_File_1 := Source_Name;
6546                      Error_Msg
6547                        (Project,
6548                         In_Tree,
6549                         "file name cannot include directory information ({)",
6550                         Location);
6551                      exit;
6552                   end if;
6553                end loop;
6554
6555                Name_Loc := Source_Names.Get (Source_Name);
6556
6557                if Name_Loc = No_Name_Location then
6558                   Name_Loc :=
6559                     (Name     => Source_Name,
6560                      Location => Location,
6561                      Source   => No_Source,
6562                      Except   => False,
6563                      Found    => False);
6564                end if;
6565
6566                Source_Names.Set (Source_Name, Name_Loc);
6567             end if;
6568          end loop;
6569
6570          Prj.Util.Close (File);
6571
6572       end if;
6573    end Get_Sources_From_File;
6574
6575    --------------
6576    -- Get_Unit --
6577    --------------
6578
6579    procedure Get_Unit
6580      (In_Tree             : Project_Tree_Ref;
6581       Canonical_File_Name : File_Name_Type;
6582       Naming              : Naming_Data;
6583       Exception_Id        : out Ada_Naming_Exception_Id;
6584       Unit_Name           : out Name_Id;
6585       Unit_Kind           : out Spec_Or_Body;
6586       Needs_Pragma        : out Boolean)
6587    is
6588       Info_Id  : Ada_Naming_Exception_Id :=
6589                    Ada_Naming_Exceptions.Get (Canonical_File_Name);
6590       VMS_Name : File_Name_Type;
6591
6592    begin
6593       if Info_Id = No_Ada_Naming_Exception then
6594          if Hostparm.OpenVMS then
6595             VMS_Name := Canonical_File_Name;
6596             Get_Name_String (VMS_Name);
6597
6598             if Name_Buffer (Name_Len) = '.' then
6599                Name_Len := Name_Len - 1;
6600                VMS_Name := Name_Find;
6601             end if;
6602
6603             Info_Id := Ada_Naming_Exceptions.Get (VMS_Name);
6604          end if;
6605
6606       end if;
6607
6608       if Info_Id /= No_Ada_Naming_Exception then
6609          Exception_Id := Info_Id;
6610          Unit_Name := No_Name;
6611          Unit_Kind := Specification;
6612          Needs_Pragma := True;
6613          return;
6614       end if;
6615
6616       Needs_Pragma := False;
6617       Exception_Id := No_Ada_Naming_Exception;
6618
6619       Get_Name_String (Canonical_File_Name);
6620
6621       --  How about some comments and a name for this declare block ???
6622       --  In fact the whole code below needs more comments ???
6623
6624       declare
6625          File          : String := Name_Buffer (1 .. Name_Len);
6626          First         : constant Positive := File'First;
6627          Last          : Natural           := File'Last;
6628          Standard_GNAT : Boolean;
6629          Spec          : constant File_Name_Type :=
6630                            Spec_Suffix_Id_Of (In_Tree, Name_Ada, Naming);
6631          Body_Suff     : constant File_Name_Type :=
6632                            Body_Suffix_Id_Of (In_Tree, Name_Ada, Naming);
6633
6634       begin
6635          Standard_GNAT := Spec = Default_Ada_Spec_Suffix
6636             and then Body_Suff = Default_Ada_Body_Suffix;
6637
6638          declare
6639             Spec_Suffix : constant String := Get_Name_String (Spec);
6640             Body_Suffix : constant String := Get_Name_String (Body_Suff);
6641             Sep_Suffix  : constant String :=
6642                             Get_Name_String (Naming.Separate_Suffix);
6643
6644             May_Be_Spec : Boolean;
6645             May_Be_Body : Boolean;
6646             May_Be_Sep  : Boolean;
6647
6648          begin
6649             May_Be_Spec :=
6650               File'Length > Spec_Suffix'Length
6651               and then
6652               File (Last - Spec_Suffix'Length + 1 .. Last) = Spec_Suffix;
6653
6654             May_Be_Body :=
6655               File'Length > Body_Suffix'Length
6656               and then
6657               File (Last - Body_Suffix'Length + 1 .. Last) = Body_Suffix;
6658
6659             May_Be_Sep :=
6660               File'Length > Sep_Suffix'Length
6661               and then
6662               File (Last - Sep_Suffix'Length + 1 .. Last) = Sep_Suffix;
6663
6664             --  If two May_Be_ booleans are True, always choose the longer one
6665
6666             if May_Be_Spec then
6667                if May_Be_Body and then
6668                  Spec_Suffix'Length < Body_Suffix'Length
6669                then
6670                   Unit_Kind := Body_Part;
6671
6672                   if May_Be_Sep and then
6673                     Body_Suffix'Length < Sep_Suffix'Length
6674                   then
6675                      Last := Last - Sep_Suffix'Length;
6676                      May_Be_Body := False;
6677
6678                   else
6679                      Last := Last - Body_Suffix'Length;
6680                      May_Be_Sep := False;
6681                   end if;
6682
6683                elsif May_Be_Sep and then
6684                      Spec_Suffix'Length < Sep_Suffix'Length
6685                then
6686                   Unit_Kind := Body_Part;
6687                   Last := Last - Sep_Suffix'Length;
6688
6689                else
6690                   Unit_Kind := Specification;
6691                   Last := Last - Spec_Suffix'Length;
6692                end if;
6693
6694             elsif May_Be_Body then
6695                Unit_Kind := Body_Part;
6696
6697                if May_Be_Sep and then
6698                   Body_Suffix'Length < Sep_Suffix'Length
6699                then
6700                   Last := Last - Sep_Suffix'Length;
6701                   May_Be_Body := False;
6702                else
6703                   Last := Last - Body_Suffix'Length;
6704                   May_Be_Sep := False;
6705                end if;
6706
6707             elsif May_Be_Sep then
6708                Unit_Kind := Body_Part;
6709                Last := Last - Sep_Suffix'Length;
6710
6711             else
6712                Last := 0;
6713             end if;
6714
6715             if Last = 0 then
6716
6717                --  This is not a source file
6718
6719                Unit_Name := No_Name;
6720                Unit_Kind := Specification;
6721
6722                if Current_Verbosity = High then
6723                   Write_Line ("   Not a valid file name.");
6724                end if;
6725
6726                return;
6727
6728             elsif Current_Verbosity = High then
6729                case Unit_Kind is
6730                when Specification =>
6731                   Write_Str  ("   Specification: ");
6732                   Write_Line (File (First .. Last + Spec_Suffix'Length));
6733
6734                when Body_Part =>
6735                   if May_Be_Body then
6736                      Write_Str  ("   Body: ");
6737                      Write_Line (File (First .. Last + Body_Suffix'Length));
6738
6739                   else
6740                      Write_Str  ("   Separate: ");
6741                      Write_Line (File (First .. Last + Sep_Suffix'Length));
6742                   end if;
6743                end case;
6744             end if;
6745          end;
6746
6747          Get_Name_String (Naming.Dot_Replacement);
6748          Standard_GNAT :=
6749            Standard_GNAT and then Name_Buffer (1 .. Name_Len) = "-";
6750
6751          if Name_Buffer (1 .. Name_Len) /= "." then
6752
6753             --  If Dot_Replacement is not a single dot, then there should not
6754             --  be any dot in the name.
6755
6756             for Index in First .. Last loop
6757                if File (Index) = '.' then
6758                   if Current_Verbosity = High then
6759                      Write_Line
6760                        ("   Not a valid file name (some dot not replaced).");
6761                   end if;
6762
6763                   Unit_Name := No_Name;
6764                   return;
6765
6766                end if;
6767             end loop;
6768
6769             --  Replace the substring Dot_Replacement with dots
6770
6771             declare
6772                Index : Positive := First;
6773
6774             begin
6775                while Index <= Last - Name_Len + 1 loop
6776
6777                   if File (Index .. Index + Name_Len - 1) =
6778                     Name_Buffer (1 .. Name_Len)
6779                   then
6780                      File (Index) := '.';
6781
6782                      if Name_Len > 1 and then Index < Last then
6783                         File (Index + 1 .. Last - Name_Len + 1) :=
6784                           File (Index + Name_Len .. Last);
6785                      end if;
6786
6787                      Last := Last - Name_Len + 1;
6788                   end if;
6789
6790                   Index := Index + 1;
6791                end loop;
6792             end;
6793          end if;
6794
6795          --  Check if the file casing is right
6796
6797          declare
6798             Src      : String := File (First .. Last);
6799             Src_Last : Positive := Last;
6800
6801          begin
6802             --  If casing is significant, deal with upper/lower case translate
6803
6804             if File_Names_Case_Sensitive then
6805                case Naming.Casing is
6806                   when All_Lower_Case =>
6807                      Fixed.Translate
6808                        (Source  => Src,
6809                         Mapping => Lower_Case_Map);
6810
6811                   when All_Upper_Case =>
6812                      Fixed.Translate
6813                        (Source  => Src,
6814                         Mapping => Upper_Case_Map);
6815
6816                   when Mixed_Case | Unknown =>
6817                      null;
6818                end case;
6819
6820                if Src /= File (First .. Last) then
6821                   if Current_Verbosity = High then
6822                      Write_Line ("   Not a valid file name (casing).");
6823                   end if;
6824
6825                   Unit_Name := No_Name;
6826                   return;
6827                end if;
6828             end if;
6829
6830             --  Put the name in lower case
6831
6832             Fixed.Translate
6833               (Source  => Src,
6834                Mapping => Lower_Case_Map);
6835
6836             --  In the standard GNAT naming scheme, check for special cases:
6837             --  children or separates of A, G, I or S, and run time sources.
6838
6839             if Standard_GNAT and then Src'Length >= 3 then
6840                declare
6841                   S1 : constant Character := Src (Src'First);
6842                   S2 : constant Character := Src (Src'First + 1);
6843                   S3 : constant Character := Src (Src'First + 2);
6844
6845                begin
6846                   if S1 = 'a' or else
6847                      S1 = 'g' or else
6848                      S1 = 'i' or else
6849                      S1 = 's'
6850                   then
6851                      --  Children or separates of packages A, G, I or S. These
6852                      --  names are x__ ... or x~... (where x is a, g, i, or s).
6853                      --  Both versions (x__... and x~...) are allowed in all
6854                      --  platforms, because it is not possible to know the
6855                      --  platform before processing of the project files.
6856
6857                      if S2 = '_' and then S3 = '_' then
6858                         Src (Src'First + 1) := '.';
6859                         Src_Last := Src_Last - 1;
6860                         Src (Src'First + 2 .. Src_Last) :=
6861                           Src (Src'First + 3 .. Src_Last + 1);
6862
6863                      elsif S2 = '~' then
6864                         Src (Src'First + 1) := '.';
6865
6866                      --  If it is potentially a run time source, disable
6867                      --  filling of the mapping file to avoid warnings.
6868
6869                      elsif S2 = '.' then
6870                         Set_Mapping_File_Initial_State_To_Empty;
6871                      end if;
6872                   end if;
6873                end;
6874             end if;
6875
6876             if Current_Verbosity = High then
6877                Write_Str  ("      ");
6878                Write_Line (Src (Src'First .. Src_Last));
6879             end if;
6880
6881             --  Now, we check if this name is a valid unit name
6882
6883             Check_Ada_Name
6884               (Name => Src (Src'First .. Src_Last), Unit => Unit_Name);
6885          end;
6886
6887       end;
6888    end Get_Unit;
6889
6890    ----------
6891    -- Hash --
6892    ----------
6893
6894    function Hash (Unit : Unit_Info) return Header_Num is
6895    begin
6896       return Header_Num (Unit.Unit mod 2048);
6897    end Hash;
6898
6899    -----------------------
6900    -- Is_Illegal_Suffix --
6901    -----------------------
6902
6903    function Is_Illegal_Suffix
6904      (Suffix                          : String;
6905       Dot_Replacement_Is_A_Single_Dot : Boolean) return Boolean
6906    is
6907    begin
6908       if Suffix'Length = 0 or else Index (Suffix, ".") = 0 then
6909          return True;
6910       end if;
6911
6912       --  If dot replacement is a single dot, and first character of suffix is
6913       --  also a dot
6914
6915       if Dot_Replacement_Is_A_Single_Dot
6916         and then Suffix (Suffix'First) = '.'
6917       then
6918          for Index in Suffix'First + 1 .. Suffix'Last loop
6919
6920             --  If there is another dot
6921
6922             if Suffix (Index) = '.' then
6923
6924                --  It is illegal to have a letter following the initial dot
6925
6926                return Is_Letter (Suffix (Suffix'First + 1));
6927             end if;
6928          end loop;
6929       end if;
6930
6931       --  Everything is OK
6932
6933       return False;
6934    end Is_Illegal_Suffix;
6935
6936    ----------------------
6937    -- Locate_Directory --
6938    ----------------------
6939
6940    procedure Locate_Directory
6941      (Project     : Project_Id;
6942       In_Tree     : Project_Tree_Ref;
6943       Name        : File_Name_Type;
6944       Parent      : Path_Name_Type;
6945       Dir         : out Path_Name_Type;
6946       Display     : out Path_Name_Type;
6947       Create      : String := "";
6948       Current_Dir : String;
6949       Location    : Source_Ptr := No_Location)
6950    is
6951       The_Parent      : constant String :=
6952                           Get_Name_String (Parent) & Directory_Separator;
6953
6954       The_Parent_Last : constant Natural :=
6955                           Compute_Directory_Last (The_Parent);
6956
6957       Full_Name       : File_Name_Type;
6958
6959       The_Name        : File_Name_Type;
6960
6961    begin
6962       Get_Name_String (Name);
6963
6964       --  Add Subdirs.all if it is a directory that may be created and
6965       --  Subdirs is not null;
6966
6967       if Create /= "" and then Subdirs /= null then
6968          if Name_Buffer (Name_Len) /= Directory_Separator then
6969             Add_Char_To_Name_Buffer (Directory_Separator);
6970          end if;
6971
6972          Add_Str_To_Name_Buffer (Subdirs.all);
6973       end if;
6974
6975       --  Convert '/' to directory separator (for Windows)
6976
6977       for J in 1 .. Name_Len loop
6978          if Name_Buffer (J) = '/' then
6979             Name_Buffer (J) := Directory_Separator;
6980          end if;
6981       end loop;
6982
6983       The_Name := Name_Find;
6984
6985       if Current_Verbosity = High then
6986          Write_Str ("Locate_Directory (""");
6987          Write_Str (Get_Name_String (The_Name));
6988          Write_Str (""", """);
6989          Write_Str (The_Parent);
6990          Write_Line (""")");
6991       end if;
6992
6993       Dir     := No_Path;
6994       Display := No_Path;
6995
6996       if Is_Absolute_Path (Get_Name_String (The_Name)) then
6997          Full_Name := The_Name;
6998
6999       else
7000          Name_Len := 0;
7001          Add_Str_To_Name_Buffer
7002            (The_Parent (The_Parent'First .. The_Parent_Last));
7003          Add_Str_To_Name_Buffer (Get_Name_String (The_Name));
7004          Full_Name := Name_Find;
7005       end if;
7006
7007       declare
7008          Full_Path_Name : constant String := Get_Name_String (Full_Name);
7009
7010       begin
7011          if (Setup_Projects or else Subdirs /= null)
7012            and then Create'Length > 0
7013            and then not Is_Directory (Full_Path_Name)
7014          then
7015             begin
7016                Create_Path (Full_Path_Name);
7017
7018                if not Quiet_Output then
7019                   Write_Str (Create);
7020                   Write_Str (" directory """);
7021                   Write_Str (Full_Path_Name);
7022                   Write_Line (""" created");
7023                end if;
7024
7025             exception
7026                when Use_Error =>
7027                   Error_Msg
7028                     (Project, In_Tree,
7029                      "could not create " & Create &
7030                      " directory " & Full_Path_Name,
7031                      Location);
7032             end;
7033          end if;
7034
7035          if Is_Directory (Full_Path_Name) then
7036             declare
7037                Normed : constant String :=
7038                           Normalize_Pathname
7039                             (Full_Path_Name,
7040                              Directory      => Current_Dir,
7041                              Resolve_Links  => False,
7042                              Case_Sensitive => True);
7043
7044                Canonical_Path : constant String :=
7045                                   Normalize_Pathname
7046                                     (Normed,
7047                                      Directory      => Current_Dir,
7048                                      Resolve_Links  =>
7049                                         Opt.Follow_Links_For_Dirs,
7050                                      Case_Sensitive => False);
7051
7052             begin
7053                Name_Len := Normed'Length;
7054                Name_Buffer (1 .. Name_Len) := Normed;
7055                Display := Name_Find;
7056
7057                Name_Len := Canonical_Path'Length;
7058                Name_Buffer (1 .. Name_Len) := Canonical_Path;
7059                Dir := Name_Find;
7060             end;
7061          end if;
7062       end;
7063    end Locate_Directory;
7064
7065    ---------------------------
7066    -- Find_Excluded_Sources --
7067    ---------------------------
7068
7069    procedure Find_Excluded_Sources
7070      (Project : Project_Id;
7071       In_Tree : Project_Tree_Ref;
7072       Data    : Project_Data)
7073    is
7074       Excluded_Sources : Variable_Value;
7075
7076       Excluded_Source_List_File : Variable_Value;
7077
7078       Current          : String_List_Id;
7079
7080       Element : String_Element;
7081
7082       Location : Source_Ptr;
7083
7084       Name : File_Name_Type;
7085
7086       File : Prj.Util.Text_File;
7087       Line : String (1 .. 300);
7088       Last : Natural;
7089
7090       Locally_Removed : Boolean := False;
7091    begin
7092       Excluded_Source_List_File :=
7093         Util.Value_Of
7094           (Name_Excluded_Source_List_File, Data.Decl.Attributes, In_Tree);
7095
7096       Excluded_Sources :=
7097         Util.Value_Of
7098           (Name_Excluded_Source_Files, Data.Decl.Attributes, In_Tree);
7099
7100       --  If Excluded_Source_Files is not declared, check
7101       --  Locally_Removed_Files.
7102
7103       if Excluded_Sources.Default then
7104          Locally_Removed := True;
7105          Excluded_Sources :=
7106            Util.Value_Of
7107              (Name_Locally_Removed_Files, Data.Decl.Attributes, In_Tree);
7108       end if;
7109
7110       Excluded_Sources_Htable.Reset;
7111
7112       --  If there are excluded sources, put them in the table
7113
7114       if not Excluded_Sources.Default then
7115          if not Excluded_Source_List_File.Default then
7116             if Locally_Removed then
7117                Error_Msg
7118                  (Project, In_Tree,
7119                   "?both attributes Locally_Removed_Files and " &
7120                   "Excluded_Source_List_File are present",
7121                   Excluded_Source_List_File.Location);
7122             else
7123                Error_Msg
7124                  (Project, In_Tree,
7125                   "?both attributes Excluded_Source_Files and " &
7126                   "Excluded_Source_List_File are present",
7127                   Excluded_Source_List_File.Location);
7128             end if;
7129          end if;
7130
7131          Current := Excluded_Sources.Values;
7132          while Current /= Nil_String loop
7133             Element := In_Tree.String_Elements.Table (Current);
7134
7135             if Osint.File_Names_Case_Sensitive then
7136                Name := File_Name_Type (Element.Value);
7137             else
7138                Get_Name_String (Element.Value);
7139                Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
7140                Name := Name_Find;
7141             end if;
7142
7143             --  If the element has no location, then use the location
7144             --  of Excluded_Sources to report possible errors.
7145
7146             if Element.Location = No_Location then
7147                Location := Excluded_Sources.Location;
7148             else
7149                Location := Element.Location;
7150             end if;
7151
7152             Excluded_Sources_Htable.Set (Name, (Name, False, Location));
7153             Current := Element.Next;
7154          end loop;
7155
7156       elsif not Excluded_Source_List_File.Default then
7157          Location := Excluded_Source_List_File.Location;
7158
7159          declare
7160             Source_File_Path_Name : constant String :=
7161                                       Path_Name_Of
7162                                         (File_Name_Type
7163                                            (Excluded_Source_List_File.Value),
7164                                          Data.Directory.Name);
7165
7166          begin
7167             if Source_File_Path_Name'Length = 0 then
7168                Err_Vars.Error_Msg_File_1 :=
7169                  File_Name_Type (Excluded_Source_List_File.Value);
7170                Error_Msg
7171                  (Project, In_Tree,
7172                   "file with excluded sources { does not exist",
7173                   Excluded_Source_List_File.Location);
7174
7175             else
7176                --  Open the file
7177
7178                Prj.Util.Open (File, Source_File_Path_Name);
7179
7180                if not Prj.Util.Is_Valid (File) then
7181                   Error_Msg
7182                     (Project, In_Tree, "file does not exist", Location);
7183                else
7184                   --  Read the lines one by one
7185
7186                   while not Prj.Util.End_Of_File (File) loop
7187                      Prj.Util.Get_Line (File, Line, Last);
7188
7189                      --  A non empty, non comment line should contain a file
7190                      --  name
7191
7192                      if Last /= 0
7193                        and then (Last = 1 or else Line (1 .. 2) /= "--")
7194                      then
7195                         Name_Len := Last;
7196                         Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
7197                         Canonical_Case_File_Name
7198                           (Name_Buffer (1 .. Name_Len));
7199                         Name := Name_Find;
7200
7201                         --  Check that there is no directory information
7202
7203                         for J in 1 .. Last loop
7204                            if Line (J) = '/'
7205                              or else Line (J) = Directory_Separator
7206                            then
7207                               Error_Msg_File_1 := Name;
7208                               Error_Msg
7209                                 (Project,
7210                                  In_Tree,
7211                                  "file name cannot include " &
7212                                  "directory information ({)",
7213                                  Location);
7214                               exit;
7215                            end if;
7216                         end loop;
7217
7218                         Excluded_Sources_Htable.Set
7219                           (Name, (Name, False, Location));
7220                      end if;
7221                   end loop;
7222
7223                   Prj.Util.Close (File);
7224                end if;
7225             end if;
7226          end;
7227       end if;
7228    end Find_Excluded_Sources;
7229
7230    ---------------------------
7231    -- Find_Explicit_Sources --
7232    ---------------------------
7233
7234    procedure Find_Explicit_Sources
7235      (Current_Dir : String;
7236       Project     : Project_Id;
7237       In_Tree     : Project_Tree_Ref;
7238       Data        : in out Project_Data)
7239    is
7240       Sources          : constant Variable_Value :=
7241                            Util.Value_Of
7242                              (Name_Source_Files,
7243                               Data.Decl.Attributes,
7244                               In_Tree);
7245       Source_List_File : constant Variable_Value :=
7246                            Util.Value_Of
7247                              (Name_Source_List_File,
7248                               Data.Decl.Attributes,
7249                               In_Tree);
7250       Name_Loc         : Name_Location;
7251
7252    begin
7253       pragma Assert (Sources.Kind = List, "Source_Files is not a list");
7254       pragma Assert
7255         (Source_List_File.Kind = Single,
7256          "Source_List_File is not a single string");
7257
7258       --  If the user has specified a Sources attribute
7259
7260       if not Sources.Default then
7261          if not Source_List_File.Default then
7262             Error_Msg
7263               (Project, In_Tree,
7264                "?both attributes source_files and " &
7265                "source_list_file are present",
7266                Source_List_File.Location);
7267          end if;
7268
7269          --  Sources is a list of file names
7270
7271          declare
7272             Current  : String_List_Id := Sources.Values;
7273             Element  : String_Element;
7274             Location : Source_Ptr;
7275             Name     : File_Name_Type;
7276
7277          begin
7278             if Get_Mode = Ada_Only then
7279                Data.Ada_Sources_Present := Current /= Nil_String;
7280             end if;
7281
7282             if Get_Mode = Multi_Language then
7283                if Current = Nil_String then
7284                   Data.First_Language_Processing := No_Language_Index;
7285
7286                   --  This project contains no source. For projects that
7287                   --  don't extend other projects, this also means that
7288                   --  there is no need for an object directory, if not
7289                   --  specified.
7290
7291                   if Data.Extends = No_Project
7292                     and then Data.Object_Directory = Data.Directory
7293                   then
7294                      Data.Object_Directory := No_Path_Information;
7295                   end if;
7296                end if;
7297             end if;
7298
7299             while Current /= Nil_String loop
7300                Element := In_Tree.String_Elements.Table (Current);
7301                Get_Name_String (Element.Value);
7302
7303                if Osint.File_Names_Case_Sensitive then
7304                   Name := File_Name_Type (Element.Value);
7305                else
7306                   Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
7307                   Name := Name_Find;
7308                end if;
7309
7310                --  If the element has no location, then use the
7311                --  location of Sources to report possible errors.
7312
7313                if Element.Location = No_Location then
7314                   Location := Sources.Location;
7315                else
7316                   Location := Element.Location;
7317                end if;
7318
7319                --  Check that there is no directory information
7320
7321                for J in 1 .. Name_Len loop
7322                   if Name_Buffer (J) = '/'
7323                     or else Name_Buffer (J) = Directory_Separator
7324                   then
7325                      Error_Msg_File_1 := Name;
7326                      Error_Msg
7327                        (Project,
7328                         In_Tree,
7329                         "file name cannot include directory " &
7330                         "information ({)",
7331                         Location);
7332                      exit;
7333                   end if;
7334                end loop;
7335
7336                --  In Multi_Language mode, check whether the file is
7337                --  already there: the same file name may be in the list; if
7338                --  the source is missing, the error will be on the first
7339                --  mention of the source file name.
7340
7341                case Get_Mode is
7342                   when Ada_Only =>
7343                      Name_Loc := No_Name_Location;
7344                   when Multi_Language =>
7345                      Name_Loc := Source_Names.Get (Name);
7346                end case;
7347
7348                if Name_Loc = No_Name_Location then
7349                   Name_Loc :=
7350                     (Name     => Name,
7351                      Location => Location,
7352                      Source   => No_Source,
7353                      Except   => False,
7354                      Found    => False);
7355                   Source_Names.Set (Name, Name_Loc);
7356                end if;
7357
7358                Current := Element.Next;
7359             end loop;
7360
7361             if Get_Mode = Ada_Only then
7362                Get_Path_Names_And_Record_Ada_Sources
7363                  (Project, In_Tree, Data, Current_Dir);
7364             end if;
7365          end;
7366
7367          --  If we have no Source_Files attribute, check the Source_List_File
7368          --  attribute
7369
7370       elsif not Source_List_File.Default then
7371
7372          --  Source_List_File is the name of the file
7373          --  that contains the source file names
7374
7375          declare
7376             Source_File_Path_Name : constant String :=
7377               Path_Name_Of
7378                 (File_Name_Type (Source_List_File.Value), Data.Directory.Name);
7379
7380          begin
7381             if Source_File_Path_Name'Length = 0 then
7382                Err_Vars.Error_Msg_File_1 :=
7383                  File_Name_Type (Source_List_File.Value);
7384                Error_Msg
7385                  (Project, In_Tree,
7386                   "file with sources { does not exist",
7387                   Source_List_File.Location);
7388
7389             else
7390                Get_Sources_From_File
7391                  (Source_File_Path_Name, Source_List_File.Location,
7392                   Project, In_Tree);
7393
7394                if Get_Mode = Ada_Only then
7395                   --  Look in the source directories to find those sources
7396
7397                   Get_Path_Names_And_Record_Ada_Sources
7398                     (Project, In_Tree, Data, Current_Dir);
7399                end if;
7400             end if;
7401          end;
7402
7403       else
7404          --  Neither Source_Files nor Source_List_File has been
7405          --  specified. Find all the files that satisfy the naming
7406          --  scheme in all the source directories.
7407
7408          if Get_Mode = Ada_Only then
7409             Find_Ada_Sources (Project, In_Tree, Data, Current_Dir);
7410          end if;
7411       end if;
7412
7413       if Get_Mode = Multi_Language then
7414          Search_Directories
7415            (Project, In_Tree, Data,
7416             For_All_Sources =>
7417               Sources.Default and then Source_List_File.Default);
7418
7419          --  Check if all exceptions have been found.
7420          --  For Ada, it is an error if an exception is not found.
7421          --  For other language, the source is simply removed.
7422
7423          declare
7424             Source : Source_Id;
7425
7426          begin
7427             Source := Data.First_Source;
7428             while Source /= No_Source loop
7429                declare
7430                   Src_Data : Source_Data renames
7431                                In_Tree.Sources.Table (Source);
7432
7433                begin
7434                   if Src_Data.Naming_Exception
7435                     and then Src_Data.Path = No_Path_Information
7436                   then
7437                      if Src_Data.Unit /= No_Name then
7438                         Error_Msg_Name_1 := Name_Id (Src_Data.Display_File);
7439                         Error_Msg_Name_2 := Name_Id (Src_Data.Unit);
7440                         Error_Msg
7441                           (Project, In_Tree,
7442                            "source file %% for unit %% not found",
7443                            No_Location);
7444                      end if;
7445
7446                      Remove_Source (Source, No_Source, Project, Data, In_Tree);
7447                   end if;
7448
7449                   Source := Src_Data.Next_In_Project;
7450                end;
7451             end loop;
7452          end;
7453
7454          --  Check that all sources in Source_Files or the file
7455          --  Source_List_File has been found.
7456
7457          declare
7458             Name_Loc : Name_Location;
7459
7460          begin
7461             Name_Loc := Source_Names.Get_First;
7462             while Name_Loc /= No_Name_Location loop
7463                if (not Name_Loc.Except) and then (not Name_Loc.Found) then
7464                   Error_Msg_Name_1 := Name_Id (Name_Loc.Name);
7465                   Error_Msg
7466                     (Project,
7467                      In_Tree,
7468                      "file %% not found",
7469                      Name_Loc.Location);
7470                end if;
7471
7472                Name_Loc := Source_Names.Get_Next;
7473             end loop;
7474          end;
7475       end if;
7476
7477       if Get_Mode = Ada_Only
7478         and then Data.Extends = No_Project
7479       then
7480          --  We should have found at least one source, if not report an error
7481
7482          if Data.Ada_Sources = Nil_String then
7483             Report_No_Sources
7484               (Project, "Ada", In_Tree, Source_List_File.Location);
7485          end if;
7486       end if;
7487
7488    end Find_Explicit_Sources;
7489
7490    -------------------------------------------
7491    -- Get_Path_Names_And_Record_Ada_Sources --
7492    -------------------------------------------
7493
7494    procedure Get_Path_Names_And_Record_Ada_Sources
7495      (Project     : Project_Id;
7496       In_Tree     : Project_Tree_Ref;
7497       Data        : in out Project_Data;
7498       Current_Dir : String)
7499    is
7500       Source_Dir      : String_List_Id;
7501       Element         : String_Element;
7502       Path            : Path_Name_Type;
7503       Dir             : Dir_Type;
7504       Name            : File_Name_Type;
7505       Canonical_Name  : File_Name_Type;
7506       Name_Str        : String (1 .. 1_024);
7507       Last            : Natural := 0;
7508       NL              : Name_Location;
7509       Current_Source  : String_List_Id := Nil_String;
7510       First_Error     : Boolean := True;
7511       Source_Recorded : Boolean := False;
7512
7513    begin
7514       --  We look in all source directories for the file names in the hash
7515       --  table Source_Names.
7516
7517       Source_Dir := Data.Source_Dirs;
7518       while Source_Dir /= Nil_String loop
7519          Source_Recorded := False;
7520          Element := In_Tree.String_Elements.Table (Source_Dir);
7521
7522          declare
7523             Dir_Path : constant String :=
7524               Get_Name_String (Element.Display_Value);
7525          begin
7526             if Current_Verbosity = High then
7527                Write_Str ("checking directory """);
7528                Write_Str (Dir_Path);
7529                Write_Line ("""");
7530             end if;
7531
7532             Open (Dir, Dir_Path);
7533
7534             loop
7535                Read (Dir, Name_Str, Last);
7536                exit when Last = 0;
7537
7538                Name_Len := Last;
7539                Name_Buffer (1 .. Name_Len) := Name_Str (1 .. Last);
7540                Name := Name_Find;
7541
7542                if Osint.File_Names_Case_Sensitive then
7543                   Canonical_Name := Name;
7544                else
7545                   Canonical_Case_File_Name (Name_Str (1 .. Last));
7546                   Name_Buffer (1 .. Name_Len) := Name_Str (1 .. Last);
7547                   Canonical_Name := Name_Find;
7548                end if;
7549
7550                NL := Source_Names.Get (Canonical_Name);
7551
7552                if NL /= No_Name_Location and then not NL.Found then
7553                   NL.Found := True;
7554                   Source_Names.Set (Canonical_Name, NL);
7555                   Name_Len := Dir_Path'Length;
7556                   Name_Buffer (1 .. Name_Len) := Dir_Path;
7557
7558                   if Name_Buffer (Name_Len) /= Directory_Separator then
7559                      Add_Char_To_Name_Buffer (Directory_Separator);
7560                   end if;
7561
7562                   Add_Str_To_Name_Buffer (Name_Str (1 .. Last));
7563                   Path := Name_Find;
7564
7565                   if Current_Verbosity = High then
7566                      Write_Str  ("  found ");
7567                      Write_Line (Get_Name_String (Name));
7568                   end if;
7569
7570                   --  Register the source if it is an Ada compilation unit
7571
7572                   Record_Ada_Source
7573                     (File_Name       => Name,
7574                      Path_Name       => Path,
7575                      Project         => Project,
7576                      In_Tree         => In_Tree,
7577                      Data            => Data,
7578                      Location        => NL.Location,
7579                      Current_Source  => Current_Source,
7580                      Source_Recorded => Source_Recorded,
7581                      Current_Dir     => Current_Dir);
7582                end if;
7583             end loop;
7584
7585             Close (Dir);
7586          end;
7587
7588          if Source_Recorded then
7589             In_Tree.String_Elements.Table (Source_Dir).Flag :=
7590               True;
7591          end if;
7592
7593          Source_Dir := Element.Next;
7594       end loop;
7595
7596       --  It is an error if a source file name in a source list or
7597       --  in a source list file is not found.
7598
7599       NL := Source_Names.Get_First;
7600       while NL /= No_Name_Location loop
7601          if not NL.Found then
7602             Err_Vars.Error_Msg_File_1 := NL.Name;
7603
7604             if First_Error then
7605                Error_Msg
7606                  (Project, In_Tree,
7607                   "source file { cannot be found",
7608                   NL.Location);
7609                First_Error := False;
7610
7611             else
7612                Error_Msg
7613                  (Project, In_Tree,
7614                   "\source file { cannot be found",
7615                   NL.Location);
7616             end if;
7617          end if;
7618
7619          NL := Source_Names.Get_Next;
7620       end loop;
7621    end Get_Path_Names_And_Record_Ada_Sources;
7622
7623    --------------------------
7624    -- Check_Naming_Schemes --
7625    --------------------------
7626
7627    procedure Check_Naming_Schemes
7628      (In_Tree               : Project_Tree_Ref;
7629       Data                  : in out Project_Data;
7630       Filename              : String;
7631       File_Name             : File_Name_Type;
7632       Alternate_Languages   : out Alternate_Language_Id;
7633       Language              : out Language_Index;
7634       Language_Name         : out Name_Id;
7635       Display_Language_Name : out Name_Id;
7636       Unit                  : out Name_Id;
7637       Lang_Kind             : out Language_Kind;
7638       Kind                  : out Source_Kind)
7639    is
7640       Last           : Positive := Filename'Last;
7641       Config         : Language_Config;
7642       Lang           : Name_List_Index := Data.Languages;
7643       Header_File    : Boolean := False;
7644       First_Language : Language_Index;
7645       OK             : Boolean;
7646
7647       Last_Spec : Natural;
7648       Last_Body : Natural;
7649       Last_Sep  : Natural;
7650
7651    begin
7652       Unit := No_Name;
7653       Alternate_Languages := No_Alternate_Language;
7654
7655       while Lang /= No_Name_List loop
7656          Language_Name := In_Tree.Name_Lists.Table (Lang).Name;
7657          Language      := Data.First_Language_Processing;
7658
7659          if Current_Verbosity = High then
7660             Write_Line
7661               ("     Testing language "
7662                & Get_Name_String (Language_Name)
7663                & " Header_File=" & Header_File'Img);
7664          end if;
7665
7666          while Language /= No_Language_Index loop
7667             if In_Tree.Languages_Data.Table (Language).Name =
7668               Language_Name
7669             then
7670                Display_Language_Name :=
7671                  In_Tree.Languages_Data.Table (Language).Display_Name;
7672                Config := In_Tree.Languages_Data.Table (Language).Config;
7673                Lang_Kind := Config.Kind;
7674
7675                if Config.Kind = File_Based then
7676
7677                   --  For file based languages, there is no Unit. Just
7678                   --  check if the file name has the implementation or,
7679                   --  if it is specified, the template suffix of the
7680                   --  language.
7681
7682                   Unit := No_Name;
7683
7684                   if not Header_File
7685                     and then Config.Naming_Data.Body_Suffix /= No_File
7686                   then
7687                      declare
7688                         Impl_Suffix : constant String :=
7689                           Get_Name_String (Config.Naming_Data.Body_Suffix);
7690
7691                      begin
7692                         if Filename'Length > Impl_Suffix'Length
7693                           and then
7694                             Filename
7695                               (Last - Impl_Suffix'Length + 1 .. Last) =
7696                               Impl_Suffix
7697                         then
7698                            Kind := Impl;
7699
7700                            if Current_Verbosity = High then
7701                               Write_Str ("     source of language ");
7702                               Write_Line
7703                                 (Get_Name_String (Display_Language_Name));
7704                            end if;
7705
7706                            return;
7707                         end if;
7708                      end;
7709                   end if;
7710
7711                   if Config.Naming_Data.Spec_Suffix /= No_File then
7712                      declare
7713                         Spec_Suffix : constant String :=
7714                           Get_Name_String
7715                             (Config.Naming_Data.Spec_Suffix);
7716
7717                      begin
7718                         if Filename'Length > Spec_Suffix'Length
7719                           and then
7720                             Filename
7721                               (Last - Spec_Suffix'Length + 1 .. Last) =
7722                               Spec_Suffix
7723                         then
7724                            Kind := Spec;
7725
7726                            if Current_Verbosity = High then
7727                               Write_Str ("     header file of language ");
7728                               Write_Line
7729                                 (Get_Name_String (Display_Language_Name));
7730                            end if;
7731
7732                            if Header_File then
7733                               Alternate_Language_Table.Increment_Last
7734                                 (In_Tree.Alt_Langs);
7735                               In_Tree.Alt_Langs.Table
7736                                 (Alternate_Language_Table.Last
7737                                    (In_Tree.Alt_Langs)) :=
7738                                 (Language => Language,
7739                                  Next     => Alternate_Languages);
7740                               Alternate_Languages :=
7741                                 Alternate_Language_Table.Last
7742                                   (In_Tree.Alt_Langs);
7743                            else
7744                               Header_File    := True;
7745                               First_Language := Language;
7746                            end if;
7747                         end if;
7748                      end;
7749                   end if;
7750
7751                elsif not Header_File then
7752                   --  Unit based language
7753
7754                   OK := Config.Naming_Data.Dot_Replacement /= No_File;
7755
7756                   if OK then
7757
7758                      --  Check casing
7759                      --  ??? Are we doing this once per file in the project ?
7760                      --  It should be done only once per project.
7761
7762                      case Config.Naming_Data.Casing is
7763                         when All_Lower_Case =>
7764                            for J in Filename'Range loop
7765                               if Is_Letter (Filename (J)) then
7766                                  if not Is_Lower (Filename (J)) then
7767                                     OK := False;
7768                                     exit;
7769                                  end if;
7770                               end if;
7771                            end loop;
7772
7773                         when All_Upper_Case =>
7774                            for J in Filename'Range loop
7775                               if Is_Letter (Filename (J)) then
7776                                  if not Is_Upper (Filename (J)) then
7777                                     OK := False;
7778                                     exit;
7779                                  end if;
7780                               end if;
7781                            end loop;
7782
7783                         when Mixed_Case =>
7784                            null;
7785
7786                         when others =>
7787                            OK := False;
7788                      end case;
7789                   end if;
7790
7791                   if OK then
7792                      Last_Spec := Natural'Last;
7793                      Last_Body := Natural'Last;
7794                      Last_Sep  := Natural'Last;
7795
7796                      if Config.Naming_Data.Separate_Suffix /= No_File
7797                        and then
7798                          Config.Naming_Data.Separate_Suffix /=
7799                            Config.Naming_Data.Body_Suffix
7800                      then
7801                         declare
7802                            Suffix : constant String :=
7803                              Get_Name_String
7804                                (Config.Naming_Data.Separate_Suffix);
7805                         begin
7806                            if Filename'Length > Suffix'Length
7807                              and then
7808                                Filename
7809                                  (Last - Suffix'Length + 1 .. Last) =
7810                                  Suffix
7811                            then
7812                               Last_Sep := Last - Suffix'Length;
7813                            end if;
7814                         end;
7815                      end if;
7816
7817                      if Config.Naming_Data.Body_Suffix /= No_File then
7818                         declare
7819                            Suffix : constant String :=
7820                              Get_Name_String
7821                                (Config.Naming_Data.Body_Suffix);
7822                         begin
7823                            if Filename'Length > Suffix'Length
7824                              and then
7825                                Filename
7826                                  (Last - Suffix'Length + 1 .. Last) =
7827                                  Suffix
7828                            then
7829                               Last_Body := Last - Suffix'Length;
7830                            end if;
7831                         end;
7832                      end if;
7833
7834                      if Config.Naming_Data.Spec_Suffix /= No_File then
7835                         declare
7836                            Suffix : constant String :=
7837                              Get_Name_String
7838                                (Config.Naming_Data.Spec_Suffix);
7839                         begin
7840                            if Filename'Length > Suffix'Length
7841                              and then
7842                                Filename
7843                                  (Last - Suffix'Length + 1 .. Last) =
7844                                  Suffix
7845                            then
7846                               Last_Spec := Last - Suffix'Length;
7847                            end if;
7848                         end;
7849                      end if;
7850
7851                      declare
7852                         Last_Min : constant Natural :=
7853                                      Natural'Min (Natural'Min (Last_Spec,
7854                                                                Last_Body),
7855                                                                Last_Sep);
7856
7857                      begin
7858                         OK := Last_Min < Last;
7859
7860                         if OK then
7861                            Last := Last_Min;
7862
7863                            if Last_Min = Last_Spec then
7864                               Kind := Spec;
7865
7866                            elsif Last_Min = Last_Body then
7867                               Kind := Impl;
7868
7869                            else
7870                               Kind := Sep;
7871                            end if;
7872                         end if;
7873                      end;
7874                   end if;
7875
7876                   if OK then
7877
7878                      --  Replace dot replacements with dots
7879
7880                      Name_Len := 0;
7881
7882                      declare
7883                         J : Positive := Filename'First;
7884
7885                         Dot_Replacement : constant String :=
7886                           Get_Name_String
7887                             (Config.Naming_Data.
7888                                  Dot_Replacement);
7889
7890                         Max : constant Positive :=
7891                           Last - Dot_Replacement'Length + 1;
7892
7893                      begin
7894                         loop
7895                            Name_Len := Name_Len + 1;
7896
7897                            if J <= Max and then
7898                              Filename
7899                                (J .. J + Dot_Replacement'Length - 1) =
7900                                Dot_Replacement
7901                            then
7902                               Name_Buffer (Name_Len) := '.';
7903                               J := J + Dot_Replacement'Length;
7904
7905                            else
7906                               if Filename (J) = '.' then
7907                                  OK := False;
7908                                  exit;
7909                               end if;
7910
7911                               Name_Buffer (Name_Len) :=
7912                                 GNAT.Case_Util.To_Lower (Filename (J));
7913                               J := J + 1;
7914                            end if;
7915
7916                            exit when J > Last;
7917                         end loop;
7918                      end;
7919                   end if;
7920
7921                   if OK then
7922
7923                      --  The name buffer should contain the name of the
7924                      --  the unit, if it is one.
7925
7926                      --  Check that this is a valid unit name
7927
7928                      Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
7929
7930                      if Unit /= No_Name then
7931
7932                         if Current_Verbosity = High then
7933                            if Kind = Spec then
7934                               Write_Str ("     spec of ");
7935                            else
7936                               Write_Str ("     body of ");
7937                            end if;
7938
7939                            Write_Str (Get_Name_String (Unit));
7940                            Write_Str (" (language ");
7941                            Write_Str
7942                              (Get_Name_String (Display_Language_Name));
7943                            Write_Line (")");
7944                         end if;
7945
7946                         --  Comments required, declare block should
7947                         --  be named ???
7948
7949                         declare
7950                            Unit_Except : constant Unit_Exception :=
7951                              Unit_Exceptions.Get (Unit);
7952
7953                            procedure Masked_Unit (Spec : Boolean);
7954                            --  Indicate that there is an exception for
7955                            --  the same unit, so the file is not a
7956                            --  source for the unit.
7957
7958                            -----------------
7959                            -- Masked_Unit --
7960                            -----------------
7961
7962                            procedure Masked_Unit (Spec : Boolean) is
7963                            begin
7964                               if Current_Verbosity = High then
7965                                  Write_Str ("   """);
7966                                  Write_Str (Filename);
7967                                  Write_Str (""" contains the ");
7968
7969                                  if Spec then
7970                                     Write_Str ("spec");
7971                                  else
7972                                     Write_Str ("body");
7973                                  end if;
7974
7975                                  Write_Str
7976                                    (" of a unit that is found in """);
7977
7978                                  if Spec then
7979                                     Write_Str
7980                                       (Get_Name_String
7981                                          (Unit_Except.Spec));
7982                                  else
7983                                     Write_Str
7984                                       (Get_Name_String
7985                                          (Unit_Except.Impl));
7986                                  end if;
7987
7988                                  Write_Line (""" (ignored)");
7989                               end if;
7990
7991                               Language := No_Language_Index;
7992                            end Masked_Unit;
7993
7994                         begin
7995                            if Kind = Spec then
7996                               if Unit_Except.Spec /= No_File
7997                                 and then Unit_Except.Spec /= File_Name
7998                               then
7999                                  Masked_Unit (Spec => True);
8000                               end if;
8001
8002                            else
8003                               if Unit_Except.Impl /= No_File
8004                                 and then Unit_Except.Impl /= File_Name
8005                               then
8006                                  Masked_Unit (Spec => False);
8007                               end if;
8008                            end if;
8009                         end;
8010
8011                         return;
8012                      end if;
8013                   end if;
8014                end if;
8015             end if;
8016
8017             Language := In_Tree.Languages_Data.Table (Language).Next;
8018          end loop;
8019
8020          Lang := In_Tree.Name_Lists.Table (Lang).Next;
8021       end loop;
8022
8023       --  Comment needed here ???
8024
8025       if Header_File then
8026          Language := First_Language;
8027
8028       else
8029          Language := No_Language_Index;
8030
8031          if Current_Verbosity = High then
8032             Write_Line ("     not a source of any language");
8033          end if;
8034       end if;
8035    end Check_Naming_Schemes;
8036
8037    ----------------
8038    -- Check_File --
8039    ----------------
8040
8041    procedure Check_File
8042      (Project           : Project_Id;
8043       In_Tree           : Project_Tree_Ref;
8044       Data              : in out Project_Data;
8045       Name              : String;
8046       File_Name         : File_Name_Type;
8047       Display_File_Name : File_Name_Type;
8048       Source_Directory  : String;
8049       For_All_Sources   : Boolean)
8050    is
8051       Display_Path    : constant String :=
8052         Normalize_Pathname
8053           (Name           => Name,
8054            Directory      => Source_Directory,
8055            Resolve_Links  => Opt.Follow_Links_For_Files,
8056            Case_Sensitive => True);
8057
8058       Name_Loc          : Name_Location := Source_Names.Get (File_Name);
8059       Path_Id           : Path_Name_Type;
8060       Display_Path_Id   : Path_Name_Type;
8061       Check_Name        : Boolean := False;
8062       Alternate_Languages : Alternate_Language_Id := No_Alternate_Language;
8063       Language          : Language_Index;
8064       Source            : Source_Id;
8065       Other_Part        : Source_Id;
8066       Add_Src           : Boolean;
8067       Src_Ind           : Source_File_Index;
8068       Unit              : Name_Id;
8069       Source_To_Replace : Source_Id := No_Source;
8070       Language_Name         : Name_Id;
8071       Display_Language_Name : Name_Id;
8072       Lang_Kind             : Language_Kind;
8073       Kind                  : Source_Kind := Spec;
8074
8075    begin
8076       Name_Len := Display_Path'Length;
8077       Name_Buffer (1 .. Name_Len) := Display_Path;
8078       Display_Path_Id := Name_Find;
8079
8080       if Osint.File_Names_Case_Sensitive then
8081          Path_Id := Display_Path_Id;
8082       else
8083          Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
8084          Path_Id := Name_Find;
8085       end if;
8086
8087       if Name_Loc = No_Name_Location then
8088          Check_Name := For_All_Sources;
8089
8090       else
8091          if Name_Loc.Found then
8092
8093             --  Check if it is OK to have the same file name in several
8094             --  source directories.
8095
8096             if not Data.Known_Order_Of_Source_Dirs then
8097                Error_Msg_File_1 := File_Name;
8098                Error_Msg
8099                  (Project, In_Tree,
8100                   "{ is found in several source directories",
8101                   Name_Loc.Location);
8102             end if;
8103
8104          else
8105             Name_Loc.Found := True;
8106
8107             Source_Names.Set (File_Name, Name_Loc);
8108
8109             if Name_Loc.Source = No_Source then
8110                Check_Name := True;
8111
8112             else
8113                In_Tree.Sources.Table (Name_Loc.Source).Path :=
8114                  (Path_Id, Display_Path_Id);
8115
8116                Source_Paths_Htable.Set
8117                  (In_Tree.Source_Paths_HT,
8118                   Path_Id,
8119                   Name_Loc.Source);
8120
8121                --  Check if this is a subunit
8122
8123                if In_Tree.Sources.Table (Name_Loc.Source).Unit /= No_Name
8124                  and then
8125                    In_Tree.Sources.Table (Name_Loc.Source).Kind = Impl
8126                then
8127                   Src_Ind := Sinput.P.Load_Project_File
8128                     (Get_Name_String (Path_Id));
8129
8130                   if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
8131                      In_Tree.Sources.Table (Name_Loc.Source).Kind := Sep;
8132                   end if;
8133                end if;
8134             end if;
8135          end if;
8136       end if;
8137
8138       if Check_Name then
8139          Other_Part := No_Source;
8140
8141          Check_Naming_Schemes
8142            (In_Tree               => In_Tree,
8143             Data                  => Data,
8144             Filename              => Get_Name_String (File_Name),
8145             File_Name             => File_Name,
8146             Alternate_Languages   => Alternate_Languages,
8147             Language              => Language,
8148             Language_Name         => Language_Name,
8149             Display_Language_Name => Display_Language_Name,
8150             Unit                  => Unit,
8151             Lang_Kind             => Lang_Kind,
8152             Kind                  => Kind);
8153
8154          if Language = No_Language_Index then
8155
8156             --  A file name in a list must be a source of a language
8157
8158             if Name_Loc.Found then
8159                Error_Msg_File_1 := File_Name;
8160                Error_Msg
8161                  (Project,
8162                   In_Tree,
8163                   "language unknown for {",
8164                   Name_Loc.Location);
8165             end if;
8166
8167          else
8168             --  Check if the same file name or unit is used in the prj tree
8169
8170             Source := In_Tree.First_Source;
8171             Add_Src := True;
8172             while Source /= No_Source loop
8173                declare
8174                   Src_Data : Source_Data renames
8175                                In_Tree.Sources.Table (Source);
8176
8177                begin
8178                   if Unit /= No_Name
8179                     and then Src_Data.Unit = Unit
8180                     and then
8181                       ((Src_Data.Kind = Spec and then Kind = Impl)
8182                          or else
8183                        (Src_Data.Kind = Impl and then Kind = Spec))
8184                   then
8185                      Other_Part := Source;
8186
8187                   elsif (Unit /= No_Name
8188                          and then Src_Data.Unit = Unit
8189                          and then
8190                            (Src_Data.Kind = Kind
8191                              or else
8192                                (Src_Data.Kind = Sep  and then Kind = Impl)
8193                              or else
8194                                (Src_Data.Kind = Impl and then Kind = Sep)))
8195                     or else
8196                       (Unit = No_Name and then Src_Data.File = File_Name)
8197                   then
8198                      --  Duplication of file/unit in same project is only
8199                      --  allowed if order of source directories is known.
8200
8201                      if Project = Src_Data.Project then
8202                         if Data.Known_Order_Of_Source_Dirs then
8203                            Add_Src := False;
8204
8205                         elsif Unit /= No_Name then
8206                            Error_Msg_Name_1 := Unit;
8207                            Error_Msg
8208                              (Project, In_Tree, "duplicate unit %%",
8209                               No_Location);
8210                            Add_Src := False;
8211
8212                         else
8213                            Error_Msg_File_1 := File_Name;
8214                            Error_Msg
8215                              (Project, In_Tree, "duplicate source file name {",
8216                               No_Location);
8217                            Add_Src := False;
8218                         end if;
8219
8220                         --  Do not allow the same unit name in different
8221                         --  projects, except if one is extending the other.
8222
8223                         --  For a file based language, the same file name
8224                         --  replaces a file in a project being extended, but
8225                         --  it is allowed to have the same file name in
8226                         --  unrelated projects.
8227
8228                      elsif Is_Extending
8229                        (Project, Src_Data.Project, In_Tree)
8230                      then
8231                         Source_To_Replace := Source;
8232
8233                      elsif Unit /= No_Name
8234                        and then not Src_Data.Locally_Removed
8235                      then
8236                         Error_Msg_Name_1 := Unit;
8237                         Error_Msg
8238                           (Project, In_Tree,
8239                            "unit %% cannot belong to several projects",
8240                            No_Location);
8241
8242                         Error_Msg_Name_1 :=
8243                           In_Tree.Projects.Table (Project).Name;
8244                         Error_Msg_Name_2 := Name_Id (Display_Path_Id);
8245                         Error_Msg
8246                           (Project, In_Tree, "\  project %%, %%", No_Location);
8247
8248                         Error_Msg_Name_1 :=
8249                           In_Tree.Projects.Table (Src_Data.Project).Name;
8250                         Error_Msg_Name_2 :=
8251                           Name_Id (Src_Data.Path.Display_Name);
8252                         Error_Msg
8253                           (Project, In_Tree, "\  project %%, %%", No_Location);
8254
8255                         Add_Src := False;
8256                      end if;
8257                   end if;
8258
8259                   Source := Src_Data.Next_In_Sources;
8260                end;
8261             end loop;
8262
8263             if Add_Src then
8264                Add_Source
8265                  (Id                  => Source,
8266                   Data                => Data,
8267                   In_Tree             => In_Tree,
8268                   Project             => Project,
8269                   Lang                => Language_Name,
8270                   Lang_Id             => Language,
8271                   Lang_Kind           => Lang_Kind,
8272                   Kind                => Kind,
8273                   Alternate_Languages => Alternate_Languages,
8274                   File_Name           => File_Name,
8275                   Display_File        => Display_File_Name,
8276                   Other_Part          => Other_Part,
8277                   Unit                => Unit,
8278                   Path                => Path_Id,
8279                   Display_Path        => Display_Path_Id,
8280                   Source_To_Replace   => Source_To_Replace);
8281             end if;
8282          end if;
8283       end if;
8284    end Check_File;
8285
8286    ------------------------
8287    -- Search_Directories --
8288    ------------------------
8289
8290    procedure Search_Directories
8291      (Project         : Project_Id;
8292       In_Tree         : Project_Tree_Ref;
8293       Data            : in out Project_Data;
8294       For_All_Sources : Boolean)
8295    is
8296       Source_Dir        : String_List_Id;
8297       Element           : String_Element;
8298       Dir               : Dir_Type;
8299       Name              : String (1 .. 1_000);
8300       Last              : Natural;
8301       File_Name         : File_Name_Type;
8302       Display_File_Name : File_Name_Type;
8303
8304    begin
8305       if Current_Verbosity = High then
8306          Write_Line ("Looking for sources:");
8307       end if;
8308
8309       --  Loop through subdirectories
8310
8311       Source_Dir := Data.Source_Dirs;
8312       while Source_Dir /= Nil_String loop
8313          begin
8314             Element := In_Tree.String_Elements.Table (Source_Dir);
8315             if Element.Value /= No_Name then
8316                Get_Name_String (Element.Display_Value);
8317
8318                declare
8319                   Source_Directory : constant String :=
8320                                        Name_Buffer (1 .. Name_Len) &
8321                                          Directory_Separator;
8322
8323                   Dir_Last : constant Natural :=
8324                                        Compute_Directory_Last
8325                                          (Source_Directory);
8326
8327                begin
8328                   if Current_Verbosity = High then
8329                      Write_Str ("Source_Dir = ");
8330                      Write_Line (Source_Directory);
8331                   end if;
8332
8333                   --  We look to every entry in the source directory
8334
8335                   Open (Dir, Source_Directory);
8336
8337                   loop
8338                      Read (Dir, Name, Last);
8339
8340                      exit when Last = 0;
8341
8342                      --  ??? Duplicate system call here, we just did a
8343                      --  a similar one. Maybe Ada.Directories would be more
8344                      --  appropriate here
8345
8346                      if Is_Regular_File
8347                        (Source_Directory & Name (1 .. Last))
8348                      then
8349                         if Current_Verbosity = High then
8350                            Write_Str  ("   Checking ");
8351                            Write_Line (Name (1 .. Last));
8352                         end if;
8353
8354                         Name_Len := Last;
8355                         Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
8356                         Display_File_Name := Name_Find;
8357
8358                         if Osint.File_Names_Case_Sensitive then
8359                            File_Name := Display_File_Name;
8360                         else
8361                            Canonical_Case_File_Name
8362                              (Name_Buffer (1 .. Name_Len));
8363                            File_Name := Name_Find;
8364                         end if;
8365
8366                         declare
8367                            FF : File_Found :=
8368                                   Excluded_Sources_Htable.Get (File_Name);
8369
8370                         begin
8371                            if FF /= No_File_Found then
8372                               if not FF.Found then
8373                                  FF.Found := True;
8374                                  Excluded_Sources_Htable.Set
8375                                    (File_Name, FF);
8376
8377                                  if Current_Verbosity = High then
8378                                     Write_Str ("     excluded source """);
8379                                     Write_Str (Get_Name_String (File_Name));
8380                                     Write_Line ("""");
8381                                  end if;
8382                               end if;
8383
8384                            else
8385                               Check_File
8386                                 (Project           => Project,
8387                                  In_Tree           => In_Tree,
8388                                  Data              => Data,
8389                                  Name              => Name (1 .. Last),
8390                                  File_Name         => File_Name,
8391                                  Display_File_Name => Display_File_Name,
8392                                  Source_Directory  => Source_Directory
8393                                    (Source_Directory'First .. Dir_Last),
8394                                  For_All_Sources   => For_All_Sources);
8395                            end if;
8396                         end;
8397                      end if;
8398                   end loop;
8399
8400                   Close (Dir);
8401                end;
8402             end if;
8403
8404          exception
8405             when Directory_Error =>
8406                null;
8407          end;
8408
8409          Source_Dir := Element.Next;
8410       end loop;
8411
8412       if Current_Verbosity = High then
8413          Write_Line ("end Looking for sources.");
8414       end if;
8415    end Search_Directories;
8416
8417    ----------------------
8418    -- Look_For_Sources --
8419    ----------------------
8420
8421    procedure Look_For_Sources
8422      (Project     : Project_Id;
8423       In_Tree     : Project_Tree_Ref;
8424       Data        : in out Project_Data;
8425       Current_Dir : String)
8426    is
8427       procedure Remove_Locally_Removed_Files_From_Units;
8428       --  Mark all locally removed sources as such in the Units table
8429
8430       procedure Process_Sources_In_Multi_Language_Mode;
8431       --  Find all source files when in multi language mode
8432
8433       ---------------------------------------------
8434       -- Remove_Locally_Removed_Files_From_Units --
8435       ---------------------------------------------
8436
8437       procedure Remove_Locally_Removed_Files_From_Units is
8438          Excluded : File_Found;
8439          OK       : Boolean;
8440          Unit     : Unit_Data;
8441          Extended : Project_Id;
8442
8443       begin
8444          Excluded := Excluded_Sources_Htable.Get_First;
8445          while Excluded /= No_File_Found loop
8446             OK := False;
8447
8448             For_Each_Unit :
8449             for Index in Unit_Table.First ..
8450               Unit_Table.Last (In_Tree.Units)
8451             loop
8452                Unit := In_Tree.Units.Table (Index);
8453
8454                for Kind in Spec_Or_Body'Range loop
8455                   if Unit.File_Names (Kind).Name = Excluded.File then
8456                      OK := True;
8457
8458                      --  Check that this is from the current project or
8459                      --  that the current project extends.
8460
8461                      Extended := Unit.File_Names (Kind).Project;
8462
8463                      if Extended = Project
8464                        or else Project_Extends (Project, Extended, In_Tree)
8465                      then
8466                         Unit.File_Names (Kind).Path.Name := Slash;
8467                         Unit.File_Names (Kind).Needs_Pragma := False;
8468                         In_Tree.Units.Table (Index) := Unit;
8469                         Add_Forbidden_File_Name
8470                           (Unit.File_Names (Kind).Name);
8471                      else
8472                         Error_Msg
8473                           (Project, In_Tree,
8474                            "cannot remove a source from " &
8475                            "another project",
8476                            Excluded.Location);
8477                      end if;
8478                      exit For_Each_Unit;
8479                   end if;
8480                end loop;
8481             end loop For_Each_Unit;
8482
8483             if not OK then
8484                Err_Vars.Error_Msg_File_1 := Excluded.File;
8485                Error_Msg
8486                  (Project, In_Tree, "unknown file {", Excluded.Location);
8487             end if;
8488
8489             Excluded := Excluded_Sources_Htable.Get_Next;
8490          end loop;
8491       end Remove_Locally_Removed_Files_From_Units;
8492
8493       --------------------------------------------
8494       -- Process_Sources_In_Multi_Language_Mode --
8495       --------------------------------------------
8496
8497       procedure Process_Sources_In_Multi_Language_Mode is
8498          Source   : Source_Id;
8499          Name_Loc : Name_Location;
8500          OK       : Boolean;
8501          FF       : File_Found;
8502
8503       begin
8504          --  First, put all naming exceptions if any, in the Source_Names table
8505
8506          Unit_Exceptions.Reset;
8507
8508          Source := Data.First_Source;
8509          while Source /= No_Source loop
8510             declare
8511                Src_Data : Source_Data renames In_Tree.Sources.Table (Source);
8512
8513             begin
8514                --  An excluded file cannot also be an exception file name
8515
8516                if Excluded_Sources_Htable.Get (Src_Data.File) /=
8517                  No_File_Found
8518                then
8519                   Error_Msg_File_1 := Src_Data.File;
8520                   Error_Msg
8521                     (Project, In_Tree,
8522                      "{ cannot be both excluded and an exception file name",
8523                      No_Location);
8524                end if;
8525
8526                Name_Loc := (Name     => Src_Data.File,
8527                             Location => No_Location,
8528                             Source   => Source,
8529                             Except   => Src_Data.Unit /= No_Name,
8530                             Found    => False);
8531
8532                if Current_Verbosity = High then
8533                   Write_Str ("Putting source #");
8534                   Write_Str (Source'Img);
8535                   Write_Str (", file ");
8536                   Write_Str (Get_Name_String (Src_Data.File));
8537                   Write_Line (" in Source_Names");
8538                end if;
8539
8540                Source_Names.Set (K => Src_Data.File, E => Name_Loc);
8541
8542                --  If this is an Ada exception, record in table Unit_Exceptions
8543
8544                if Src_Data.Unit /= No_Name then
8545                   declare
8546                      Unit_Except : Unit_Exception :=
8547                                      Unit_Exceptions.Get (Src_Data.Unit);
8548
8549                   begin
8550                      Unit_Except.Name := Src_Data.Unit;
8551
8552                      if Src_Data.Kind = Spec then
8553                         Unit_Except.Spec := Src_Data.File;
8554                      else
8555                         Unit_Except.Impl := Src_Data.File;
8556                      end if;
8557
8558                      Unit_Exceptions.Set (Src_Data.Unit, Unit_Except);
8559                   end;
8560                end if;
8561
8562                Source := Src_Data.Next_In_Project;
8563             end;
8564          end loop;
8565
8566          Find_Explicit_Sources
8567            (Current_Dir, Project, In_Tree, Data);
8568
8569          --  Mark as such the sources that are declared as excluded
8570
8571          FF := Excluded_Sources_Htable.Get_First;
8572          while FF /= No_File_Found loop
8573             OK     := False;
8574             Source := In_Tree.First_Source;
8575             while Source /= No_Source loop
8576                declare
8577                   Src_Data : Source_Data renames
8578                                In_Tree.Sources.Table (Source);
8579
8580                begin
8581                   if Src_Data.File = FF.File then
8582
8583                      --  Check that this is from this project or a project that
8584                      --  the current project extends.
8585
8586                      if Src_Data.Project = Project or else
8587                        Is_Extending (Project, Src_Data.Project, In_Tree)
8588                      then
8589                         Src_Data.Locally_Removed := True;
8590                         Src_Data.In_Interfaces := False;
8591                         Add_Forbidden_File_Name (FF.File);
8592                         OK := True;
8593                         exit;
8594                      end if;
8595                   end if;
8596
8597                   Source := Src_Data.Next_In_Sources;
8598                end;
8599             end loop;
8600
8601             if not FF.Found and not OK then
8602                Err_Vars.Error_Msg_File_1 := FF.File;
8603                Error_Msg (Project, In_Tree, "unknown file {", FF.Location);
8604             end if;
8605
8606             FF := Excluded_Sources_Htable.Get_Next;
8607          end loop;
8608
8609          --  Check that two sources of this project do not have the same object
8610          --  file name.
8611
8612          Check_Object_File_Names : declare
8613             Src_Id      : Source_Id;
8614             Source_Name : File_Name_Type;
8615
8616             procedure Check_Object (Src_Data : Source_Data);
8617             --  Check if object file name of the current source is already in
8618             --  hash table Object_File_Names. If it is, report an error. If it
8619             --  is not, put it there with the file name of the current source.
8620
8621             ------------------
8622             -- Check_Object --
8623             ------------------
8624
8625             procedure Check_Object (Src_Data : Source_Data) is
8626             begin
8627                Source_Name := Object_File_Names.Get (Src_Data.Object);
8628
8629                if Source_Name /= No_File then
8630                   Error_Msg_File_1 := Src_Data.File;
8631                   Error_Msg_File_2 := Source_Name;
8632                   Error_Msg
8633                     (Project,
8634                      In_Tree,
8635                      "{ and { have the same object file name",
8636                      No_Location);
8637
8638                else
8639                   Object_File_Names.Set (Src_Data.Object, Src_Data.File);
8640                end if;
8641             end Check_Object;
8642
8643          --  Start of processing for Check_Object_File_Names
8644
8645          begin
8646             Object_File_Names.Reset;
8647             Src_Id := In_Tree.First_Source;
8648             while Src_Id /= No_Source loop
8649                declare
8650                   Src_Data : Source_Data renames
8651                                In_Tree.Sources.Table (Src_Id);
8652
8653                begin
8654                   if Src_Data.Compiled and then Src_Data.Object_Exists
8655                     and then Project_Extends
8656                                (Project, Src_Data.Project, In_Tree)
8657                   then
8658                      if Src_Data.Unit = No_Name then
8659                         if Src_Data.Kind = Impl then
8660                            Check_Object (Src_Data);
8661                         end if;
8662
8663                      else
8664                         case Src_Data.Kind is
8665                            when Spec =>
8666                               if Src_Data.Other_Part = No_Source then
8667                                  Check_Object (Src_Data);
8668                               end if;
8669
8670                            when Sep =>
8671                               null;
8672
8673                            when Impl =>
8674                               if Src_Data.Other_Part /= No_Source then
8675                                  Check_Object (Src_Data);
8676
8677                               else
8678                                  --  Check if it is a subunit
8679
8680                                  declare
8681                                     Src_Ind : constant Source_File_Index :=
8682                                                 Sinput.P.Load_Project_File
8683                                                  (Get_Name_String
8684                                                    (Src_Data.Path.Name));
8685                                  begin
8686                                     if Sinput.P.Source_File_Is_Subunit
8687                                       (Src_Ind)
8688                                     then
8689                                        In_Tree.Sources.Table (Src_Id).Kind :=
8690                                          Sep;
8691                                     else
8692                                        Check_Object (Src_Data);
8693                                     end if;
8694                                  end;
8695                               end if;
8696                         end case;
8697                      end if;
8698                   end if;
8699
8700                   Src_Id := Src_Data.Next_In_Sources;
8701                end;
8702             end loop;
8703          end Check_Object_File_Names;
8704       end Process_Sources_In_Multi_Language_Mode;
8705
8706    --  Start of processing for Look_For_Sources
8707
8708    begin
8709       Source_Names.Reset;
8710       Find_Excluded_Sources (Project, In_Tree, Data);
8711
8712       case Get_Mode is
8713          when Ada_Only =>
8714             if Is_A_Language (In_Tree, Data, Name_Ada) then
8715                Find_Explicit_Sources (Current_Dir, Project, In_Tree, Data);
8716                Remove_Locally_Removed_Files_From_Units;
8717             end if;
8718
8719          when Multi_Language =>
8720             if Data.First_Language_Processing /= No_Language_Index then
8721                Process_Sources_In_Multi_Language_Mode;
8722             end if;
8723       end case;
8724    end Look_For_Sources;
8725
8726    ------------------
8727    -- Path_Name_Of --
8728    ------------------
8729
8730    function Path_Name_Of
8731      (File_Name : File_Name_Type;
8732       Directory : Path_Name_Type) return String
8733    is
8734       Result        : String_Access;
8735       The_Directory : constant String := Get_Name_String (Directory);
8736
8737    begin
8738       Get_Name_String (File_Name);
8739       Result :=
8740         Locate_Regular_File
8741           (File_Name => Name_Buffer (1 .. Name_Len),
8742            Path      => The_Directory);
8743
8744       if Result = null then
8745          return "";
8746       else
8747          Canonical_Case_File_Name (Result.all);
8748          return Result.all;
8749       end if;
8750    end Path_Name_Of;
8751
8752    -------------------------------
8753    -- Prepare_Ada_Naming_Exceptions --
8754    -------------------------------
8755
8756    procedure Prepare_Ada_Naming_Exceptions
8757      (List    : Array_Element_Id;
8758       In_Tree : Project_Tree_Ref;
8759       Kind    : Spec_Or_Body)
8760    is
8761       Current : Array_Element_Id;
8762       Element : Array_Element;
8763       Unit    : Unit_Info;
8764
8765    begin
8766       --  Traverse the list
8767
8768       Current := List;
8769       while Current /= No_Array_Element loop
8770          Element := In_Tree.Array_Elements.Table (Current);
8771
8772          if Element.Index /= No_Name then
8773             Unit :=
8774               (Kind => Kind,
8775                Unit => Element.Index,
8776                Next => No_Ada_Naming_Exception);
8777             Reverse_Ada_Naming_Exceptions.Set
8778               (Unit, (Element.Value.Value, Element.Value.Index));
8779             Unit.Next :=
8780               Ada_Naming_Exceptions.Get (File_Name_Type (Element.Value.Value));
8781             Ada_Naming_Exception_Table.Increment_Last;
8782             Ada_Naming_Exception_Table.Table
8783               (Ada_Naming_Exception_Table.Last) := Unit;
8784             Ada_Naming_Exceptions.Set
8785               (File_Name_Type (Element.Value.Value),
8786                Ada_Naming_Exception_Table.Last);
8787          end if;
8788
8789          Current := Element.Next;
8790       end loop;
8791    end Prepare_Ada_Naming_Exceptions;
8792
8793    ---------------------
8794    -- Project_Extends --
8795    ---------------------
8796
8797    function Project_Extends
8798      (Extending : Project_Id;
8799       Extended  : Project_Id;
8800       In_Tree   : Project_Tree_Ref) return Boolean
8801    is
8802       Current : Project_Id := Extending;
8803
8804    begin
8805       loop
8806          if Current = No_Project then
8807             return False;
8808
8809          elsif Current = Extended then
8810             return True;
8811          end if;
8812
8813          Current := In_Tree.Projects.Table (Current).Extends;
8814       end loop;
8815    end Project_Extends;
8816
8817    -----------------------
8818    -- Record_Ada_Source --
8819    -----------------------
8820
8821    procedure Record_Ada_Source
8822      (File_Name       : File_Name_Type;
8823       Path_Name       : Path_Name_Type;
8824       Project         : Project_Id;
8825       In_Tree         : Project_Tree_Ref;
8826       Data            : in out Project_Data;
8827       Location        : Source_Ptr;
8828       Current_Source  : in out String_List_Id;
8829       Source_Recorded : in out Boolean;
8830       Current_Dir     : String)
8831    is
8832       Canonical_File_Name : File_Name_Type;
8833       Canonical_Path_Name : Path_Name_Type;
8834
8835       Exception_Id : Ada_Naming_Exception_Id;
8836       Unit_Name    : Name_Id;
8837       Unit_Kind    : Spec_Or_Body;
8838       Unit_Ind     : Int := 0;
8839       Info         : Unit_Info;
8840       Name_Index   : Name_And_Index;
8841       Needs_Pragma : Boolean;
8842
8843       The_Location    : Source_Ptr              := Location;
8844       Previous_Source : constant String_List_Id := Current_Source;
8845       Except_Name     : Name_And_Index          := No_Name_And_Index;
8846
8847       Unit_Prj : Unit_Project;
8848
8849       File_Name_Recorded : Boolean := False;
8850
8851    begin
8852       if Osint.File_Names_Case_Sensitive then
8853          Canonical_File_Name := File_Name;
8854          Canonical_Path_Name := Path_Name;
8855       else
8856          Get_Name_String (File_Name);
8857          Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
8858          Canonical_File_Name := Name_Find;
8859
8860          declare
8861             Canonical_Path : constant String :=
8862                                Normalize_Pathname
8863                                  (Get_Name_String (Path_Name),
8864                                   Directory      => Current_Dir,
8865                                   Resolve_Links  => Opt.Follow_Links_For_Files,
8866                                   Case_Sensitive => False);
8867          begin
8868             Name_Len := 0;
8869             Add_Str_To_Name_Buffer (Canonical_Path);
8870             Canonical_Path_Name := Name_Find;
8871          end;
8872       end if;
8873
8874       --  Find out the unit name, the unit kind and if it needs
8875       --  a specific SFN pragma.
8876
8877       Get_Unit
8878         (In_Tree             => In_Tree,
8879          Canonical_File_Name => Canonical_File_Name,
8880          Naming              => Data.Naming,
8881          Exception_Id        => Exception_Id,
8882          Unit_Name           => Unit_Name,
8883          Unit_Kind           => Unit_Kind,
8884          Needs_Pragma        => Needs_Pragma);
8885
8886       if Exception_Id = No_Ada_Naming_Exception
8887         and then Unit_Name = No_Name
8888       then
8889          if Current_Verbosity = High then
8890             Write_Str  ("   """);
8891             Write_Str  (Get_Name_String (Canonical_File_Name));
8892             Write_Line (""" is not a valid source file name (ignored).");
8893          end if;
8894
8895       else
8896          --  Check to see if the source has been hidden by an exception,
8897          --  but only if it is not an exception.
8898
8899          if not Needs_Pragma then
8900             Except_Name :=
8901               Reverse_Ada_Naming_Exceptions.Get
8902                 ((Unit_Kind, Unit_Name, No_Ada_Naming_Exception));
8903
8904             if Except_Name /= No_Name_And_Index then
8905                if Current_Verbosity = High then
8906                   Write_Str  ("   """);
8907                   Write_Str  (Get_Name_String (Canonical_File_Name));
8908                   Write_Str  (""" contains a unit that is found in """);
8909                   Write_Str  (Get_Name_String (Except_Name.Name));
8910                   Write_Line (""" (ignored).");
8911                end if;
8912
8913                --  The file is not included in the source of the project since
8914                --  it is hidden by the exception. So, nothing else to do.
8915
8916                return;
8917             end if;
8918          end if;
8919
8920          loop
8921             if Exception_Id /= No_Ada_Naming_Exception then
8922                Info := Ada_Naming_Exception_Table.Table (Exception_Id);
8923                Exception_Id := Info.Next;
8924                Info.Next := No_Ada_Naming_Exception;
8925                Name_Index := Reverse_Ada_Naming_Exceptions.Get (Info);
8926
8927                Unit_Name := Info.Unit;
8928                Unit_Ind  := Name_Index.Index;
8929                Unit_Kind := Info.Kind;
8930             end if;
8931
8932             --  Put the file name in the list of sources of the project
8933
8934             String_Element_Table.Increment_Last (In_Tree.String_Elements);
8935             In_Tree.String_Elements.Table
8936               (String_Element_Table.Last (In_Tree.String_Elements)) :=
8937                 (Value         => Name_Id (Canonical_File_Name),
8938                  Display_Value => Name_Id (File_Name),
8939                  Location      => No_Location,
8940                  Flag          => False,
8941                  Next          => Nil_String,
8942                  Index         => Unit_Ind);
8943
8944             if Current_Source = Nil_String then
8945                Data.Ada_Sources :=
8946                  String_Element_Table.Last (In_Tree.String_Elements);
8947             else
8948                In_Tree.String_Elements.Table (Current_Source).Next :=
8949                  String_Element_Table.Last (In_Tree.String_Elements);
8950             end if;
8951
8952             Current_Source :=
8953               String_Element_Table.Last (In_Tree.String_Elements);
8954
8955             --  Put the unit in unit list
8956
8957             declare
8958                The_Unit : Unit_Index :=
8959                             Units_Htable.Get (In_Tree.Units_HT, Unit_Name);
8960
8961                The_Unit_Data : Unit_Data;
8962
8963             begin
8964                if Current_Verbosity = High then
8965                   Write_Str  ("Putting ");
8966                   Write_Str  (Get_Name_String (Unit_Name));
8967                   Write_Line (" in the unit list.");
8968                end if;
8969
8970                --  The unit is already in the list, but may be it is
8971                --  only the other unit kind (spec or body), or what is
8972                --  in the unit list is a unit of a project we are extending.
8973
8974                if The_Unit /= No_Unit_Index then
8975                   The_Unit_Data := In_Tree.Units.Table (The_Unit);
8976
8977                   if (The_Unit_Data.File_Names (Unit_Kind).Name =
8978                                                           Canonical_File_Name
8979                         and then
8980                         The_Unit_Data.File_Names
8981                           (Unit_Kind).Path.Name = Slash)
8982                     or else The_Unit_Data.File_Names (Unit_Kind).Name = No_File
8983                     or else Project_Extends
8984                       (Data.Extends,
8985                        The_Unit_Data.File_Names (Unit_Kind).Project,
8986                        In_Tree)
8987                   then
8988                      if
8989                        The_Unit_Data.File_Names (Unit_Kind).Path.Name = Slash
8990                      then
8991                         Remove_Forbidden_File_Name
8992                           (The_Unit_Data.File_Names (Unit_Kind).Name);
8993                      end if;
8994
8995                      --  Record the file name in the hash table Files_Htable
8996
8997                      Unit_Prj := (Unit => The_Unit, Project => Project);
8998                      Files_Htable.Set
8999                        (In_Tree.Files_HT,
9000                         Canonical_File_Name,
9001                         Unit_Prj);
9002
9003                      The_Unit_Data.File_Names (Unit_Kind) :=
9004                        (Name         => Canonical_File_Name,
9005                         Index        => Unit_Ind,
9006                         Display_Name => File_Name,
9007                         Path         => (Canonical_Path_Name, Path_Name),
9008                         Project      => Project,
9009                         Needs_Pragma => Needs_Pragma);
9010                      In_Tree.Units.Table (The_Unit) := The_Unit_Data;
9011                      Source_Recorded := True;
9012
9013                   elsif The_Unit_Data.File_Names (Unit_Kind).Project = Project
9014                     and then (Data.Known_Order_Of_Source_Dirs
9015                                 or else
9016                                 The_Unit_Data.File_Names
9017                                   (Unit_Kind).Path.Name = Canonical_Path_Name)
9018                   then
9019                      if Previous_Source = Nil_String then
9020                         Data.Ada_Sources := Nil_String;
9021                      else
9022                         In_Tree.String_Elements.Table (Previous_Source).Next :=
9023                           Nil_String;
9024                         String_Element_Table.Decrement_Last
9025                           (In_Tree.String_Elements);
9026                      end if;
9027
9028                      Current_Source := Previous_Source;
9029
9030                   else
9031                      --  It is an error to have two units with the same name
9032                      --  and the same kind (spec or body).
9033
9034                      if The_Location = No_Location then
9035                         The_Location :=
9036                           In_Tree.Projects.Table (Project).Location;
9037                      end if;
9038
9039                      Err_Vars.Error_Msg_Name_1 := Unit_Name;
9040                      Error_Msg
9041                        (Project, In_Tree, "duplicate unit %%", The_Location);
9042
9043                      Err_Vars.Error_Msg_Name_1 :=
9044                        In_Tree.Projects.Table
9045                          (The_Unit_Data.File_Names (Unit_Kind).Project).Name;
9046                      Err_Vars.Error_Msg_File_1 :=
9047                        File_Name_Type
9048                          (The_Unit_Data.File_Names (Unit_Kind).Path.Name);
9049                      Error_Msg
9050                        (Project, In_Tree,
9051                         "\   project file %%, {", The_Location);
9052
9053                      Err_Vars.Error_Msg_Name_1 :=
9054                        In_Tree.Projects.Table (Project).Name;
9055                      Err_Vars.Error_Msg_File_1 :=
9056                        File_Name_Type (Canonical_Path_Name);
9057                      Error_Msg
9058                        (Project, In_Tree,
9059                         "\   project file %%, {", The_Location);
9060                   end if;
9061
9062                --  It is a new unit, create a new record
9063
9064                else
9065                   --  First, check if there is no other unit with this file
9066                   --  name in another project. If it is, report error but note
9067                   --  we do that only for the first unit in the source file.
9068
9069                   Unit_Prj :=
9070                     Files_Htable.Get (In_Tree.Files_HT, Canonical_File_Name);
9071
9072                   if not File_Name_Recorded and then
9073                     Unit_Prj /= No_Unit_Project
9074                   then
9075                      Error_Msg_File_1 := File_Name;
9076                      Error_Msg_Name_1 :=
9077                        In_Tree.Projects.Table (Unit_Prj.Project).Name;
9078                      Error_Msg
9079                        (Project, In_Tree,
9080                         "{ is already a source of project %%",
9081                         Location);
9082
9083                   else
9084                      Unit_Table.Increment_Last (In_Tree.Units);
9085                      The_Unit := Unit_Table.Last (In_Tree.Units);
9086                      Units_Htable.Set
9087                        (In_Tree.Units_HT, Unit_Name, The_Unit);
9088                      Unit_Prj := (Unit => The_Unit, Project => Project);
9089                      Files_Htable.Set
9090                        (In_Tree.Files_HT,
9091                         Canonical_File_Name,
9092                         Unit_Prj);
9093                      The_Unit_Data.Name := Unit_Name;
9094                      The_Unit_Data.File_Names (Unit_Kind) :=
9095                        (Name         => Canonical_File_Name,
9096                         Index        => Unit_Ind,
9097                         Display_Name => File_Name,
9098                         Path         => (Canonical_Path_Name, Path_Name),
9099                         Project      => Project,
9100                         Needs_Pragma => Needs_Pragma);
9101                      In_Tree.Units.Table (The_Unit) := The_Unit_Data;
9102                      Source_Recorded := True;
9103                   end if;
9104                end if;
9105             end;
9106
9107             exit when Exception_Id = No_Ada_Naming_Exception;
9108             File_Name_Recorded := True;
9109          end loop;
9110       end if;
9111    end Record_Ada_Source;
9112
9113    -------------------
9114    -- Remove_Source --
9115    -------------------
9116
9117    procedure Remove_Source
9118      (Id          : Source_Id;
9119       Replaced_By : Source_Id;
9120       Project     : Project_Id;
9121       Data        : in out Project_Data;
9122       In_Tree     : Project_Tree_Ref)
9123    is
9124       Src_Data : constant Source_Data := In_Tree.Sources.Table (Id);
9125       Source   : Source_Id;
9126
9127    begin
9128       if Current_Verbosity = High then
9129          Write_Str ("Removing source #");
9130          Write_Line (Id'Img);
9131       end if;
9132
9133       if Replaced_By /= No_Source then
9134          In_Tree.Sources.Table (Id).Replaced_By := Replaced_By;
9135          In_Tree.Sources.Table (Replaced_By).Declared_In_Interfaces :=
9136            In_Tree.Sources.Table (Id).Declared_In_Interfaces;
9137       end if;
9138
9139       --  Remove the source from the global source list
9140
9141       Source := In_Tree.First_Source;
9142
9143       if Source = Id then
9144          In_Tree.First_Source := Src_Data.Next_In_Sources;
9145
9146       else
9147          while In_Tree.Sources.Table (Source).Next_In_Sources /= Id loop
9148             Source := In_Tree.Sources.Table (Source).Next_In_Sources;
9149          end loop;
9150
9151          In_Tree.Sources.Table (Source).Next_In_Sources :=
9152            Src_Data.Next_In_Sources;
9153       end if;
9154
9155       --  Remove the source from the project list
9156
9157       if Src_Data.Project = Project then
9158          Source := Data.First_Source;
9159
9160          if Source = Id then
9161             Data.First_Source := Src_Data.Next_In_Project;
9162
9163             if Src_Data.Next_In_Project = No_Source then
9164                Data.Last_Source := No_Source;
9165             end if;
9166
9167          else
9168             while In_Tree.Sources.Table (Source).Next_In_Project /= Id loop
9169                Source := In_Tree.Sources.Table (Source).Next_In_Project;
9170             end loop;
9171
9172             In_Tree.Sources.Table (Source).Next_In_Project :=
9173               Src_Data.Next_In_Project;
9174
9175             if Src_Data.Next_In_Project = No_Source then
9176                In_Tree.Projects.Table (Src_Data.Project).Last_Source := Source;
9177             end if;
9178          end if;
9179
9180       else
9181          Source := In_Tree.Projects.Table (Src_Data.Project).First_Source;
9182
9183          if Source = Id then
9184             In_Tree.Projects.Table (Src_Data.Project).First_Source :=
9185               Src_Data.Next_In_Project;
9186
9187             if Src_Data.Next_In_Project = No_Source then
9188                In_Tree.Projects.Table (Src_Data.Project).Last_Source :=
9189                  No_Source;
9190             end if;
9191
9192          else
9193             while In_Tree.Sources.Table (Source).Next_In_Project /= Id loop
9194                Source := In_Tree.Sources.Table (Source).Next_In_Project;
9195             end loop;
9196
9197             In_Tree.Sources.Table (Source).Next_In_Project :=
9198               Src_Data.Next_In_Project;
9199
9200             if Src_Data.Next_In_Project = No_Source then
9201                In_Tree.Projects.Table (Src_Data.Project).Last_Source := Source;
9202             end if;
9203          end if;
9204       end if;
9205
9206       --  Remove source from the language list
9207
9208       Source := In_Tree.Languages_Data.Table (Src_Data.Language).First_Source;
9209
9210       if Source = Id then
9211          In_Tree.Languages_Data.Table (Src_Data.Language).First_Source :=
9212            Src_Data.Next_In_Lang;
9213
9214       else
9215          while In_Tree.Sources.Table (Source).Next_In_Lang /= Id loop
9216             Source := In_Tree.Sources.Table (Source).Next_In_Lang;
9217          end loop;
9218
9219          In_Tree.Sources.Table (Source).Next_In_Lang :=
9220            Src_Data.Next_In_Lang;
9221       end if;
9222    end Remove_Source;
9223
9224    -----------------------
9225    -- Report_No_Sources --
9226    -----------------------
9227
9228    procedure Report_No_Sources
9229      (Project      : Project_Id;
9230       Lang_Name    : String;
9231       In_Tree      : Project_Tree_Ref;
9232       Location     : Source_Ptr;
9233       Continuation : Boolean := False)
9234    is
9235    begin
9236       case When_No_Sources is
9237          when Silent =>
9238             null;
9239
9240          when Warning | Error =>
9241             declare
9242                Msg : constant String :=
9243                        "<there are no " &
9244                        Lang_Name &
9245                        " sources in this project";
9246
9247             begin
9248                Error_Msg_Warn := When_No_Sources = Warning;
9249
9250                if Continuation then
9251                   Error_Msg
9252                     (Project, In_Tree, "\" & Msg, Location);
9253
9254                else
9255                   Error_Msg
9256                     (Project, In_Tree, Msg, Location);
9257                end if;
9258             end;
9259       end case;
9260    end Report_No_Sources;
9261
9262    ----------------------
9263    -- Show_Source_Dirs --
9264    ----------------------
9265
9266    procedure Show_Source_Dirs
9267      (Data    : Project_Data;
9268       In_Tree : Project_Tree_Ref)
9269    is
9270       Current : String_List_Id;
9271       Element : String_Element;
9272
9273    begin
9274       Write_Line ("Source_Dirs:");
9275
9276       Current := Data.Source_Dirs;
9277       while Current /= Nil_String loop
9278          Element := In_Tree.String_Elements.Table (Current);
9279          Write_Str  ("   ");
9280          Write_Line (Get_Name_String (Element.Value));
9281          Current := Element.Next;
9282       end loop;
9283
9284       Write_Line ("end Source_Dirs.");
9285    end Show_Source_Dirs;
9286
9287    -------------------------
9288    -- Warn_If_Not_Sources --
9289    -------------------------
9290
9291    --  comments needed in this body ???
9292
9293    procedure Warn_If_Not_Sources
9294      (Project     : Project_Id;
9295       In_Tree     : Project_Tree_Ref;
9296       Conventions : Array_Element_Id;
9297       Specs       : Boolean;
9298       Extending   : Boolean)
9299    is
9300       Conv          : Array_Element_Id;
9301       Unit          : Name_Id;
9302       The_Unit_Id   : Unit_Index;
9303       The_Unit_Data : Unit_Data;
9304       Location      : Source_Ptr;
9305
9306    begin
9307       Conv := Conventions;
9308       while Conv /= No_Array_Element loop
9309          Unit := In_Tree.Array_Elements.Table (Conv).Index;
9310          Error_Msg_Name_1 := Unit;
9311          Get_Name_String (Unit);
9312          To_Lower (Name_Buffer (1 .. Name_Len));
9313          Unit := Name_Find;
9314          The_Unit_Id := Units_Htable.Get (In_Tree.Units_HT, Unit);
9315          Location := In_Tree.Array_Elements.Table (Conv).Value.Location;
9316
9317          if The_Unit_Id = No_Unit_Index then
9318             Error_Msg (Project, In_Tree, "?unknown unit %%", Location);
9319
9320          else
9321             The_Unit_Data := In_Tree.Units.Table (The_Unit_Id);
9322             Error_Msg_Name_2 :=
9323               In_Tree.Array_Elements.Table (Conv).Value.Value;
9324
9325             if Specs then
9326                if not Check_Project
9327                  (The_Unit_Data.File_Names (Specification).Project,
9328                   Project, In_Tree, Extending)
9329                then
9330                   Error_Msg
9331                     (Project, In_Tree,
9332                      "?source of spec of unit %% (%%)" &
9333                      " cannot be found in this project",
9334                      Location);
9335                end if;
9336
9337             else
9338                if not Check_Project
9339                  (The_Unit_Data.File_Names (Body_Part).Project,
9340                   Project, In_Tree, Extending)
9341                then
9342                   Error_Msg
9343                     (Project, In_Tree,
9344                      "?source of body of unit %% (%%)" &
9345                      " cannot be found in this project",
9346                      Location);
9347                end if;
9348             end if;
9349          end if;
9350
9351          Conv := In_Tree.Array_Elements.Table (Conv).Next;
9352       end loop;
9353    end Warn_If_Not_Sources;
9354
9355 end Prj.Nmsc;