gcc/ada/prj-nmsc.adb

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