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