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