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