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