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-2005, 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 Err_Vars; use Err_Vars;
  28 with Fmap;     use Fmap;
  29 with Hostparm;
  30 with MLib.Tgt;
  31 with Namet;    use Namet;
  32 with Osint;    use Osint;
  33 with Output;   use Output;
  34 with MLib.Tgt; use MLib.Tgt;
  35 with Prj.Env;  use Prj.Env;
  36 with Prj.Err;
  37 with Prj.Util; use Prj.Util;
  38 with Sinput.P;
  39 with Snames;   use Snames;
  40 with Table;    use Table;
  41
  42 with Ada.Characters.Handling;    use Ada.Characters.Handling;
  43 with Ada.Strings;                use Ada.Strings;
  44 with Ada.Strings.Fixed;          use Ada.Strings.Fixed;
  45 with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
  46
  47 with GNAT.Case_Util;             use GNAT.Case_Util;
  48 with GNAT.Directory_Operations;  use GNAT.Directory_Operations;
  49 with GNAT.HTable;
  50
  51 package body Prj.Nmsc is
  52
  53    Error_Report : Put_Line_Access := null;
  54    --  Set to point to error reporting procedure
  55
  56    ALI_Suffix   : constant String := ".ali";
  57    --  File suffix for ali files
  58
  59    Object_Suffix : constant String := Get_Object_Suffix.all;
  60    --  File suffix for object files
  61
  62    type Name_Location is record
  63       Name     : Name_Id;
  64       Location : Source_Ptr;
  65       Found    : Boolean := False;
  66    end record;
  67    --  Information about file names found in string list attribute
  68    --  Source_Files or in a source list file, stored in hash table
  69    --  Source_Names, used by procedure Get_Path_Names_And_Record_Sources.
  70
  71    No_Name_Location : constant Name_Location :=
  72      (Name => No_Name, Location => No_Location, Found => False);
  73
  74    package Source_Names is new GNAT.HTable.Simple_HTable
  75      (Header_Num => Header_Num,
  76       Element    => Name_Location,
  77       No_Element => No_Name_Location,
  78       Key        => Name_Id,
  79       Hash       => Hash,
  80       Equal      => "=");
  81    --  Hash table to store file names found in string list attribute
  82    --  Source_Files or in a source list file, stored in hash table
  83    --  Source_Names, used by procedure Get_Path_Names_And_Record_Sources.
  84
  85    package Recursive_Dirs is new GNAT.HTable.Simple_HTable
  86      (Header_Num => Header_Num,
  87       Element    => Boolean,
  88       No_Element => False,
  89       Key        => Name_Id,
  90       Hash       => Hash,
  91       Equal      => "=");
  92    --  Hash table to store recursive source directories, to avoid looking
  93    --  several times, and to avoid cycles that may be introduced by symbolic
  94    --  links.
  95
  96    type Ada_Naming_Exception_Id is new Nat;
  97    No_Ada_Naming_Exception : constant Ada_Naming_Exception_Id := 0;
  98
  99    type Unit_Info is record
 100       Kind : Spec_Or_Body;
 101       Unit : Name_Id;
 102       Next : Ada_Naming_Exception_Id := No_Ada_Naming_Exception;
 103    end record;
 104    --  No_Unit : constant Unit_Info :=
 105    --              (Specification, No_Name, No_Ada_Naming_Exception);
 106
 107    package Ada_Naming_Exception_Table is new Table.Table
 108      (Table_Component_Type => Unit_Info,
 109       Table_Index_Type     => Ada_Naming_Exception_Id,
 110       Table_Low_Bound      => 1,
 111       Table_Initial        => 20,
 112       Table_Increment      => 100,
 113       Table_Name           => "Prj.Nmsc.Ada_Naming_Exception_Table");
 114
 115    package Ada_Naming_Exceptions is new GNAT.HTable.Simple_HTable
 116      (Header_Num => Header_Num,
 117       Element    => Ada_Naming_Exception_Id,
 118       No_Element => No_Ada_Naming_Exception,
 119       Key        => Name_Id,
 120       Hash       => Hash,
 121       Equal      => "=");
 122    --  A hash table to store naming exceptions for Ada. For each file name
 123    --  there is one or several unit in table Ada_Naming_Exception_Table.
 124
 125    function Hash (Unit : Unit_Info) return Header_Num;
 126
 127    type Name_And_Index is record
 128       Name  : Name_Id := No_Name;
 129       Index : Int     := 0;
 130    end record;
 131    No_Name_And_Index : constant Name_And_Index :=
 132                          (Name => No_Name, Index => 0);
 133
 134    package Reverse_Ada_Naming_Exceptions is new GNAT.HTable.Simple_HTable
 135      (Header_Num => Header_Num,
 136       Element    => Name_And_Index,
 137       No_Element => No_Name_And_Index,
 138       Key        => Unit_Info,
 139       Hash       => Hash,
 140       Equal      => "=");
 141    --  A table to check if a unit with an exceptional name will hide
 142    --  a source with a file name following the naming convention.
 143
 144    function ALI_File_Name (Source : String) return String;
 145    --  Return the ALI file name corresponding to a source
 146
 147    procedure Check_Ada_Name (Name : String; Unit : out Name_Id);
 148    --  Check that a name is a valid Ada unit name
 149
 150    procedure Check_Naming_Scheme
 151      (Data    : in out Project_Data;
 152       Project : Project_Id;
 153       In_Tree : Project_Tree_Ref);
 154    --  Check the naming scheme part of Data
 155
 156    procedure Check_Ada_Naming_Scheme_Validity
 157      (Project : Project_Id;
 158       In_Tree : Project_Tree_Ref;
 159       Naming  : Naming_Data);
 160    --  Check that the package Naming is correct
 161
 162    procedure Check_For_Source
 163      (File_Name        : Name_Id;
 164       Path_Name        : Name_Id;
 165       Project          : Project_Id;
 166       In_Tree          : Project_Tree_Ref;
 167       Data             : in out Project_Data;
 168       Location         : Source_Ptr;
 169       Language         : Language_Index;
 170       Suffix           : String;
 171       Naming_Exception : Boolean);
 172    --  Check if a file, with name File_Name and path Path_Name, in a source
 173    --  directory is a source for language Language in project Project of
 174    --  project tree In_Tree. ???
 175
 176    procedure Check_If_Externally_Built
 177      (Project : Project_Id;
 178       In_Tree : Project_Tree_Ref;
 179       Data    : in out Project_Data);
 180    --  Check attribute Externally_Built of project Project in project tree
 181    --  In_Tree and modify its data Data if it has the value "true".
 182
 183    procedure Check_Library_Attributes
 184      (Project   : Project_Id;
 185       In_Tree : Project_Tree_Ref;
 186       Data      : in out Project_Data);
 187    --  Check the library attributes of project Project in project tree In_Tree
 188    --  and modify its data Data accordingly.
 189
 190    procedure Check_Package_Naming
 191      (Project : Project_Id;
 192       In_Tree : Project_Tree_Ref;
 193       Data    : in out Project_Data);
 194    --  Check package Naming of project Project in project tree In_Tree and
 195    --  modify its data Data accordingly.
 196
 197    procedure Check_Programming_Languages
 198      (In_Tree : Project_Tree_Ref; Data : in out Project_Data);
 199    --  Check attribute Languages for the project with data Data in project
 200    --  tree In_Tree and set the components of Data for all the programming
 201    --  languages indicated in attribute Languages, if any.
 202
 203    function Check_Project
 204      (P            : Project_Id;
 205       Root_Project : Project_Id;
 206       In_Tree      : Project_Tree_Ref;
 207       Extending    : Boolean) return Boolean;
 208    --  Returns True if P is Root_Project or, if Extending is True, a project
 209    --  extended by Root_Project.
 210
 211    procedure Check_Stand_Alone_Library
 212      (Project   : Project_Id;
 213       In_Tree   : Project_Tree_Ref;
 214       Data      : in out Project_Data;
 215       Extending : Boolean);
 216    --  Check if project Project in project tree In_Tree is a Stand-Alone
 217    --  Library project, and modify its data Data accordingly if it is one.
 218
 219    function Compute_Directory_Last (Dir : String) return Natural;
 220    --  Return the index of the last significant character in Dir. This is used
 221    --  to avoid duplicates '/' at the end of directory names
 222
 223    function Body_Suffix_Of
 224      (Language   : Language_Index;
 225       In_Project : Project_Data;
 226       In_Tree    : Project_Tree_Ref)
 227       return String;
 228    --  Returns the suffix of sources of language Language in project In_Project
 229    --  in project tree In_Tree.
 230
 231    procedure Error_Msg
 232      (Project       : Project_Id;
 233       In_Tree       : Project_Tree_Ref;
 234       Msg           : String;
 235       Flag_Location : Source_Ptr);
 236    --  Output an error message. If Error_Report is null, simply call
 237    --  Prj.Err.Error_Msg. Otherwise, disregard Flag_Location and use
 238    --  Error_Report.
 239
 240    procedure Find_Sources
 241      (Project      : Project_Id;
 242       In_Tree      : Project_Tree_Ref;
 243       Data         : in out Project_Data;
 244       For_Language : Language_Index;
 245       Follow_Links : Boolean := False);
 246    --  Find all the sources in all of the source directories of a project for
 247    --  a specified language.
 248
 249    procedure Free_Ada_Naming_Exceptions;
 250    --  Free the internal hash tables used for checking naming exceptions
 251
 252    procedure Get_Directories
 253      (Project : Project_Id;
 254       In_Tree : Project_Tree_Ref;
 255       Data    : in out Project_Data);
 256    --  Get the object directory, the exec directory and the source directories
 257    --  of a project.
 258
 259    procedure Get_Mains
 260      (Project : Project_Id;
 261       In_Tree : Project_Tree_Ref;
 262       Data    : in out Project_Data);
 263    --  Get the mains of a project from attribute Main, if it exists, and put
 264    --  them in the project data.
 265
 266    procedure Get_Sources_From_File
 267      (Path     : String;
 268       Location : Source_Ptr;
 269       Project  : Project_Id;
 270       In_Tree  : Project_Tree_Ref);
 271    --  Get the list of sources from a text file and put them in hash table
 272    --  Source_Names.
 273
 274    procedure Get_Unit
 275      (Canonical_File_Name : Name_Id;
 276       Naming              : Naming_Data;
 277       Exception_Id        : out Ada_Naming_Exception_Id;
 278       Unit_Name           : out Name_Id;
 279       Unit_Kind           : out Spec_Or_Body;
 280       Needs_Pragma        : out Boolean);
 281    --  Find out, from a file name, the unit name, the unit kind and if a
 282    --  specific SFN pragma is needed. If the file name corresponds to no
 283    --  unit, then Unit_Name will be No_Name. If the file is a multi-unit source
 284    --  or an exception to the naming scheme, then Exception_Id is set to
 285    --  the unit or units that the source contains.
 286
 287    function Is_Illegal_Suffix
 288      (Suffix                          : String;
 289       Dot_Replacement_Is_A_Single_Dot : Boolean) return Boolean;
 290    --  Returns True if the string Suffix cannot be used as
 291    --  a spec suffix, a body suffix or a separate suffix.
 292
 293    procedure Locate_Directory
 294      (Name    : Name_Id;
 295       Parent  : Name_Id;
 296       Dir     : out Name_Id;
 297       Display : out Name_Id);
 298    --  Locate a directory (returns No_Name for Dir and Display if directory
 299    --  does not exist). Name is the directory name. Parent is the root
 300    --  directory, if Name is a relative path name. Dir is the canonical case
 301    --  path name of the directory, Display is the directory path name for
 302    --  display purposes.
 303
 304    procedure Look_For_Sources
 305      (Project      : Project_Id;
 306       In_Tree      : Project_Tree_Ref;
 307       Data         : in out Project_Data;
 308       Follow_Links : Boolean);
 309    --  Find all the sources of a project
 310
 311    function Path_Name_Of
 312      (File_Name : Name_Id;
 313       Directory : Name_Id) return String;
 314    --  Returns the path name of a (non project) file.
 315    --  Returns an empty string if file cannot be found.
 316
 317    procedure Prepare_Ada_Naming_Exceptions
 318      (List    : Array_Element_Id;
 319       In_Tree : Project_Tree_Ref;
 320       Kind    : Spec_Or_Body);
 321    --  Prepare the internal hash tables used for checking naming exceptions
 322    --  for Ada. Insert all elements of List in the tables.
 323
 324    function Project_Extends
 325      (Extending : Project_Id;
 326       Extended  : Project_Id;
 327       In_Tree   : Project_Tree_Ref) return Boolean;
 328    --  Returns True if Extending is extending Extended either directly or
 329    --  indirectly.
 330
 331    procedure Record_Ada_Source
 332      (File_Name       : Name_Id;
 333       Path_Name       : Name_Id;
 334       Project         : Project_Id;
 335       In_Tree         : Project_Tree_Ref;
 336       Data            : in out Project_Data;
 337       Location        : Source_Ptr;
 338       Current_Source  : in out String_List_Id;
 339       Source_Recorded : in out Boolean;
 340       Follow_Links    : Boolean);
 341    --  Put a unit in the list of units of a project, if the file name
 342    --  corresponds to a valid unit name.
 343
 344    procedure Record_Other_Sources
 345      (Project           : Project_Id;
 346       In_Tree           : Project_Tree_Ref;
 347       Data              : in out Project_Data;
 348       Language          : Language_Index;
 349       Naming_Exceptions : Boolean);
 350    --  Record the sources of a language in a project.
 351    --  When Naming_Exceptions is True, mark the found sources as such, to
 352    --  later remove those that are not named in a list of sources.
 353
 354    procedure Show_Source_Dirs
 355      (Project : Project_Id; In_Tree : Project_Tree_Ref);
 356    --  List all the source directories of a project
 357
 358    function Suffix_For
 359      (Language : Language_Index;
 360       Naming   : Naming_Data;
 361       In_Tree  : Project_Tree_Ref) return Name_Id;
 362    --  Get the suffix for the source of a language from a package naming.
 363    --  If not specified, return the default for the language.
 364
 365    procedure Warn_If_Not_Sources
 366      (Project     : Project_Id;
 367       In_Tree     : Project_Tree_Ref;
 368       Conventions : Array_Element_Id;
 369       Specs       : Boolean;
 370       Extending   : Boolean);
 371    --  Check that individual naming conventions apply to immediate
 372    --  sources of the project; if not, issue a warning.
 373
 374    -------------------
 375    -- ALI_File_Name --
 376    -------------------
 377
 378    function ALI_File_Name (Source : String) return String is
 379    begin
 380       --  If the source name has an extension, then replace it with
 381       --  the ALI suffix.
 382
 383       for Index in reverse Source'First + 1 .. Source'Last loop
 384          if Source (Index) = '.' then
 385             return Source (Source'First .. Index - 1) & ALI_Suffix;
 386          end if;
 387       end loop;
 388
 389       --  If there is no dot, or if it is the first character, just add the
 390       --  ALI suffix.
 391
 392       return Source & ALI_Suffix;
 393    end ALI_File_Name;
 394
 395    -----------
 396    -- Check --
 397    -----------
 398
 399    procedure Check
 400      (Project      : Project_Id;
 401       In_Tree      : Project_Tree_Ref;
 402       Report_Error : Put_Line_Access;
 403       Follow_Links : Boolean)
 404    is
 405       Data      : Project_Data := In_Tree.Projects.Table (Project);
 406       Extending : Boolean := False;
 407
 408    begin
 409       Error_Report := Report_Error;
 410
 411       Recursive_Dirs.Reset;
 412
 413       --  Object, exec and source directories
 414
 415       Get_Directories (Project, In_Tree, Data);
 416
 417       --  Get the programming languages
 418
 419       Check_Programming_Languages (In_Tree, Data);
 420
 421       --  Library attributes
 422
 423       Check_Library_Attributes (Project, In_Tree, Data);
 424
 425       Check_If_Externally_Built (Project, In_Tree, Data);
 426
 427       if Current_Verbosity = High then
 428          Show_Source_Dirs (Project, In_Tree);
 429       end if;
 430
 431       Check_Package_Naming (Project, In_Tree, Data);
 432
 433       Extending := Data.Extends /= No_Project;
 434
 435       Check_Naming_Scheme (Data, Project, In_Tree);
 436
 437       Prepare_Ada_Naming_Exceptions
 438         (Data.Naming.Bodies, In_Tree, Body_Part);
 439       Prepare_Ada_Naming_Exceptions
 440         (Data.Naming.Specs, In_Tree, Specification);
 441
 442       --  Find the sources
 443
 444       if Data.Source_Dirs /= Nil_String then
 445          Look_For_Sources (Project, In_Tree, Data, Follow_Links);
 446       end if;
 447
 448       if Data.Ada_Sources_Present then
 449
 450          --  Check that all individual naming conventions apply to sources of
 451          --  this project file.
 452
 453          Warn_If_Not_Sources
 454            (Project, In_Tree, Data.Naming.Bodies,
 455             Specs     => False,
 456             Extending => Extending);
 457          Warn_If_Not_Sources
 458            (Project, In_Tree, Data.Naming.Specs,
 459             Specs     => True,
 460             Extending => Extending);
 461       end if;
 462
 463       --  If it is a library project file, check if it is a standalone library
 464
 465       if Data.Library then
 466          Check_Stand_Alone_Library (Project, In_Tree, Data, Extending);
 467       end if;
 468
 469       --  Put the list of Mains, if any, in the project data
 470
 471       Get_Mains (Project, In_Tree, Data);
 472
 473       --  Update the project data in the Projects table
 474
 475       In_Tree.Projects.Table (Project) := Data;
 476
 477       Free_Ada_Naming_Exceptions;
 478    end Check;
 479
 480    --------------------
 481    -- Check_Ada_Name --
 482    --------------------
 483
 484    procedure Check_Ada_Name (Name : String; Unit : out Name_Id) is
 485       The_Name        : String := Name;
 486       Real_Name       : Name_Id;
 487       Need_Letter     : Boolean := True;
 488       Last_Underscore : Boolean := False;
 489       OK              : Boolean := The_Name'Length > 0;
 490
 491    begin
 492       To_Lower (The_Name);
 493
 494       Name_Len := The_Name'Length;
 495       Name_Buffer (1 .. Name_Len) := The_Name;
 496       Real_Name := Name_Find;
 497
 498       --  Check first that the given name is not an Ada reserved word
 499
 500       if Get_Name_Table_Byte (Real_Name) /= 0
 501         and then Real_Name /= Name_Project
 502         and then Real_Name /= Name_Extends
 503         and then Real_Name /= Name_External
 504       then
 505          Unit := No_Name;
 506
 507          if Current_Verbosity = High then
 508             Write_Str (The_Name);
 509             Write_Line (" is an Ada reserved word.");
 510          end if;
 511
 512          return;
 513       end if;
 514
 515       for Index in The_Name'Range loop
 516          if Need_Letter then
 517
 518             --  We need a letter (at the beginning, and following a dot),
 519             --  but we don't have one.
 520
 521             if Is_Letter (The_Name (Index)) then
 522                Need_Letter := False;
 523
 524             else
 525                OK := False;
 526
 527                if Current_Verbosity = High then
 528                   Write_Int  (Types.Int (Index));
 529                   Write_Str  (": '");
 530                   Write_Char (The_Name (Index));
 531                   Write_Line ("' is not a letter.");
 532                end if;
 533
 534                exit;
 535             end if;
 536
 537          elsif Last_Underscore
 538            and then (The_Name (Index) = '_' or else The_Name (Index) = '.')
 539          then
 540             --  Two underscores are illegal, and a dot cannot follow
 541             --  an underscore.
 542
 543             OK := False;
 544
 545             if Current_Verbosity = High then
 546                Write_Int  (Types.Int (Index));
 547                Write_Str  (": '");
 548                Write_Char (The_Name (Index));
 549                Write_Line ("' is illegal here.");
 550             end if;
 551
 552             exit;
 553
 554          elsif The_Name (Index) = '.' then
 555
 556             --  We need a letter after a dot
 557
 558             Need_Letter := True;
 559
 560          elsif The_Name (Index) = '_' then
 561             Last_Underscore := True;
 562
 563          else
 564             --  We need an letter or a digit
 565
 566             Last_Underscore := False;
 567
 568             if not Is_Alphanumeric (The_Name (Index)) then
 569                OK := False;
 570
 571                if Current_Verbosity = High then
 572                   Write_Int  (Types.Int (Index));
 573                   Write_Str  (": '");
 574                   Write_Char (The_Name (Index));
 575                   Write_Line ("' is not alphanumeric.");
 576                end if;
 577
 578                exit;
 579             end if;
 580          end if;
 581       end loop;
 582
 583       --  Cannot end with an underscore or a dot
 584
 585       OK := OK and then not Need_Letter and then not Last_Underscore;
 586
 587       if OK then
 588          Unit := Real_Name;
 589
 590       else
 591          --  Signal a problem with No_Name
 592
 593          Unit := No_Name;
 594       end if;
 595    end Check_Ada_Name;
 596
 597    --------------------------------------
 598    -- Check_Ada_Naming_Scheme_Validity --
 599    --------------------------------------
 600
 601    procedure Check_Ada_Naming_Scheme_Validity
 602      (Project : Project_Id;
 603       In_Tree : Project_Tree_Ref;
 604       Naming  : Naming_Data)
 605    is
 606    begin
 607       --  Only check if we are not using the Default naming scheme
 608
 609       if Naming /= In_Tree.Private_Part.Default_Naming then
 610          declare
 611             Dot_Replacement       : constant String :=
 612                                      Get_Name_String
 613                                        (Naming.Dot_Replacement);
 614
 615             Spec_Suffix : constant String :=
 616                                      Get_Name_String
 617                                        (Naming.Ada_Spec_Suffix);
 618
 619             Body_Suffix : constant String :=
 620                                      Get_Name_String
 621                                        (Naming.Ada_Body_Suffix);
 622
 623             Separate_Suffix       : constant String :=
 624                                      Get_Name_String
 625                                        (Naming.Separate_Suffix);
 626
 627          begin
 628             --  Dot_Replacement cannot
 629             --   - be empty
 630             --   - start or end with an alphanumeric
 631             --   - be a single '_'
 632             --   - start with an '_' followed by an alphanumeric
 633             --   - contain a '.' except if it is "."
 634
 635             if Dot_Replacement'Length = 0
 636               or else Is_Alphanumeric
 637                         (Dot_Replacement (Dot_Replacement'First))
 638               or else Is_Alphanumeric
 639                         (Dot_Replacement (Dot_Replacement'Last))
 640               or else (Dot_Replacement (Dot_Replacement'First) = '_'
 641                         and then
 642                         (Dot_Replacement'Length = 1
 643                           or else
 644                            Is_Alphanumeric
 645                              (Dot_Replacement (Dot_Replacement'First + 1))))
 646               or else (Dot_Replacement'Length > 1
 647                          and then
 648                            Index (Source => Dot_Replacement,
 649                                   Pattern => ".") /= 0)
 650             then
 651                Error_Msg
 652                  (Project, In_Tree,
 653                   '"' & Dot_Replacement &
 654                   """ is illegal for Dot_Replacement.",
 655                   Naming.Dot_Repl_Loc);
 656             end if;
 657
 658             --  Suffixes cannot
 659             --   - be empty
 660
 661             if Is_Illegal_Suffix
 662                  (Spec_Suffix, Dot_Replacement = ".")
 663             then
 664                Err_Vars.Error_Msg_Name_1 := Naming.Ada_Spec_Suffix;
 665                Error_Msg
 666                  (Project, In_Tree,
 667                   "{ is illegal for Spec_Suffix",
 668                   Naming.Spec_Suffix_Loc);
 669             end if;
 670
 671             if Is_Illegal_Suffix
 672                  (Body_Suffix, Dot_Replacement = ".")
 673             then
 674                Err_Vars.Error_Msg_Name_1 := Naming.Ada_Body_Suffix;
 675                Error_Msg
 676                  (Project, In_Tree,
 677                   "{ is illegal for Body_Suffix",
 678                   Naming.Body_Suffix_Loc);
 679             end if;
 680
 681             if Body_Suffix /= Separate_Suffix then
 682                if Is_Illegal_Suffix
 683                     (Separate_Suffix, Dot_Replacement = ".")
 684                then
 685                   Err_Vars.Error_Msg_Name_1 := Naming.Separate_Suffix;
 686                   Error_Msg
 687                     (Project, In_Tree,
 688                      "{ is illegal for Separate_Suffix",
 689                      Naming.Sep_Suffix_Loc);
 690                end if;
 691             end if;
 692
 693             --  Spec_Suffix cannot have the same termination as
 694             --  Body_Suffix or Separate_Suffix
 695
 696             if Spec_Suffix'Length <= Body_Suffix'Length
 697               and then
 698                 Body_Suffix (Body_Suffix'Last -
 699                              Spec_Suffix'Length + 1 ..
 700                              Body_Suffix'Last) = Spec_Suffix
 701             then
 702                Error_Msg
 703                  (Project, In_Tree,
 704                   "Body_Suffix (""" &
 705                   Body_Suffix &
 706                   """) cannot end with" &
 707                   " Spec_Suffix  (""" &
 708                   Spec_Suffix & """).",
 709                   Naming.Body_Suffix_Loc);
 710             end if;
 711
 712             if Body_Suffix /= Separate_Suffix
 713               and then Spec_Suffix'Length <= Separate_Suffix'Length
 714               and then
 715                 Separate_Suffix
 716                   (Separate_Suffix'Last - Spec_Suffix'Length + 1
 717                     ..
 718                    Separate_Suffix'Last) = Spec_Suffix
 719             then
 720                Error_Msg
 721                  (Project, In_Tree,
 722                   "Separate_Suffix (""" &
 723                   Separate_Suffix &
 724                   """) cannot end with" &
 725                   " Spec_Suffix (""" &
 726                   Spec_Suffix & """).",
 727                   Naming.Sep_Suffix_Loc);
 728             end if;
 729          end;
 730       end if;
 731    end Check_Ada_Naming_Scheme_Validity;
 732
 733    ----------------------
 734    -- Check_For_Source --
 735    ----------------------
 736
 737    procedure Check_For_Source
 738      (File_Name        : Name_Id;
 739       Path_Name        : Name_Id;
 740       Project          : Project_Id;
 741       In_Tree          : Project_Tree_Ref;
 742       Data             : in out Project_Data;
 743       Location         : Source_Ptr;
 744       Language         : Language_Index;
 745       Suffix           : String;
 746       Naming_Exception : Boolean)
 747    is
 748       Name : String := Get_Name_String (File_Name);
 749       Real_Location : Source_Ptr := Location;
 750
 751    begin
 752       Canonical_Case_File_Name (Name);
 753
 754       --  A file is a source of a language if Naming_Exception is True (case
 755       --  of naming exceptions) or if its file name ends with the suffix.
 756
 757       if Naming_Exception or else
 758         (Name'Length > Suffix'Length and then
 759          Name (Name'Last - Suffix'Length + 1 .. Name'Last) = Suffix)
 760       then
 761          if Real_Location = No_Location then
 762             Real_Location := Data.Location;
 763          end if;
 764
 765          declare
 766             Path : String := Get_Name_String (Path_Name);
 767
 768             Path_Id : Name_Id;
 769             --  The path name id (in canonical case)
 770
 771             File_Id : Name_Id;
 772             --  The file name id (in canonical case)
 773
 774             Obj_Id : Name_Id;
 775             --  The object file name
 776
 777             Obj_Path_Id : Name_Id;
 778             --  The object path name
 779
 780             Dep_Id : Name_Id;
 781             --  The dependency file name
 782
 783             Dep_Path_Id : Name_Id;
 784             --  The dependency path name
 785
 786             Dot_Pos : Natural := 0;
 787             --  Position of the last dot in Name
 788
 789             Source    : Other_Source;
 790             Source_Id : Other_Source_Id := Data.First_Other_Source;
 791
 792          begin
 793             Canonical_Case_File_Name (Path);
 794
 795             --  Get the file name id
 796
 797             Name_Len := Name'Length;
 798             Name_Buffer (1 .. Name_Len) := Name;
 799             File_Id := Name_Find;
 800
 801             --  Get the path name id
 802
 803             Name_Len := Path'Length;
 804             Name_Buffer (1 .. Name_Len) := Path;
 805             Path_Id := Name_Find;
 806
 807             --  Find the position of the last dot
 808
 809             for J in reverse Name'Range loop
 810                if Name (J) = '.' then
 811                   Dot_Pos := J;
 812                   exit;
 813                end if;
 814             end loop;
 815
 816             if Dot_Pos <= Name'First then
 817                Dot_Pos := Name'Last + 1;
 818             end if;
 819
 820             --  Compute the object file name
 821
 822             Get_Name_String (File_Id);
 823             Name_Len := Dot_Pos - Name'First;
 824
 825             for J in Object_Suffix'Range loop
 826                Name_Len := Name_Len + 1;
 827                Name_Buffer (Name_Len) := Object_Suffix (J);
 828             end loop;
 829
 830             Obj_Id := Name_Find;
 831
 832             --  Compute the object path name
 833
 834             Get_Name_String (Data.Object_Directory);
 835
 836             if Name_Buffer (Name_Len) /= Directory_Separator and then
 837               Name_Buffer (Name_Len) /= '/'
 838             then
 839                Name_Len := Name_Len + 1;
 840                Name_Buffer (Name_Len) := Directory_Separator;
 841             end if;
 842
 843             Add_Str_To_Name_Buffer (Get_Name_String (Obj_Id));
 844             Obj_Path_Id := Name_Find;
 845
 846             --  Compute the dependency file name
 847
 848             Get_Name_String (File_Id);
 849             Name_Len := Dot_Pos - Name'First + 1;
 850             Name_Buffer (Name_Len) := '.';
 851             Name_Len := Name_Len + 1;
 852             Name_Buffer (Name_Len) := 'd';
 853             Dep_Id := Name_Find;
 854
 855             --  Compute the dependency path name
 856
 857             Get_Name_String (Data.Object_Directory);
 858
 859             if Name_Buffer (Name_Len) /= Directory_Separator and then
 860               Name_Buffer (Name_Len) /= '/'
 861             then
 862                Name_Len := Name_Len + 1;
 863                Name_Buffer (Name_Len) := Directory_Separator;
 864             end if;
 865
 866             Add_Str_To_Name_Buffer (Get_Name_String (Dep_Id));
 867             Dep_Path_Id := Name_Find;
 868
 869             --  Check if source is already in the list of source for this
 870             --  project: it may have already been specified as a naming
 871             --  exception for the same language or an other language, or
 872             --  they may be two identical file names in different source
 873             --  directories.
 874
 875             while Source_Id /= No_Other_Source loop
 876                Source := In_Tree.Other_Sources.Table (Source_Id);
 877
 878                if Source.File_Name = File_Id then
 879
 880                   --  Two sources of different languages cannot have the same
 881                   --  file name.
 882
 883                   if Source.Language /= Language then
 884                      Error_Msg_Name_1 := File_Name;
 885                      Error_Msg
 886                        (Project, In_Tree,
 887                         "{ cannot be a source of several languages",
 888                         Real_Location);
 889                      return;
 890
 891                   --  No problem if a file has already been specified as
 892                   --  a naming exception of this language.
 893
 894                   elsif Source.Path_Name = Path_Id then
 895
 896                      --  Reset the naming exception flag, if this is not a
 897                      --  naming exception.
 898
 899                      if not Naming_Exception then
 900                         In_Tree.Other_Sources.Table
 901                           (Source_Id).Naming_Exception := False;
 902                      end if;
 903
 904                      return;
 905
 906                   --  There are several files with the same names, but the
 907                   --  order of the source directories is known (no /**):
 908                   --  only the first one encountered is kept, the other ones
 909                   --  are ignored.
 910
 911                   elsif Data.Known_Order_Of_Source_Dirs then
 912                      return;
 913
 914                   --  But it is an error if the order of the source directories
 915                   --  is not known.
 916
 917                   else
 918                      Error_Msg_Name_1 := File_Name;
 919                      Error_Msg
 920                        (Project, In_Tree,
 921                         "{ is found in several source directories",
 922                         Real_Location);
 923                      return;
 924                   end if;
 925
 926                --  Two sources with different file names cannot have the same
 927                --  object file name.
 928
 929                elsif Source.Object_Name = Obj_Id then
 930                   Error_Msg_Name_1 := File_Id;
 931                   Error_Msg_Name_2 := Source.File_Name;
 932                   Error_Msg_Name_3 := Obj_Id;
 933                   Error_Msg
 934                        (Project, In_Tree,
 935                         "{ and { have the same object file {",
 936                         Real_Location);
 937                      return;
 938                end if;
 939
 940                Source_Id := Source.Next;
 941             end loop;
 942
 943             if Current_Verbosity = High then
 944                Write_Str ("      found ");
 945                Display_Language_Name (Language);
 946                Write_Str (" source """);
 947                Write_Str (Get_Name_String (File_Name));
 948                Write_Line ("""");
 949                Write_Str ("      object path = ");
 950                Write_Line (Get_Name_String (Obj_Path_Id));
 951             end if;
 952
 953             --  Create the Other_Source record
 954
 955             Source :=
 956               (Language         => Language,
 957                File_Name        => File_Id,
 958                Path_Name        => Path_Id,
 959                Source_TS        => File_Stamp (Path_Id),
 960                Object_Name      => Obj_Id,
 961                Object_Path      => Obj_Path_Id,
 962                Object_TS        => File_Stamp (Obj_Path_Id),
 963                Dep_Name         => Dep_Id,
 964                Dep_Path         => Dep_Path_Id,
 965                Dep_TS           => File_Stamp (Dep_Path_Id),
 966                Naming_Exception => Naming_Exception,
 967                Next             => No_Other_Source);
 968
 969             --  And add it to the Other_Sources table
 970
 971             Other_Source_Table.Increment_Last
 972               (In_Tree.Other_Sources);
 973             In_Tree.Other_Sources.Table
 974               (Other_Source_Table.Last (In_Tree.Other_Sources)) :=
 975                  Source;
 976
 977             --  There are sources of languages other than Ada in this project
 978
 979             Data.Other_Sources_Present := True;
 980
 981             --  And there are sources of this language in this project
 982
 983             Set (Language, True, Data, In_Tree);
 984
 985             --  Add this source to the list of sources of languages other than
 986             --  Ada of the project.
 987
 988             if Data.First_Other_Source = No_Other_Source then
 989                Data.First_Other_Source :=
 990                  Other_Source_Table.Last (In_Tree.Other_Sources);
 991
 992             else
 993                In_Tree.Other_Sources.Table (Data.Last_Other_Source).Next :=
 994                  Other_Source_Table.Last (In_Tree.Other_Sources);
 995             end if;
 996
 997             Data.Last_Other_Source :=
 998               Other_Source_Table.Last (In_Tree.Other_Sources);
 999          end;
1000       end if;
1001    end Check_For_Source;
1002
1003    -------------------------------
1004    -- Check_If_Externally_Built --
1005    -------------------------------
1006
1007    procedure Check_If_Externally_Built
1008      (Project : Project_Id;
1009       In_Tree : Project_Tree_Ref;
1010       Data    : in out Project_Data)
1011    is
1012       Externally_Built : constant Variable_Value :=
1013                            Util.Value_Of
1014                             (Name_Externally_Built,
1015                              Data.Decl.Attributes, In_Tree);
1016
1017    begin
1018       if not Externally_Built.Default then
1019          Get_Name_String (Externally_Built.Value);
1020          To_Lower (Name_Buffer (1 .. Name_Len));
1021
1022          if Name_Buffer (1 .. Name_Len) = "true" then
1023             Data.Externally_Built := True;
1024
1025          elsif Name_Buffer (1 .. Name_Len) /= "false" then
1026             Error_Msg (Project, In_Tree,
1027                        "Externally_Built may only be true or false",
1028                        Externally_Built.Location);
1029          end if;
1030       end if;
1031
1032       if Current_Verbosity = High then
1033          Write_Str ("Project is ");
1034
1035          if not Data.Externally_Built then
1036             Write_Str ("not ");
1037          end if;
1038
1039          Write_Line ("externally built.");
1040       end if;
1041    end Check_If_Externally_Built;
1042
1043    -----------------------------
1044    -- Check_Naming_Scheme --
1045    -----------------------------
1046
1047    procedure Check_Naming_Scheme
1048      (Data    : in out Project_Data;
1049       Project : Project_Id;
1050       In_Tree : Project_Tree_Ref)
1051    is
1052       Naming_Id : constant Package_Id :=
1053                     Util.Value_Of (Name_Naming, Data.Decl.Packages, In_Tree);
1054
1055       Naming : Package_Element;
1056
1057       procedure Check_Unit_Names (List : Array_Element_Id);
1058       --  Check that a list of unit names contains only valid names
1059
1060       ----------------------
1061       -- Check_Unit_Names --
1062       ----------------------
1063
1064       procedure Check_Unit_Names (List : Array_Element_Id) is
1065          Current   : Array_Element_Id := List;
1066          Element   : Array_Element;
1067          Unit_Name : Name_Id;
1068
1069       begin
1070          --  Loop through elements of the string list
1071
1072          while Current /= No_Array_Element loop
1073             Element := In_Tree.Array_Elements.Table (Current);
1074
1075             --  Put file name in canonical case
1076
1077             Get_Name_String (Element.Value.Value);
1078             Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1079             Element.Value.Value := Name_Find;
1080
1081             --  Check that it contains a valid unit name
1082
1083             Get_Name_String (Element.Index);
1084             Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit_Name);
1085
1086             if Unit_Name = No_Name then
1087                Err_Vars.Error_Msg_Name_1 := Element.Index;
1088                Error_Msg
1089                  (Project, In_Tree,
1090                   "{ is not a valid unit name.",
1091                   Element.Value.Location);
1092
1093             else
1094                if Current_Verbosity = High then
1095                   Write_Str ("    Unit (""");
1096                   Write_Str (Get_Name_String (Unit_Name));
1097                   Write_Line (""")");
1098                end if;
1099
1100                Element.Index := Unit_Name;
1101                In_Tree.Array_Elements.Table (Current) := Element;
1102             end if;
1103
1104             Current := Element.Next;
1105          end loop;
1106       end Check_Unit_Names;
1107
1108    --  Start of processing for Check_Naming_Scheme
1109
1110    begin
1111       --  If there is a package Naming, we will put in Data.Naming what is in
1112       --  this package Naming.
1113
1114       if Naming_Id /= No_Package then
1115          Naming := In_Tree.Packages.Table (Naming_Id);
1116
1117          if Current_Verbosity = High then
1118             Write_Line ("Checking ""Naming"" for Ada.");
1119          end if;
1120
1121          declare
1122             Bodies : constant Array_Element_Id :=
1123                        Util.Value_Of (Name_Body, Naming.Decl.Arrays, In_Tree);
1124
1125             Specs : constant Array_Element_Id :=
1126                       Util.Value_Of (Name_Spec, Naming.Decl.Arrays, In_Tree);
1127
1128          begin
1129             if Bodies /= No_Array_Element then
1130
1131                --  We have elements in the array Body_Part
1132
1133                if Current_Verbosity = High then
1134                   Write_Line ("Found Bodies.");
1135                end if;
1136
1137                Data.Naming.Bodies := Bodies;
1138                Check_Unit_Names (Bodies);
1139
1140             else
1141                if Current_Verbosity = High then
1142                   Write_Line ("No Bodies.");
1143                end if;
1144             end if;
1145
1146             if Specs /= No_Array_Element then
1147
1148                --  We have elements in the array Specs
1149
1150                if Current_Verbosity = High then
1151                   Write_Line ("Found Specs.");
1152                end if;
1153
1154                Data.Naming.Specs := Specs;
1155                Check_Unit_Names (Specs);
1156
1157             else
1158                if Current_Verbosity = High then
1159                   Write_Line ("No Specs.");
1160                end if;
1161             end if;
1162          end;
1163
1164          --  We are now checking if variables Dot_Replacement, Casing,
1165          --  Spec_Suffix, Body_Suffix and/or Separate_Suffix
1166          --  exist.
1167
1168          --  For each variable, if it does not exist, we do nothing,
1169          --  because we already have the default.
1170
1171          --  Check Dot_Replacement
1172
1173          declare
1174             Dot_Replacement : constant Variable_Value :=
1175                                 Util.Value_Of
1176                                   (Name_Dot_Replacement,
1177                                    Naming.Decl.Attributes, In_Tree);
1178
1179          begin
1180             pragma Assert (Dot_Replacement.Kind = Single,
1181                            "Dot_Replacement is not a single string");
1182
1183             if not Dot_Replacement.Default then
1184                Get_Name_String (Dot_Replacement.Value);
1185
1186                if Name_Len = 0 then
1187                   Error_Msg
1188                     (Project, In_Tree,
1189                      "Dot_Replacement cannot be empty",
1190                      Dot_Replacement.Location);
1191
1192                else
1193                   Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1194                   Data.Naming.Dot_Replacement := Name_Find;
1195                   Data.Naming.Dot_Repl_Loc := Dot_Replacement.Location;
1196                end if;
1197             end if;
1198          end;
1199
1200          if Current_Verbosity = High then
1201             Write_Str  ("  Dot_Replacement = """);
1202             Write_Str  (Get_Name_String (Data.Naming.Dot_Replacement));
1203             Write_Char ('"');
1204             Write_Eol;
1205          end if;
1206
1207          --  Check Casing
1208
1209          declare
1210             Casing_String : constant Variable_Value :=
1211                               Util.Value_Of
1212                                 (Name_Casing, Naming.Decl.Attributes, In_Tree);
1213
1214          begin
1215             pragma Assert (Casing_String.Kind = Single,
1216                            "Casing is not a single string");
1217
1218             if not Casing_String.Default then
1219                declare
1220                   Casing_Image : constant String :=
1221                                    Get_Name_String (Casing_String.Value);
1222                begin
1223                   declare
1224                      Casing_Value : constant Casing_Type :=
1225                                       Value (Casing_Image);
1226                   begin
1227                      Data.Naming.Casing := Casing_Value;
1228                   end;
1229
1230                exception
1231                   when Constraint_Error =>
1232                      if Casing_Image'Length = 0 then
1233                         Error_Msg
1234                           (Project, In_Tree,
1235                            "Casing cannot be an empty string",
1236                            Casing_String.Location);
1237
1238                      else
1239                         Name_Len := Casing_Image'Length;
1240                         Name_Buffer (1 .. Name_Len) := Casing_Image;
1241                         Err_Vars.Error_Msg_Name_1 := Name_Find;
1242                         Error_Msg
1243                           (Project, In_Tree,
1244                            "{ is not a correct Casing",
1245                            Casing_String.Location);
1246                      end if;
1247                end;
1248             end if;
1249          end;
1250
1251          if Current_Verbosity = High then
1252             Write_Str  ("  Casing = ");
1253             Write_Str  (Image (Data.Naming.Casing));
1254             Write_Char ('.');
1255             Write_Eol;
1256          end if;
1257
1258          --  Check Spec_Suffix
1259
1260          declare
1261             Ada_Spec_Suffix : constant Variable_Value :=
1262                                 Prj.Util.Value_Of
1263                                   (Index     => Name_Ada,
1264                                    Src_Index => 0,
1265                                    In_Array  => Data.Naming.Spec_Suffix,
1266                                    In_Tree   => In_Tree);
1267
1268          begin
1269             if Ada_Spec_Suffix.Kind = Single
1270               and then Get_Name_String (Ada_Spec_Suffix.Value) /= ""
1271             then
1272                Get_Name_String (Ada_Spec_Suffix.Value);
1273                Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1274                Data.Naming.Ada_Spec_Suffix := Name_Find;
1275                Data.Naming.Spec_Suffix_Loc := Ada_Spec_Suffix.Location;
1276
1277             else
1278                Data.Naming.Ada_Spec_Suffix := Default_Ada_Spec_Suffix;
1279             end if;
1280          end;
1281
1282          if Current_Verbosity = High then
1283             Write_Str  ("  Spec_Suffix = """);
1284             Write_Str  (Get_Name_String (Data.Naming.Ada_Spec_Suffix));
1285             Write_Char ('"');
1286             Write_Eol;
1287          end if;
1288
1289          --  Check Body_Suffix
1290
1291          declare
1292             Ada_Body_Suffix : constant Variable_Value :=
1293               Prj.Util.Value_Of
1294                 (Index     => Name_Ada,
1295                  Src_Index => 0,
1296                  In_Array  => Data.Naming.Body_Suffix,
1297                  In_Tree   => In_Tree);
1298
1299          begin
1300             if Ada_Body_Suffix.Kind = Single
1301               and then Get_Name_String (Ada_Body_Suffix.Value) /= ""
1302             then
1303                Get_Name_String (Ada_Body_Suffix.Value);
1304                Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1305                Data.Naming.Ada_Body_Suffix := Name_Find;
1306                Data.Naming.Body_Suffix_Loc := Ada_Body_Suffix.Location;
1307
1308             else
1309                Data.Naming.Ada_Body_Suffix := Default_Ada_Body_Suffix;
1310             end if;
1311          end;
1312
1313          if Current_Verbosity = High then
1314             Write_Str  ("  Body_Suffix = """);
1315             Write_Str  (Get_Name_String (Data.Naming.Ada_Body_Suffix));
1316             Write_Char ('"');
1317             Write_Eol;
1318          end if;
1319
1320          --  Check Separate_Suffix
1321
1322          declare
1323             Ada_Sep_Suffix : constant Variable_Value :=
1324                                Prj.Util.Value_Of
1325                                  (Variable_Name => Name_Separate_Suffix,
1326                                   In_Variables  => Naming.Decl.Attributes,
1327                                   In_Tree       => In_Tree);
1328
1329          begin
1330             if Ada_Sep_Suffix.Default then
1331                Data.Naming.Separate_Suffix :=
1332                  Data.Naming.Ada_Body_Suffix;
1333
1334             else
1335                Get_Name_String (Ada_Sep_Suffix.Value);
1336
1337                if Name_Len = 0 then
1338                   Error_Msg
1339                     (Project, In_Tree,
1340                      "Separate_Suffix cannot be empty",
1341                      Ada_Sep_Suffix.Location);
1342
1343                else
1344                   Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1345                   Data.Naming.Separate_Suffix := Name_Find;
1346                   Data.Naming.Sep_Suffix_Loc  := Ada_Sep_Suffix.Location;
1347                end if;
1348             end if;
1349          end;
1350
1351          if Current_Verbosity = High then
1352             Write_Str  ("  Separate_Suffix = """);
1353             Write_Str  (Get_Name_String (Data.Naming.Separate_Suffix));
1354             Write_Char ('"');
1355             Write_Eol;
1356          end if;
1357
1358          --  Check if Data.Naming is valid
1359
1360          Check_Ada_Naming_Scheme_Validity (Project, In_Tree, Data.Naming);
1361
1362       else
1363          Data.Naming.Ada_Spec_Suffix := Default_Ada_Spec_Suffix;
1364          Data.Naming.Ada_Body_Suffix := Default_Ada_Body_Suffix;
1365          Data.Naming.Separate_Suffix := Default_Ada_Body_Suffix;
1366       end if;
1367    end Check_Naming_Scheme;
1368
1369    ------------------------------
1370    -- Check_Library_Attributes --
1371    ------------------------------
1372
1373    procedure Check_Library_Attributes
1374      (Project : Project_Id;
1375       In_Tree : Project_Tree_Ref;
1376       Data    : in out Project_Data)
1377    is
1378       Attributes : constant Prj.Variable_Id := Data.Decl.Attributes;
1379
1380       Lib_Dir : constant Prj.Variable_Value :=
1381                   Prj.Util.Value_Of
1382                     (Snames.Name_Library_Dir, Attributes, In_Tree);
1383
1384       Lib_Name : constant Prj.Variable_Value :=
1385                    Prj.Util.Value_Of
1386                      (Snames.Name_Library_Name, Attributes, In_Tree);
1387
1388       Lib_Version : constant Prj.Variable_Value :=
1389                       Prj.Util.Value_Of
1390                         (Snames.Name_Library_Version, Attributes, In_Tree);
1391
1392       Lib_ALI_Dir : constant Prj.Variable_Value :=
1393                       Prj.Util.Value_Of
1394                         (Snames.Name_Library_Ali_Dir, Attributes, In_Tree);
1395
1396       The_Lib_Kind : constant Prj.Variable_Value :=
1397                        Prj.Util.Value_Of
1398                          (Snames.Name_Library_Kind, Attributes, In_Tree);
1399
1400    begin
1401       --  Special case of extending project
1402
1403       if Data.Extends /= No_Project then
1404          declare
1405             Extended_Data : constant Project_Data :=
1406                            In_Tree.Projects.Table (Data.Extends);
1407
1408          begin
1409             --  If the project extended is a library project, we inherit
1410             --  the library name, if it is not redefined; we check that
1411             --  the library directory is specified; and we reset the
1412             --  library flag for the extended project.
1413
1414             if Extended_Data.Library then
1415                if Lib_Name.Default then
1416                   Data.Library_Name := Extended_Data.Library_Name;
1417                end if;
1418
1419                if Lib_Dir.Default then
1420                   if not Data.Virtual then
1421                      Error_Msg
1422                        (Project, In_Tree,
1423                         "a project extending a library project must " &
1424                         "specify an attribute Library_Dir",
1425                         Data.Location);
1426                   end if;
1427                end if;
1428
1429                In_Tree.Projects.Table (Data.Extends).Library :=
1430                  False;
1431             end if;
1432          end;
1433       end if;
1434
1435       pragma Assert (Lib_Dir.Kind = Single);
1436
1437       if Lib_Dir.Value = Empty_String then
1438          if Current_Verbosity = High then
1439             Write_Line ("No library directory");
1440          end if;
1441
1442       else
1443          --  Find path name, check that it is a directory
1444
1445          Locate_Directory
1446            (Lib_Dir.Value, Data.Display_Directory,
1447             Data.Library_Dir, Data.Display_Library_Dir);
1448
1449          if Data.Library_Dir = No_Name then
1450
1451             --  Get the absolute name of the library directory that
1452             --  does not exist, to report an error.
1453
1454             declare
1455                Dir_Name : constant String := Get_Name_String (Lib_Dir.Value);
1456
1457             begin
1458                if Is_Absolute_Path (Dir_Name) then
1459                   Err_Vars.Error_Msg_Name_1 := Lib_Dir.Value;
1460
1461                else
1462                   Get_Name_String (Data.Display_Directory);
1463
1464                   if Name_Buffer (Name_Len) /= Directory_Separator then
1465                      Name_Len := Name_Len + 1;
1466                      Name_Buffer (Name_Len) := Directory_Separator;
1467                   end if;
1468
1469                   Name_Buffer
1470                     (Name_Len + 1 .. Name_Len + Dir_Name'Length) :=
1471                     Dir_Name;
1472                   Name_Len := Name_Len + Dir_Name'Length;
1473                   Err_Vars.Error_Msg_Name_1 := Name_Find;
1474                end if;
1475
1476                --  Report the error
1477
1478                Error_Msg
1479                  (Project, In_Tree,
1480                   "library directory { does not exist",
1481                   Lib_Dir.Location);
1482             end;
1483
1484          --  The library directory cannot be the same as the Object directory
1485
1486          elsif Data.Library_Dir = Data.Object_Directory then
1487             Error_Msg
1488               (Project, In_Tree,
1489                "library directory cannot be the same " &
1490                "as object directory",
1491                Lib_Dir.Location);
1492             Data.Library_Dir := No_Name;
1493             Data.Display_Library_Dir := No_Name;
1494
1495          else
1496             declare
1497                OK       : Boolean := True;
1498                Dirs_Id  : String_List_Id;
1499                Dir_Elem : String_Element;
1500
1501             begin
1502                --  The library directory cannot be the same as a source
1503                --  directory of the current project.
1504
1505                Dirs_Id := Data.Source_Dirs;
1506                while Dirs_Id /= Nil_String loop
1507                   Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id);
1508                   Dirs_Id  := Dir_Elem.Next;
1509
1510                   if Data.Library_Dir = Dir_Elem.Value then
1511                      Err_Vars.Error_Msg_Name_1 := Dir_Elem.Value;
1512                      Error_Msg
1513                        (Project, In_Tree,
1514                         "library directory cannot be the same " &
1515                         "as source directory {",
1516                         Lib_Dir.Location);
1517                      OK := False;
1518                      exit;
1519                   end if;
1520                end loop;
1521
1522                if OK then
1523
1524                   --  The library directory cannot be the same as a source
1525                   --  directory of another project either.
1526
1527                   Project_Loop :
1528                   for Pid in 1 .. Project_Table.Last (In_Tree.Projects) loop
1529                      if Pid /= Project then
1530                         Dirs_Id := In_Tree.Projects.Table (Pid).Source_Dirs;
1531
1532                         Dir_Loop : while Dirs_Id /= Nil_String loop
1533                            Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id);
1534                            Dirs_Id  := Dir_Elem.Next;
1535
1536                            if Data.Library_Dir = Dir_Elem.Value then
1537                               Err_Vars.Error_Msg_Name_1 := Dir_Elem.Value;
1538                               Err_Vars.Error_Msg_Name_2 :=
1539                                 In_Tree.Projects.Table (Pid).Name;
1540
1541                               Error_Msg
1542                                 (Project, In_Tree,
1543                                  "library directory cannot be the same " &
1544                                  "as source directory { of project {",
1545                                  Lib_Dir.Location);
1546                               OK := False;
1547                               exit Project_Loop;
1548                            end if;
1549                         end loop Dir_Loop;
1550                      end if;
1551                   end loop Project_Loop;
1552                end if;
1553
1554                if not OK then
1555                   Data.Library_Dir := No_Name;
1556                   Data.Display_Library_Dir := No_Name;
1557
1558                elsif Current_Verbosity = High then
1559
1560                   --  Display the Library directory in high verbosity
1561
1562                   Write_Str ("Library directory =""");
1563                   Write_Str (Get_Name_String (Data.Display_Library_Dir));
1564                   Write_Line ("""");
1565                end if;
1566             end;
1567          end if;
1568       end if;
1569
1570       pragma Assert (Lib_Name.Kind = Single);
1571
1572       if Lib_Name.Value = Empty_String then
1573          if Current_Verbosity = High
1574            and then Data.Library_Name = No_Name
1575          then
1576             Write_Line ("No library name");
1577          end if;
1578
1579       else
1580          --  There is no restriction on the syntax of library names
1581
1582          Data.Library_Name := Lib_Name.Value;
1583       end if;
1584
1585       if Data.Library_Name /= No_Name
1586         and then Current_Verbosity = High
1587       then
1588          Write_Str ("Library name = """);
1589          Write_Str (Get_Name_String (Data.Library_Name));
1590          Write_Line ("""");
1591       end if;
1592
1593       Data.Library :=
1594         Data.Library_Dir /= No_Name
1595         and then
1596       Data.Library_Name /= No_Name;
1597
1598       if Data.Library then
1599          if MLib.Tgt.Support_For_Libraries = MLib.Tgt.None then
1600             Error_Msg
1601               (Project, In_Tree,
1602                "?libraries are not supported on this platform",
1603                Lib_Name.Location);
1604             Data.Library := False;
1605
1606          else
1607             if Lib_ALI_Dir.Value = Empty_String then
1608                if Current_Verbosity = High then
1609                   Write_Line ("No library 'A'L'I directory specified");
1610                end if;
1611                Data.Library_ALI_Dir := Data.Library_Dir;
1612                Data.Display_Library_ALI_Dir := Data.Display_Library_Dir;
1613
1614             else
1615                --  Find path name, check that it is a directory
1616
1617                Locate_Directory
1618                  (Lib_ALI_Dir.Value, Data.Display_Directory,
1619                   Data.Library_ALI_Dir, Data.Display_Library_ALI_Dir);
1620
1621                if Data.Library_ALI_Dir = No_Name then
1622
1623                   --  Get the absolute name of the library ALI directory that
1624                   --  does not exist, to report an error.
1625
1626                   declare
1627                      Dir_Name : constant String :=
1628                                   Get_Name_String (Lib_ALI_Dir.Value);
1629
1630                   begin
1631                      if Is_Absolute_Path (Dir_Name) then
1632                         Err_Vars.Error_Msg_Name_1 := Lib_Dir.Value;
1633
1634                      else
1635                         Get_Name_String (Data.Display_Directory);
1636
1637                         if Name_Buffer (Name_Len) /= Directory_Separator then
1638                            Name_Len := Name_Len + 1;
1639                            Name_Buffer (Name_Len) := Directory_Separator;
1640                         end if;
1641
1642                         Name_Buffer
1643                           (Name_Len + 1 .. Name_Len + Dir_Name'Length) :=
1644                           Dir_Name;
1645                         Name_Len := Name_Len + Dir_Name'Length;
1646                         Err_Vars.Error_Msg_Name_1 := Name_Find;
1647                      end if;
1648
1649                      --  Report the error
1650
1651                      Error_Msg
1652                        (Project, In_Tree,
1653                         "library 'A'L'I directory { does not exist",
1654                         Lib_ALI_Dir.Location);
1655                   end;
1656                end if;
1657
1658                if Data.Library_ALI_Dir /= Data.Library_Dir then
1659
1660                   --  The library ALI directory cannot be the same as the
1661                   --  Object directory.
1662
1663                   if Data.Library_ALI_Dir = Data.Object_Directory then
1664                      Error_Msg
1665                        (Project, In_Tree,
1666                         "library 'A'L'I directory cannot be the same " &
1667                         "as object directory",
1668                         Lib_ALI_Dir.Location);
1669                      Data.Library_ALI_Dir := No_Name;
1670                      Data.Display_Library_ALI_Dir := No_Name;
1671
1672                   else
1673                      declare
1674                         OK       : Boolean := True;
1675                         Dirs_Id  : String_List_Id;
1676                         Dir_Elem : String_Element;
1677
1678                      begin
1679                         --  The library ALI directory cannot be the same as
1680                         --  a source directory of the current project.
1681
1682                         Dirs_Id := Data.Source_Dirs;
1683                         while Dirs_Id /= Nil_String loop
1684                            Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id);
1685                            Dirs_Id  := Dir_Elem.Next;
1686
1687                            if Data.Library_ALI_Dir = Dir_Elem.Value then
1688                               Err_Vars.Error_Msg_Name_1 := Dir_Elem.Value;
1689                               Error_Msg
1690                                 (Project, In_Tree,
1691                                  "library 'A'L'I directory cannot be " &
1692                                  "the same as source directory {",
1693                                  Lib_ALI_Dir.Location);
1694                               OK := False;
1695                               exit;
1696                            end if;
1697                         end loop;
1698
1699                         if OK then
1700
1701                            --  The library ALI directory cannot be the same as
1702                            --  a source directory of another project either.
1703
1704                            ALI_Project_Loop :
1705                            for
1706                              Pid in 1 .. Project_Table.Last (In_Tree.Projects)
1707                            loop
1708                               if Pid /= Project then
1709                                  Dirs_Id :=
1710                                    In_Tree.Projects.Table (Pid).Source_Dirs;
1711
1712                                  ALI_Dir_Loop :
1713                                  while Dirs_Id /= Nil_String loop
1714                                     Dir_Elem :=
1715                                       In_Tree.String_Elements.Table (Dirs_Id);
1716                                     Dirs_Id  := Dir_Elem.Next;
1717
1718                                     if
1719                                       Data.Library_ALI_Dir = Dir_Elem.Value
1720                                     then
1721                                        Err_Vars.Error_Msg_Name_1 :=
1722                                          Dir_Elem.Value;
1723                                        Err_Vars.Error_Msg_Name_2 :=
1724                                          In_Tree.Projects.Table (Pid).Name;
1725
1726                                        Error_Msg
1727                                          (Project, In_Tree,
1728                                           "library 'A'L'I directory cannot " &
1729                                           "be the same as source directory " &
1730                                           "{ of project {",
1731                                           Lib_ALI_Dir.Location);
1732                                        OK := False;
1733                                        exit ALI_Project_Loop;
1734                                     end if;
1735                                  end loop ALI_Dir_Loop;
1736                               end if;
1737                            end loop ALI_Project_Loop;
1738                         end if;
1739
1740                         if not OK then
1741                            Data.Library_ALI_Dir := No_Name;
1742                            Data.Display_Library_ALI_Dir := No_Name;
1743
1744                         elsif Current_Verbosity = High then
1745
1746                            --  Display the Library ALI directory in high
1747                            --  verbosity.
1748
1749                            Write_Str ("Library ALI directory =""");
1750                            Write_Str
1751                              (Get_Name_String (Data.Display_Library_ALI_Dir));
1752                            Write_Line ("""");
1753                         end if;
1754                      end;
1755                   end if;
1756                end if;
1757             end if;
1758
1759             pragma Assert (Lib_Version.Kind = Single);
1760
1761             if Lib_Version.Value = Empty_String then
1762                if Current_Verbosity = High then
1763                   Write_Line ("No library version specified");
1764                end if;
1765
1766             else
1767                Data.Lib_Internal_Name := Lib_Version.Value;
1768             end if;
1769
1770             pragma Assert (The_Lib_Kind.Kind = Single);
1771
1772             if The_Lib_Kind.Value = Empty_String then
1773                if Current_Verbosity = High then
1774                   Write_Line ("No library kind specified");
1775                end if;
1776
1777             else
1778                Get_Name_String (The_Lib_Kind.Value);
1779
1780                declare
1781                   Kind_Name : constant String :=
1782                                 To_Lower (Name_Buffer (1 .. Name_Len));
1783
1784                   OK : Boolean := True;
1785
1786                begin
1787                   if Kind_Name = "static" then
1788                      Data.Library_Kind := Static;
1789
1790                   elsif Kind_Name = "dynamic" then
1791                      Data.Library_Kind := Dynamic;
1792
1793                   elsif Kind_Name = "relocatable" then
1794                      Data.Library_Kind := Relocatable;
1795
1796                   else
1797                      Error_Msg
1798                        (Project, In_Tree,
1799                         "illegal value for Library_Kind",
1800                         The_Lib_Kind.Location);
1801                      OK := False;
1802                   end if;
1803
1804                   if Current_Verbosity = High and then OK then
1805                      Write_Str ("Library kind = ");
1806                      Write_Line (Kind_Name);
1807                   end if;
1808
1809                   if Data.Library_Kind /= Static and then
1810                     MLib.Tgt.Support_For_Libraries = MLib.Tgt.Static_Only
1811                   then
1812                      Error_Msg
1813                        (Project, In_Tree,
1814                         "only static libraries are supported " &
1815                         "on this platform",
1816                         The_Lib_Kind.Location);
1817                      Data.Library := False;
1818                   end if;
1819                end;
1820             end if;
1821
1822             if Data.Library and then Current_Verbosity = High then
1823                Write_Line ("This is a library project file");
1824             end if;
1825
1826          end if;
1827       end if;
1828    end Check_Library_Attributes;
1829
1830    --------------------------
1831    -- Check_Package_Naming --
1832    --------------------------
1833
1834    procedure Check_Package_Naming
1835      (Project : Project_Id;
1836       In_Tree : Project_Tree_Ref;
1837       Data    : in out Project_Data)
1838    is
1839       Naming_Id : constant Package_Id :=
1840                     Util.Value_Of (Name_Naming, Data.Decl.Packages, In_Tree);
1841
1842       Naming : Package_Element;
1843
1844    begin
1845       --  If there is a package Naming, we will put in Data.Naming
1846       --  what is in this package Naming.
1847
1848       if Naming_Id /= No_Package then
1849          Naming := In_Tree.Packages.Table (Naming_Id);
1850
1851          if Current_Verbosity = High then
1852             Write_Line ("Checking ""Naming"".");
1853          end if;
1854
1855          --  Check Spec_Suffix
1856
1857          declare
1858             Spec_Suffixs : Array_Element_Id :=
1859                              Util.Value_Of
1860                                (Name_Spec_Suffix,
1861                                 Naming.Decl.Arrays,
1862                                 In_Tree);
1863
1864             Suffix  : Array_Element_Id;
1865             Element : Array_Element;
1866             Suffix2 : Array_Element_Id;
1867
1868          begin
1869             --  If some suffixs have been specified, we make sure that
1870             --  for each language for which a default suffix has been
1871             --  specified, there is a suffix specified, either the one
1872             --  in the project file or if there were none, the default.
1873
1874             if Spec_Suffixs /= No_Array_Element then
1875                Suffix := Data.Naming.Spec_Suffix;
1876
1877                while Suffix /= No_Array_Element loop
1878                   Element :=
1879                     In_Tree.Array_Elements.Table (Suffix);
1880                   Suffix2 := Spec_Suffixs;
1881
1882                   while Suffix2 /= No_Array_Element loop
1883                      exit when In_Tree.Array_Elements.Table
1884                                 (Suffix2).Index = Element.Index;
1885                      Suffix2 := In_Tree.Array_Elements.Table
1886                                  (Suffix2).Next;
1887                   end loop;
1888
1889                   --  There is a registered default suffix, but no
1890                   --  suffix specified in the project file.
1891                   --  Add the default to the array.
1892
1893                   if Suffix2 = No_Array_Element then
1894                      Array_Element_Table.Increment_Last
1895                        (In_Tree.Array_Elements);
1896                      In_Tree.Array_Elements.Table
1897                        (Array_Element_Table.Last
1898                           (In_Tree.Array_Elements)) :=
1899                        (Index                => Element.Index,
1900                         Src_Index            => Element.Src_Index,
1901                         Index_Case_Sensitive => False,
1902                         Value                => Element.Value,
1903                         Next                 => Spec_Suffixs);
1904                      Spec_Suffixs := Array_Element_Table.Last
1905                                        (In_Tree.Array_Elements);
1906                   end if;
1907
1908                   Suffix := Element.Next;
1909                end loop;
1910
1911                --  Put the resulting array as the specification suffixs
1912
1913                Data.Naming.Spec_Suffix := Spec_Suffixs;
1914             end if;
1915          end;
1916
1917          declare
1918             Current : Array_Element_Id := Data.Naming.Spec_Suffix;
1919             Element : Array_Element;
1920
1921          begin
1922             while Current /= No_Array_Element loop
1923                Element := In_Tree.Array_Elements.Table (Current);
1924                Get_Name_String (Element.Value.Value);
1925
1926                if Name_Len = 0 then
1927                   Error_Msg
1928                     (Project, In_Tree,
1929                      "Spec_Suffix cannot be empty",
1930                      Element.Value.Location);
1931                end if;
1932
1933                In_Tree.Array_Elements.Table (Current) := Element;
1934                Current := Element.Next;
1935             end loop;
1936          end;
1937
1938          --  Check Body_Suffix
1939
1940          declare
1941             Impl_Suffixs : Array_Element_Id :=
1942               Util.Value_Of
1943                 (Name_Body_Suffix,
1944                  Naming.Decl.Arrays,
1945                  In_Tree);
1946
1947             Suffix       : Array_Element_Id;
1948             Element      : Array_Element;
1949             Suffix2      : Array_Element_Id;
1950
1951          begin
1952             --  If some suffixes have been specified, we make sure that
1953             --  for each language for which a default suffix has been
1954             --  specified, there is a suffix specified, either the one
1955             --  in the project file or if there were noe, the default.
1956
1957             if Impl_Suffixs /= No_Array_Element then
1958                Suffix := Data.Naming.Body_Suffix;
1959
1960                while Suffix /= No_Array_Element loop
1961                   Element :=
1962                     In_Tree.Array_Elements.Table (Suffix);
1963                   Suffix2 := Impl_Suffixs;
1964
1965                   while Suffix2 /= No_Array_Element loop
1966                      exit when In_Tree.Array_Elements.Table
1967                                 (Suffix2).Index = Element.Index;
1968                      Suffix2 := In_Tree.Array_Elements.Table
1969                                   (Suffix2).Next;
1970                   end loop;
1971
1972                   --  There is a registered default suffix, but no suffix was
1973                   --  specified in the project file. Add the default to the
1974                   --  array.
1975
1976                   if Suffix2 = No_Array_Element then
1977                      Array_Element_Table.Increment_Last
1978                        (In_Tree.Array_Elements);
1979                      In_Tree.Array_Elements.Table
1980                        (Array_Element_Table.Last
1981                           (In_Tree.Array_Elements)) :=
1982                        (Index                => Element.Index,
1983                         Src_Index            => Element.Src_Index,
1984                         Index_Case_Sensitive => False,
1985                         Value                => Element.Value,
1986                         Next                 => Impl_Suffixs);
1987                      Impl_Suffixs := Array_Element_Table.Last
1988                                        (In_Tree.Array_Elements);
1989                   end if;
1990
1991                   Suffix := Element.Next;
1992                end loop;
1993
1994                --  Put the resulting array as the implementation suffixs
1995
1996                Data.Naming.Body_Suffix := Impl_Suffixs;
1997             end if;
1998          end;
1999
2000          declare
2001             Current : Array_Element_Id := Data.Naming.Body_Suffix;
2002             Element : Array_Element;
2003
2004          begin
2005             while Current /= No_Array_Element loop
2006                Element := In_Tree.Array_Elements.Table (Current);
2007                Get_Name_String (Element.Value.Value);
2008
2009                if Name_Len = 0 then
2010                   Error_Msg
2011                     (Project, In_Tree,
2012                      "Body_Suffix cannot be empty",
2013                      Element.Value.Location);
2014                end if;
2015
2016                In_Tree.Array_Elements.Table (Current) := Element;
2017                Current := Element.Next;
2018             end loop;
2019          end;
2020
2021          --  Get the exceptions, if any
2022
2023          Data.Naming.Specification_Exceptions :=
2024            Util.Value_Of
2025              (Name_Specification_Exceptions,
2026               In_Arrays => Naming.Decl.Arrays,
2027               In_Tree   => In_Tree);
2028
2029          Data.Naming.Implementation_Exceptions :=
2030            Util.Value_Of
2031              (Name_Implementation_Exceptions,
2032               In_Arrays => Naming.Decl.Arrays,
2033               In_Tree   => In_Tree);
2034       end if;
2035    end Check_Package_Naming;
2036
2037    ---------------------------------
2038    -- Check_Programming_Languages --
2039    ---------------------------------
2040
2041    procedure Check_Programming_Languages
2042      (In_Tree : Project_Tree_Ref;
2043       Data    : in out Project_Data)
2044    is
2045       Languages : Variable_Value := Nil_Variable_Value;
2046
2047    begin
2048       Languages :=
2049         Prj.Util.Value_Of (Name_Languages, Data.Decl.Attributes, In_Tree);
2050       Data.Ada_Sources_Present   := Data.Source_Dirs /= Nil_String;
2051       Data.Other_Sources_Present := Data.Source_Dirs /= Nil_String;
2052
2053       if Data.Source_Dirs /= Nil_String then
2054
2055          --  Check if languages are specified in this project
2056
2057          if Languages.Default then
2058
2059             --  Attribute Languages is not specified. So, it defaults to
2060             --  a project of language Ada only.
2061
2062             Data.Languages (Ada_Language_Index) := True;
2063
2064             --  No sources of languages other than Ada
2065
2066             Data.Other_Sources_Present := False;
2067
2068          else
2069             declare
2070                Current   : String_List_Id := Languages.Values;
2071                Element   : String_Element;
2072                Lang_Name : Name_Id;
2073                Index     : Language_Index;
2074
2075             begin
2076                --  Assume that there is no language specified yet
2077
2078                Data.Other_Sources_Present := False;
2079                Data.Ada_Sources_Present   := False;
2080
2081                --  Look through all the languages specified in attribute
2082                --  Languages, if any
2083
2084                while Current /= Nil_String loop
2085                   Element :=
2086                     In_Tree.String_Elements.Table (Current);
2087                   Get_Name_String (Element.Value);
2088                   To_Lower (Name_Buffer (1 .. Name_Len));
2089                   Lang_Name := Name_Find;
2090                   Index := Language_Indexes.Get (Lang_Name);
2091
2092                   if Index = No_Language_Index then
2093                      Add_Language_Name (Lang_Name);
2094                      Index := Last_Language_Index;
2095                   end if;
2096
2097                   Set (Index, True, Data, In_Tree);
2098                   Set (Language_Processing => Default_Language_Processing_Data,
2099                        For_Language        => Index,
2100                        In_Project          => Data,
2101                        In_Tree             => In_Tree);
2102
2103                   if Index = Ada_Language_Index then
2104                      Data.Ada_Sources_Present := True;
2105
2106                   else
2107                      Data.Other_Sources_Present := True;
2108                   end if;
2109
2110                   Current := Element.Next;
2111                end loop;
2112             end;
2113          end if;
2114       end if;
2115    end Check_Programming_Languages;
2116
2117    -------------------
2118    -- Check_Project --
2119    -------------------
2120
2121    function Check_Project
2122      (P            : Project_Id;
2123       Root_Project : Project_Id;
2124       In_Tree      : Project_Tree_Ref;
2125       Extending    : Boolean) return Boolean
2126    is
2127    begin
2128       if P = Root_Project then
2129          return True;
2130
2131       elsif Extending then
2132          declare
2133             Data : Project_Data := In_Tree.Projects.Table (Root_Project);
2134
2135          begin
2136             while Data.Extends /= No_Project loop
2137                if P = Data.Extends then
2138                   return True;
2139                end if;
2140
2141                Data := In_Tree.Projects.Table (Data.Extends);
2142             end loop;
2143          end;
2144       end if;
2145
2146       return False;
2147    end Check_Project;
2148
2149    -------------------------------
2150    -- Check_Stand_Alone_Library --
2151    -------------------------------
2152
2153    procedure Check_Stand_Alone_Library
2154      (Project   : Project_Id;
2155       In_Tree   : Project_Tree_Ref;
2156       Data      : in out Project_Data;
2157       Extending : Boolean)
2158    is
2159       Lib_Interfaces      : constant Prj.Variable_Value :=
2160                               Prj.Util.Value_Of
2161                                 (Snames.Name_Library_Interface,
2162                                  Data.Decl.Attributes,
2163                                  In_Tree);
2164
2165       Lib_Auto_Init       : constant Prj.Variable_Value :=
2166                               Prj.Util.Value_Of
2167                                 (Snames.Name_Library_Auto_Init,
2168                                  Data.Decl.Attributes,
2169                                  In_Tree);
2170
2171       Lib_Src_Dir         : constant Prj.Variable_Value :=
2172                               Prj.Util.Value_Of
2173                                 (Snames.Name_Library_Src_Dir,
2174                                  Data.Decl.Attributes,
2175                                  In_Tree);
2176
2177       Lib_Symbol_File     : constant Prj.Variable_Value :=
2178                               Prj.Util.Value_Of
2179                                 (Snames.Name_Library_Symbol_File,
2180                                  Data.Decl.Attributes,
2181                                  In_Tree);
2182
2183       Lib_Symbol_Policy   : constant Prj.Variable_Value :=
2184                               Prj.Util.Value_Of
2185                                 (Snames.Name_Library_Symbol_Policy,
2186                                  Data.Decl.Attributes,
2187                                  In_Tree);
2188
2189       Lib_Ref_Symbol_File : constant Prj.Variable_Value :=
2190                               Prj.Util.Value_Of
2191                                 (Snames.Name_Library_Reference_Symbol_File,
2192                                  Data.Decl.Attributes,
2193                                  In_Tree);
2194
2195       Auto_Init_Supported : constant Boolean :=
2196                               MLib.Tgt.
2197                                 Standalone_Library_Auto_Init_Is_Supported;
2198
2199       OK : Boolean := True;
2200
2201    begin
2202       pragma Assert (Lib_Interfaces.Kind = List);
2203
2204       --  It is a stand-alone library project file if attribute
2205       --  Library_Interface is defined.
2206
2207       if not Lib_Interfaces.Default then
2208          SAL_Library : declare
2209             Interfaces     : String_List_Id := Lib_Interfaces.Values;
2210             Interface_ALIs : String_List_Id := Nil_String;
2211             Unit           : Name_Id;
2212             The_Unit_Id    : Unit_Id;
2213             The_Unit_Data  : Unit_Data;
2214
2215             procedure Add_ALI_For (Source : Name_Id);
2216             --  Add an ALI file name to the list of Interface ALIs
2217
2218             -----------------
2219             -- Add_ALI_For --
2220             -----------------
2221
2222             procedure Add_ALI_For (Source : Name_Id) is
2223             begin
2224                Get_Name_String (Source);
2225
2226                declare
2227                   ALI         : constant String :=
2228                     ALI_File_Name (Name_Buffer (1 .. Name_Len));
2229                   ALI_Name_Id : Name_Id;
2230                begin
2231                   Name_Len := ALI'Length;
2232                   Name_Buffer (1 .. Name_Len) := ALI;
2233                   ALI_Name_Id := Name_Find;
2234
2235                   String_Element_Table.Increment_Last
2236                     (In_Tree.String_Elements);
2237                   In_Tree.String_Elements.Table
2238                     (String_Element_Table.Last
2239                       (In_Tree.String_Elements)) :=
2240                     (Value         => ALI_Name_Id,
2241                      Index         => 0,
2242                      Display_Value => ALI_Name_Id,
2243                      Location      =>
2244                        In_Tree.String_Elements.Table
2245                          (Interfaces).Location,
2246                      Flag          => False,
2247                      Next          => Interface_ALIs);
2248                   Interface_ALIs := String_Element_Table.Last
2249                                       (In_Tree.String_Elements);
2250                end;
2251             end Add_ALI_For;
2252
2253          --  Start of processing for SAL_Library
2254
2255          begin
2256             Data.Standalone_Library := True;
2257
2258             --  Library_Interface cannot be an empty list
2259
2260             if Interfaces = Nil_String then
2261                Error_Msg
2262                  (Project, In_Tree,
2263                   "Library_Interface cannot be an empty list",
2264                   Lib_Interfaces.Location);
2265             end if;
2266
2267             --  Process each unit name specified in the attribute
2268             --  Library_Interface.
2269
2270             while Interfaces /= Nil_String loop
2271                Get_Name_String
2272                  (In_Tree.String_Elements.Table
2273                                                      (Interfaces).Value);
2274                To_Lower (Name_Buffer (1 .. Name_Len));
2275
2276                if Name_Len = 0 then
2277                   Error_Msg
2278                     (Project, In_Tree,
2279                      "an interface cannot be an empty string",
2280                      In_Tree.String_Elements.Table
2281                                                    (Interfaces).Location);
2282
2283                else
2284                   Unit := Name_Find;
2285                   Error_Msg_Name_1 := Unit;
2286                   The_Unit_Id :=
2287                     Units_Htable.Get (In_Tree.Units_HT, Unit);
2288
2289                   if The_Unit_Id = No_Unit then
2290                      Error_Msg
2291                        (Project, In_Tree,
2292                         "unknown unit {",
2293                         In_Tree.String_Elements.Table
2294                           (Interfaces).Location);
2295
2296                   else
2297                      --  Check that the unit is part of the project
2298
2299                      The_Unit_Data :=
2300                        In_Tree.Units.Table (The_Unit_Id);
2301
2302                      if The_Unit_Data.File_Names (Body_Part).Name /= No_Name
2303                        and then The_Unit_Data.File_Names (Body_Part).Path /=
2304                                                                         Slash
2305                      then
2306                         if Check_Project
2307                           (The_Unit_Data.File_Names (Body_Part).Project,
2308                            Project, In_Tree, Extending)
2309                         then
2310                            --  There is a body for this unit.
2311                            --  If there is no spec, we need to check
2312                            --  that it is not a subunit.
2313
2314                            if The_Unit_Data.File_Names
2315                              (Specification).Name = No_Name
2316                            then
2317                               declare
2318                                  Src_Ind : Source_File_Index;
2319
2320                               begin
2321                                  Src_Ind := Sinput.P.Load_Project_File
2322                                    (Get_Name_String
2323                                       (The_Unit_Data.File_Names
2324                                          (Body_Part).Path));
2325
2326                                  if Sinput.P.Source_File_Is_Subunit
2327                                    (Src_Ind)
2328                                  then
2329                                     Error_Msg
2330                                       (Project, In_Tree,
2331                                        "{ is a subunit; " &
2332                                        "it cannot be an interface",
2333                                        In_Tree.
2334                                          String_Elements.Table
2335                                            (Interfaces).Location);
2336                                  end if;
2337                               end;
2338                            end if;
2339
2340                            --  The unit is not a subunit, so we add
2341                            --  to the Interface ALIs the ALI file
2342                            --  corresponding to the body.
2343
2344                            Add_ALI_For
2345                              (The_Unit_Data.File_Names (Body_Part).Name);
2346
2347                         else
2348                            Error_Msg
2349                              (Project, In_Tree,
2350                               "{ is not an unit of this project",
2351                               In_Tree.String_Elements.Table
2352                                 (Interfaces).Location);
2353                         end if;
2354
2355                      elsif The_Unit_Data.File_Names
2356                        (Specification).Name /= No_Name
2357                        and then The_Unit_Data.File_Names
2358                          (Specification).Path /= Slash
2359                        and then Check_Project
2360                          (The_Unit_Data.File_Names
2361                               (Specification).Project,
2362                           Project, In_Tree, Extending)
2363
2364                      then
2365                         --  The unit is part of the project, it has
2366                         --  a spec, but no body. We add to the Interface
2367                         --  ALIs the ALI file corresponding to the spec.
2368
2369                         Add_ALI_For
2370                           (The_Unit_Data.File_Names (Specification).Name);
2371
2372                      else
2373                         Error_Msg
2374                           (Project, In_Tree,
2375                            "{ is not an unit of this project",
2376                            In_Tree.String_Elements.Table
2377                                                     (Interfaces).Location);
2378                      end if;
2379                   end if;
2380
2381                end if;
2382
2383                Interfaces :=
2384                  In_Tree.String_Elements.Table (Interfaces).Next;
2385             end loop;
2386
2387             --  Put the list of Interface ALIs in the project data
2388
2389             Data.Lib_Interface_ALIs := Interface_ALIs;
2390
2391             --  Check value of attribute Library_Auto_Init and set
2392             --  Lib_Auto_Init accordingly.
2393
2394             if Lib_Auto_Init.Default then
2395
2396                --  If no attribute Library_Auto_Init is declared, then
2397                --  set auto init only if it is supported.
2398
2399                Data.Lib_Auto_Init := Auto_Init_Supported;
2400
2401             else
2402                Get_Name_String (Lib_Auto_Init.Value);
2403                To_Lower (Name_Buffer (1 .. Name_Len));
2404
2405                if Name_Buffer (1 .. Name_Len) = "false" then
2406                   Data.Lib_Auto_Init := False;
2407
2408                elsif Name_Buffer (1 .. Name_Len) = "true" then
2409                   if Auto_Init_Supported then
2410                      Data.Lib_Auto_Init := True;
2411
2412                   else
2413                      --  Library_Auto_Init cannot be "true" if auto init
2414                      --  is not supported
2415
2416                      Error_Msg
2417                        (Project, In_Tree,
2418                         "library auto init not supported " &
2419                         "on this platform",
2420                         Lib_Auto_Init.Location);
2421                   end if;
2422
2423                else
2424                   Error_Msg
2425                     (Project, In_Tree,
2426                      "invalid value for attribute Library_Auto_Init",
2427                      Lib_Auto_Init.Location);
2428                end if;
2429             end if;
2430          end SAL_Library;
2431
2432          --  If attribute Library_Src_Dir is defined and not the
2433          --  empty string, check if the directory exist and is not
2434          --  the object directory or one of the source directories.
2435          --  This is the directory where copies of the interface
2436          --  sources will be copied. Note that this directory may be
2437          --  the library directory.
2438
2439          if Lib_Src_Dir.Value /= Empty_String then
2440             declare
2441                Dir_Id : constant Name_Id := Lib_Src_Dir.Value;
2442
2443             begin
2444                Locate_Directory
2445                  (Dir_Id, Data.Display_Directory,
2446                   Data.Library_Src_Dir,
2447                   Data.Display_Library_Src_Dir);
2448
2449                --  If directory does not exist, report an error
2450
2451                if Data.Library_Src_Dir = No_Name then
2452
2453                   --  Get the absolute name of the library directory
2454                   --  that does not exist, to report an error.
2455
2456                   declare
2457                      Dir_Name : constant String :=
2458                        Get_Name_String (Dir_Id);
2459
2460                   begin
2461                      if Is_Absolute_Path (Dir_Name) then
2462                         Err_Vars.Error_Msg_Name_1 := Dir_Id;
2463
2464                      else
2465                         Get_Name_String (Data.Directory);
2466
2467                         if Name_Buffer (Name_Len) /=
2468                           Directory_Separator
2469                         then
2470                            Name_Len := Name_Len + 1;
2471                            Name_Buffer (Name_Len) :=
2472                              Directory_Separator;
2473                         end if;
2474
2475                         Name_Buffer
2476                           (Name_Len + 1 ..
2477                              Name_Len + Dir_Name'Length) :=
2478                             Dir_Name;
2479                         Name_Len := Name_Len + Dir_Name'Length;
2480                         Err_Vars.Error_Msg_Name_1 := Name_Find;
2481                      end if;
2482
2483                      --  Report the error
2484
2485                      Error_Msg
2486                        (Project, In_Tree,
2487                         "Directory { does not exist",
2488                         Lib_Src_Dir.Location);
2489                   end;
2490
2491                   --  Report an error if it is the same as the object
2492                   --  directory.
2493
2494                elsif Data.Library_Src_Dir = Data.Object_Directory then
2495                   Error_Msg
2496                     (Project, In_Tree,
2497                      "directory to copy interfaces cannot be " &
2498                      "the object directory",
2499                      Lib_Src_Dir.Location);
2500                   Data.Library_Src_Dir := No_Name;
2501
2502                else
2503                   declare
2504                      Src_Dirs : String_List_Id;
2505                      Src_Dir  : String_Element;
2506
2507                   begin
2508                      --  Interface copy directory cannot be one of the source
2509                      --  directory of the current project.
2510
2511                      Src_Dirs := Data.Source_Dirs;
2512                      while Src_Dirs /= Nil_String loop
2513                         Src_Dir := In_Tree.String_Elements.Table
2514                                                           (Src_Dirs);
2515
2516                         --  Report error if it is one of the source directories
2517
2518                         if Data.Library_Src_Dir = Src_Dir.Value then
2519                            Error_Msg
2520                              (Project, In_Tree,
2521                               "directory to copy interfaces cannot " &
2522                               "be one of the source directories",
2523                               Lib_Src_Dir.Location);
2524                            Data.Library_Src_Dir := No_Name;
2525                            exit;
2526                         end if;
2527
2528                         Src_Dirs := Src_Dir.Next;
2529                      end loop;
2530
2531                      if Data.Library_Src_Dir /= No_Name then
2532
2533                         --  It cannot be a source directory of any other
2534                         --  project either.
2535
2536                         Project_Loop : for Pid in 1 ..
2537                           Project_Table.Last (In_Tree.Projects)
2538                         loop
2539                            Src_Dirs :=
2540                              In_Tree.Projects.Table (Pid).Source_Dirs;
2541                            Dir_Loop : while Src_Dirs /= Nil_String loop
2542                               Src_Dir :=
2543                                 In_Tree.String_Elements.Table (Src_Dirs);
2544
2545                               --  Report error if it is one of the source
2546                               --  directories
2547
2548                               if Data.Library_Src_Dir = Src_Dir.Value then
2549                                  Error_Msg_Name_1 := Src_Dir.Value;
2550                                  Error_Msg_Name_2 :=
2551                                    In_Tree.Projects.Table (Pid).Name;
2552                                  Error_Msg
2553                                    (Project, In_Tree,
2554                                     "directory to copy interfaces cannot " &
2555                                     "be the same as source directory { of " &
2556                                     "project {",
2557                                     Lib_Src_Dir.Location);
2558                                  Data.Library_Src_Dir := No_Name;
2559                                  exit Project_Loop;
2560                               end if;
2561
2562                               Src_Dirs := Src_Dir.Next;
2563                            end loop Dir_Loop;
2564                         end loop Project_Loop;
2565                      end if;
2566                   end;
2567
2568                   --  In high verbosity, if there is a valid Library_Src_Dir,
2569                   --  display its path name.
2570
2571                   if Data.Library_Src_Dir /= No_Name
2572                     and then Current_Verbosity = High
2573                   then
2574                      Write_Str ("Directory to copy interfaces =""");
2575                      Write_Str (Get_Name_String (Data.Library_Src_Dir));
2576                      Write_Line ("""");
2577                   end if;
2578                end if;
2579             end;
2580          end if;
2581
2582          --  Check the symbol related attributes
2583
2584          --  First, the symbol policy
2585
2586          if not Lib_Symbol_Policy.Default then
2587             declare
2588                Value : constant String :=
2589                  To_Lower
2590                    (Get_Name_String (Lib_Symbol_Policy.Value));
2591
2592             begin
2593                --  Symbol policy must hove one of a limited number of values
2594
2595                if Value = "autonomous" or else Value = "default" then
2596                   Data.Symbol_Data.Symbol_Policy := Autonomous;
2597
2598                elsif Value = "compliant" then
2599                   Data.Symbol_Data.Symbol_Policy := Compliant;
2600
2601                elsif Value = "controlled" then
2602                   Data.Symbol_Data.Symbol_Policy := Controlled;
2603
2604                elsif Value = "restricted" then
2605                   Data.Symbol_Data.Symbol_Policy := Restricted;
2606
2607                else
2608                   Error_Msg
2609                     (Project, In_Tree,
2610                      "illegal value for Library_Symbol_Policy",
2611                      Lib_Symbol_Policy.Location);
2612                end if;
2613             end;
2614          end if;
2615
2616          --  If attribute Library_Symbol_File is not specified, symbol policy
2617          --  cannot be Restricted.
2618
2619          if Lib_Symbol_File.Default then
2620             if Data.Symbol_Data.Symbol_Policy = Restricted then
2621                Error_Msg
2622                  (Project, In_Tree,
2623                   "Library_Symbol_File needs to be defined when " &
2624                   "symbol policy is Restricted",
2625                   Lib_Symbol_Policy.Location);
2626             end if;
2627
2628          else
2629             --  Library_Symbol_File is defined. Check that the file exists
2630
2631             Data.Symbol_Data.Symbol_File := Lib_Symbol_File.Value;
2632
2633             Get_Name_String (Lib_Symbol_File.Value);
2634
2635             if Name_Len = 0 then
2636                Error_Msg
2637                  (Project, In_Tree,
2638                   "symbol file name cannot be an empty string",
2639                   Lib_Symbol_File.Location);
2640
2641             else
2642                OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len));
2643
2644                if OK then
2645                   for J in 1 .. Name_Len loop
2646                      if Name_Buffer (J) = '/'
2647                        or else Name_Buffer (J) = Directory_Separator
2648                      then
2649                         OK := False;
2650                         exit;
2651                      end if;
2652                   end loop;
2653                end if;
2654
2655                if not OK then
2656                   Error_Msg_Name_1 := Lib_Symbol_File.Value;
2657                   Error_Msg
2658                     (Project, In_Tree,
2659                      "symbol file name { is illegal. " &
2660                      "Name canot include directory info.",
2661                      Lib_Symbol_File.Location);
2662                end if;
2663             end if;
2664          end if;
2665
2666          --  If attribute Library_Reference_Symbol_File is not defined,
2667          --  symbol policy cannot be Compilant or Controlled.
2668
2669          if Lib_Ref_Symbol_File.Default then
2670             if Data.Symbol_Data.Symbol_Policy = Compliant
2671               or else Data.Symbol_Data.Symbol_Policy = Controlled
2672             then
2673                Error_Msg
2674                  (Project, In_Tree,
2675                   "a reference symbol file need to be defined",
2676                   Lib_Symbol_Policy.Location);
2677             end if;
2678
2679          else
2680             --  Library_Reference_Symbol_File is defined, check file exists
2681
2682             Data.Symbol_Data.Reference := Lib_Ref_Symbol_File.Value;
2683
2684             Get_Name_String (Lib_Ref_Symbol_File.Value);
2685
2686             if Name_Len = 0 then
2687                Error_Msg
2688                  (Project, In_Tree,
2689                   "reference symbol file name cannot be an empty string",
2690                   Lib_Symbol_File.Location);
2691
2692             else
2693                OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len));
2694
2695                if OK then
2696                   for J in 1 .. Name_Len loop
2697                      if Name_Buffer (J) = '/'
2698                        or else Name_Buffer (J) = Directory_Separator
2699                      then
2700                         OK := False;
2701                         exit;
2702                      end if;
2703                   end loop;
2704                end if;
2705
2706                if not OK then
2707                   Error_Msg_Name_1 := Lib_Ref_Symbol_File.Value;
2708                   Error_Msg
2709                     (Project, In_Tree,
2710                      "reference symbol file { name is illegal. " &
2711                      "Name canot include directory info.",
2712                      Lib_Ref_Symbol_File.Location);
2713                end if;
2714
2715                if not Is_Regular_File
2716                  (Get_Name_String (Data.Object_Directory) &
2717                   Directory_Separator &
2718                   Get_Name_String (Lib_Ref_Symbol_File.Value))
2719                then
2720                   Error_Msg_Name_1 := Lib_Ref_Symbol_File.Value;
2721
2722                   --  For controlled symbol policy, it is an error if the
2723                   --  reference symbol file does not exist. For other symbol
2724                   --  policies, this is just a warning
2725
2726                   Error_Msg_Warn :=
2727                     Data.Symbol_Data.Symbol_Policy /= Controlled;
2728
2729                   Error_Msg
2730                     (Project, In_Tree,
2731                      "<library reference symbol file { does not exist",
2732                      Lib_Ref_Symbol_File.Location);
2733
2734                   --  In addition in the non-controlled case, if symbol policy
2735                   --  is Compliant, it is changed to Autonomous, because there
2736                   --  is no reference to check against, and we don't want to
2737                   --  fail in this case.
2738
2739                   if Data.Symbol_Data.Symbol_Policy /= Controlled then
2740                      if Data.Symbol_Data.Symbol_Policy = Compliant then
2741                         Data.Symbol_Data.Symbol_Policy := Autonomous;
2742                      end if;
2743                   end if;
2744                end if;
2745             end if;
2746          end if;
2747       end if;
2748    end Check_Stand_Alone_Library;
2749
2750    ----------------------------
2751    -- Compute_Directory_Last --
2752    ----------------------------
2753
2754    function Compute_Directory_Last (Dir : String) return Natural is
2755    begin
2756       if Dir'Length > 1
2757         and then (Dir (Dir'Last - 1) = Directory_Separator
2758                   or else Dir (Dir'Last - 1) = '/')
2759       then
2760          return Dir'Last - 1;
2761       else
2762          return Dir'Last;
2763       end if;
2764    end Compute_Directory_Last;
2765
2766    --------------------
2767    -- Body_Suffix_Of --
2768    --------------------
2769
2770    function Body_Suffix_Of
2771      (Language   : Language_Index;
2772       In_Project : Project_Data;
2773       In_Tree    : Project_Tree_Ref) return String
2774    is
2775       Suffix_Id : constant Name_Id :=
2776                     Suffix_Of (Language, In_Project, In_Tree);
2777    begin
2778       if Suffix_Id /= No_Name then
2779          return Get_Name_String (Suffix_Id);
2780       else
2781          return "." & Get_Name_String (Language_Names.Table (Language));
2782       end if;
2783    end Body_Suffix_Of;
2784
2785    ---------------
2786    -- Error_Msg --
2787    ---------------
2788
2789    procedure Error_Msg
2790      (Project       : Project_Id;
2791       In_Tree       : Project_Tree_Ref;
2792       Msg           : String;
2793       Flag_Location : Source_Ptr)
2794    is
2795       Error_Buffer : String (1 .. 5_000);
2796       Error_Last   : Natural := 0;
2797       Msg_Name     : Natural := 0;
2798       First        : Positive := Msg'First;
2799
2800       procedure Add (C : Character);
2801       --  Add a character to the buffer
2802
2803       procedure Add (S : String);
2804       --  Add a string to the buffer
2805
2806       procedure Add (Id : Name_Id);
2807       --  Add a name to the buffer
2808
2809       ---------
2810       -- Add --
2811       ---------
2812
2813       procedure Add (C : Character) is
2814       begin
2815          Error_Last := Error_Last + 1;
2816          Error_Buffer (Error_Last) := C;
2817       end Add;
2818
2819       procedure Add (S : String) is
2820       begin
2821          Error_Buffer (Error_Last + 1 .. Error_Last + S'Length) := S;
2822          Error_Last := Error_Last + S'Length;
2823       end Add;
2824
2825       procedure Add (Id : Name_Id) is
2826       begin
2827          Get_Name_String (Id);
2828          Add (Name_Buffer (1 .. Name_Len));
2829       end Add;
2830
2831    --  Start of processing for Error_Msg
2832
2833    begin
2834       if Error_Report = null then
2835          Prj.Err.Error_Msg (Msg, Flag_Location);
2836          return;
2837       end if;
2838
2839       --  Ignore continuation character
2840
2841       if Msg (First) = '\' then
2842          First := First + 1;
2843
2844          --  Warniung character is always the first one in this package
2845          --  this is an undoocumented kludge!!!
2846
2847       elsif Msg (First) = '?' then
2848          First := First + 1;
2849          Add ("Warning: ");
2850
2851       elsif Msg (First) = '<' then
2852          First := First + 1;
2853
2854          if Err_Vars.Error_Msg_Warn then
2855             Add ("Warning: ");
2856          end if;
2857       end if;
2858
2859       for Index in First .. Msg'Last loop
2860          if Msg (Index) = '{' or else Msg (Index) = '%' then
2861
2862             --  Include a name between double quotes
2863
2864             Msg_Name := Msg_Name + 1;
2865             Add ('"');
2866
2867             case Msg_Name is
2868                when 1 => Add (Err_Vars.Error_Msg_Name_1);
2869                when 2 => Add (Err_Vars.Error_Msg_Name_2);
2870                when 3 => Add (Err_Vars.Error_Msg_Name_3);
2871
2872                when others => null;
2873             end case;
2874
2875             Add ('"');
2876
2877          else
2878             Add (Msg (Index));
2879          end if;
2880
2881       end loop;
2882
2883       Error_Report (Error_Buffer (1 .. Error_Last), Project, In_Tree);
2884    end Error_Msg;
2885
2886    ------------------
2887    -- Find_Sources --
2888    ------------------
2889
2890    procedure Find_Sources
2891      (Project      : Project_Id;
2892       In_Tree      : Project_Tree_Ref;
2893       Data         : in out Project_Data;
2894       For_Language : Language_Index;
2895       Follow_Links : Boolean := False)
2896    is
2897       Source_Dir      : String_List_Id := Data.Source_Dirs;
2898       Element         : String_Element;
2899       Dir             : Dir_Type;
2900       Current_Source  : String_List_Id := Nil_String;
2901       Source_Recorded : Boolean := False;
2902
2903    begin
2904       if Current_Verbosity = High then
2905          Write_Line ("Looking for sources:");
2906       end if;
2907
2908       --  For each subdirectory
2909
2910       while Source_Dir /= Nil_String loop
2911          begin
2912             Source_Recorded := False;
2913             Element := In_Tree.String_Elements.Table (Source_Dir);
2914             if Element.Value /= No_Name then
2915                Get_Name_String (Element.Display_Value);
2916
2917                declare
2918                   Source_Directory : constant String :=
2919                     Name_Buffer (1 .. Name_Len) & Directory_Separator;
2920                   Dir_Last  : constant Natural :=
2921                      Compute_Directory_Last (Source_Directory);
2922
2923                begin
2924                   if Current_Verbosity = High then
2925                      Write_Str ("Source_Dir = ");
2926                      Write_Line (Source_Directory);
2927                   end if;
2928
2929                   --  We look to every entry in the source directory
2930
2931                   Open (Dir, Source_Directory
2932                                (Source_Directory'First .. Dir_Last));
2933
2934                   loop
2935                      Read (Dir, Name_Buffer, Name_Len);
2936
2937                      if Current_Verbosity = High then
2938                         Write_Str  ("   Checking ");
2939                         Write_Line (Name_Buffer (1 .. Name_Len));
2940                      end if;
2941
2942                      exit when Name_Len = 0;
2943
2944                      declare
2945                         File_Name : constant Name_Id := Name_Find;
2946                         Path      : constant String :=
2947                           Normalize_Pathname
2948                             (Name      => Name_Buffer (1 .. Name_Len),
2949                              Directory => Source_Directory
2950                                (Source_Directory'First .. Dir_Last),
2951                              Resolve_Links => Follow_Links,
2952                              Case_Sensitive => True);
2953                         Path_Name : Name_Id;
2954
2955                      begin
2956                         Name_Len := Path'Length;
2957                         Name_Buffer (1 .. Name_Len) := Path;
2958                         Path_Name := Name_Find;
2959
2960                         if For_Language = Ada_Language_Index then
2961
2962                            --  We attempt to register it as a source. However,
2963                            --  there is no error if the file does not contain
2964                            --  a valid source. But there is an error if we have
2965                            --  a duplicate unit name.
2966
2967                            Record_Ada_Source
2968                              (File_Name       => File_Name,
2969                               Path_Name       => Path_Name,
2970                               Project         => Project,
2971                               In_Tree         => In_Tree,
2972                               Data            => Data,
2973                               Location        => No_Location,
2974                               Current_Source  => Current_Source,
2975                               Source_Recorded => Source_Recorded,
2976                               Follow_Links    => Follow_Links);
2977
2978                         else
2979                            Check_For_Source
2980                              (File_Name        => File_Name,
2981                               Path_Name        => Path_Name,
2982                               Project          => Project,
2983                               In_Tree          => In_Tree,
2984                               Data             => Data,
2985                               Location         => No_Location,
2986                               Language         => For_Language,
2987                               Suffix           =>
2988                                 Body_Suffix_Of (For_Language, Data, In_Tree),
2989                               Naming_Exception => False);
2990                         end if;
2991                      end;
2992                   end loop;
2993
2994                   Close (Dir);
2995                end;
2996             end if;
2997
2998          exception
2999             when Directory_Error =>
3000                null;
3001          end;
3002
3003          if Source_Recorded then
3004             In_Tree.String_Elements.Table (Source_Dir).Flag :=
3005               True;
3006          end if;
3007
3008          Source_Dir := Element.Next;
3009       end loop;
3010
3011       if Current_Verbosity = High then
3012          Write_Line ("end Looking for sources.");
3013       end if;
3014
3015       if For_Language = Ada_Language_Index then
3016
3017          --  If we have looked for sources and found none, then
3018          --  it is an error, except if it is an extending project.
3019          --  If a non extending project is not supposed to contain
3020          --  any source, then we never call Find_Sources.
3021
3022          if Current_Source /= Nil_String then
3023             Data.Ada_Sources_Present := True;
3024
3025          elsif Data.Extends = No_Project then
3026             Error_Msg
3027               (Project, In_Tree,
3028                "there are no Ada sources in this project",
3029                Data.Location);
3030          end if;
3031       end if;
3032    end Find_Sources;
3033
3034    --------------------------------
3035    -- Free_Ada_Naming_Exceptions --
3036    --------------------------------
3037
3038    procedure Free_Ada_Naming_Exceptions is
3039    begin
3040       Ada_Naming_Exception_Table.Set_Last (0);
3041       Ada_Naming_Exceptions.Reset;
3042       Reverse_Ada_Naming_Exceptions.Reset;
3043    end Free_Ada_Naming_Exceptions;
3044
3045    ---------------------
3046    -- Get_Directories --
3047    ---------------------
3048
3049    procedure Get_Directories
3050      (Project : Project_Id;
3051       In_Tree : Project_Tree_Ref;
3052       Data    : in out Project_Data)
3053    is
3054       Object_Dir : constant Variable_Value :=
3055                      Util.Value_Of
3056                        (Name_Object_Dir, Data.Decl.Attributes, In_Tree);
3057
3058       Exec_Dir   : constant Variable_Value :=
3059                      Util.Value_Of
3060                        (Name_Exec_Dir, Data.Decl.Attributes, In_Tree);
3061
3062       Source_Dirs : constant Variable_Value :=
3063                       Util.Value_Of
3064                         (Name_Source_Dirs, Data.Decl.Attributes, In_Tree);
3065
3066       Last_Source_Dir : String_List_Id  := Nil_String;
3067
3068       procedure Find_Source_Dirs (From : Name_Id; Location : Source_Ptr);
3069       --  Find one or several source directories, and add them
3070       --  to the list of source directories of the project.
3071
3072       ----------------------
3073       -- Find_Source_Dirs --
3074       ----------------------
3075
3076       procedure Find_Source_Dirs (From : Name_Id; Location : Source_Ptr) is
3077          Directory : constant String := Get_Name_String (From);
3078          Element   : String_Element;
3079
3080          procedure Recursive_Find_Dirs (Path : Name_Id);
3081          --  Find all the subdirectories (recursively) of Path and add them
3082          --  to the list of source directories of the project.
3083
3084          -------------------------
3085          -- Recursive_Find_Dirs --
3086          -------------------------
3087
3088          procedure Recursive_Find_Dirs (Path : Name_Id) is
3089             Dir      : Dir_Type;
3090             Name     : String (1 .. 250);
3091             Last     : Natural;
3092             List     : String_List_Id := Data.Source_Dirs;
3093             Element  : String_Element;
3094             Found    : Boolean := False;
3095
3096             Non_Canonical_Path : Name_Id := No_Name;
3097             Canonical_Path     : Name_Id := No_Name;
3098
3099             The_Path : constant String :=
3100                          Normalize_Pathname (Get_Name_String (Path)) &
3101                          Directory_Separator;
3102
3103             The_Path_Last : constant Natural :=
3104                               Compute_Directory_Last (The_Path);
3105
3106          begin
3107             Name_Len := The_Path_Last - The_Path'First + 1;
3108             Name_Buffer (1 .. Name_Len) :=
3109               The_Path (The_Path'First .. The_Path_Last);
3110             Non_Canonical_Path := Name_Find;
3111             Get_Name_String (Non_Canonical_Path);
3112             Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3113             Canonical_Path := Name_Find;
3114
3115             --  To avoid processing the same directory several times, check
3116             --  if the directory is already in Recursive_Dirs. If it is,
3117             --  then there is nothing to do, just return. If it is not, put
3118             --  it there and continue recursive processing.
3119
3120             if Recursive_Dirs.Get (Canonical_Path) then
3121                return;
3122
3123             else
3124                Recursive_Dirs.Set (Canonical_Path, True);
3125             end if;
3126
3127             --  Check if directory is already in list
3128
3129             while List /= Nil_String loop
3130                Element := In_Tree.String_Elements.Table (List);
3131
3132                if Element.Value /= No_Name then
3133                   Found := Element.Value = Canonical_Path;
3134                   exit when Found;
3135                end if;
3136
3137                List := Element.Next;
3138             end loop;
3139
3140             --  If directory is not already in list, put it there
3141
3142             if not Found then
3143                if Current_Verbosity = High then
3144                   Write_Str  ("   ");
3145                   Write_Line (The_Path (The_Path'First .. The_Path_Last));
3146                end if;
3147
3148                String_Element_Table.Increment_Last
3149                  (In_Tree.String_Elements);
3150                Element :=
3151                  (Value    => Canonical_Path,
3152                   Display_Value => Non_Canonical_Path,
3153                   Location => No_Location,
3154                   Flag     => False,
3155                   Next     => Nil_String,
3156                   Index    => 0);
3157
3158                --  Case of first source directory
3159
3160                if Last_Source_Dir = Nil_String then
3161                   Data.Source_Dirs := String_Element_Table.Last
3162                                         (In_Tree.String_Elements);
3163
3164                   --  Here we already have source directories
3165
3166                else
3167                   --  Link the previous last to the new one
3168
3169                   In_Tree.String_Elements.Table
3170                     (Last_Source_Dir).Next :=
3171                       String_Element_Table.Last
3172                         (In_Tree.String_Elements);
3173                end if;
3174
3175                --  And register this source directory as the new last
3176
3177                Last_Source_Dir  := String_Element_Table.Last
3178                  (In_Tree.String_Elements);
3179                In_Tree.String_Elements.Table (Last_Source_Dir) :=
3180                  Element;
3181             end if;
3182
3183             --  Now look for subdirectories. We do that even when this
3184             --  directory is already in the list, because some of its
3185             --  subdirectories may not be in the list yet.
3186
3187             Open (Dir, The_Path (The_Path'First .. The_Path_Last));
3188
3189             loop
3190                Read (Dir, Name, Last);
3191                exit when Last = 0;
3192
3193                if Name (1 .. Last) /= "."
3194                  and then Name (1 .. Last) /= ".."
3195                then
3196                   --  Avoid . and .. directories
3197
3198                   if Current_Verbosity = High then
3199                      Write_Str  ("   Checking ");
3200                      Write_Line (Name (1 .. Last));
3201                   end if;
3202
3203                   declare
3204                      Path_Name : constant String :=
3205                                    Normalize_Pathname
3206                                      (Name      => Name (1 .. Last),
3207                                       Directory =>
3208                                         The_Path
3209                                           (The_Path'First .. The_Path_Last),
3210                                       Resolve_Links  => False,
3211                                       Case_Sensitive => True);
3212
3213                   begin
3214                      if Is_Directory (Path_Name) then
3215
3216                         --  We have found a new subdirectory, call self
3217
3218                         Name_Len := Path_Name'Length;
3219                         Name_Buffer (1 .. Name_Len) := Path_Name;
3220                         Recursive_Find_Dirs (Name_Find);
3221                      end if;
3222                   end;
3223                end if;
3224             end loop;
3225
3226             Close (Dir);
3227
3228          exception
3229             when Directory_Error =>
3230                null;
3231          end Recursive_Find_Dirs;
3232
3233       --  Start of processing for Find_Source_Dirs
3234
3235       begin
3236          if Current_Verbosity = High then
3237             Write_Str ("Find_Source_Dirs (""");
3238             Write_Str (Directory);
3239             Write_Line (""")");
3240          end if;
3241
3242          --  First, check if we are looking for a directory tree,
3243          --  indicated by "/**" at the end.
3244
3245          if Directory'Length >= 3
3246            and then Directory (Directory'Last - 1 .. Directory'Last) = "**"
3247            and then (Directory (Directory'Last - 2) = '/'
3248                        or else
3249                      Directory (Directory'Last - 2) = Directory_Separator)
3250          then
3251             Data.Known_Order_Of_Source_Dirs := False;
3252
3253             Name_Len := Directory'Length - 3;
3254
3255             if Name_Len = 0 then
3256
3257                --  This is the case of "/**": all directories
3258                --  in the file system.
3259
3260                Name_Len := 1;
3261                Name_Buffer (1) := Directory (Directory'First);
3262
3263             else
3264                Name_Buffer (1 .. Name_Len) :=
3265                  Directory (Directory'First .. Directory'Last - 3);
3266             end if;
3267
3268             if Current_Verbosity = High then
3269                Write_Str ("Looking for all subdirectories of """);
3270                Write_Str (Name_Buffer (1 .. Name_Len));
3271                Write_Line ("""");
3272             end if;
3273
3274             declare
3275                Base_Dir : constant Name_Id := Name_Find;
3276                Root_Dir : constant String :=
3277                             Normalize_Pathname
3278                               (Name      => Get_Name_String (Base_Dir),
3279                                Directory =>
3280                                  Get_Name_String (Data.Display_Directory),
3281                                Resolve_Links  => False,
3282                                Case_Sensitive => True);
3283
3284             begin
3285                if Root_Dir'Length = 0 then
3286                   Err_Vars.Error_Msg_Name_1 := Base_Dir;
3287
3288                   if Location = No_Location then
3289                      Error_Msg
3290                        (Project, In_Tree,
3291                         "{ is not a valid directory.",
3292                         Data.Location);
3293                   else
3294                      Error_Msg
3295                        (Project, In_Tree,
3296                         "{ is not a valid directory.",
3297                         Location);
3298                   end if;
3299
3300                else
3301                   --  We have an existing directory, we register it and all
3302                   --  of its subdirectories.
3303
3304                   if Current_Verbosity = High then
3305                      Write_Line ("Looking for source directories:");
3306                   end if;
3307
3308                   Name_Len := Root_Dir'Length;
3309                   Name_Buffer (1 .. Name_Len) := Root_Dir;
3310                   Recursive_Find_Dirs (Name_Find);
3311
3312                   if Current_Verbosity = High then
3313                      Write_Line ("End of looking for source directories.");
3314                   end if;
3315                end if;
3316             end;
3317
3318          --  We have a single directory
3319
3320          else
3321             declare
3322                Path_Name         : Name_Id;
3323                Display_Path_Name : Name_Id;
3324
3325             begin
3326                Locate_Directory
3327                  (From, Data.Display_Directory, Path_Name, Display_Path_Name);
3328
3329                if Path_Name = No_Name then
3330                   Err_Vars.Error_Msg_Name_1 := From;
3331
3332                   if Location = No_Location then
3333                      Error_Msg
3334                        (Project, In_Tree,
3335                         "{ is not a valid directory",
3336                         Data.Location);
3337                   else
3338                      Error_Msg
3339                        (Project, In_Tree,
3340                         "{ is not a valid directory",
3341                         Location);
3342                   end if;
3343
3344                else
3345                   --  As it is an existing directory, we add it to
3346                   --  the list of directories.
3347
3348                   String_Element_Table.Increment_Last
3349                     (In_Tree.String_Elements);
3350                   Element.Value := Path_Name;
3351                   Element.Display_Value := Display_Path_Name;
3352
3353                   if Last_Source_Dir = Nil_String then
3354
3355                      --  This is the first source directory
3356
3357                      Data.Source_Dirs := String_Element_Table.Last
3358                                         (In_Tree.String_Elements);
3359
3360                   else
3361                      --  We already have source directories,
3362                      --  link the previous last to the new one.
3363
3364                      In_Tree.String_Elements.Table
3365                        (Last_Source_Dir).Next :=
3366                          String_Element_Table.Last
3367                            (In_Tree.String_Elements);
3368                   end if;
3369
3370                   --  And register this source directory as the new last
3371
3372                   Last_Source_Dir := String_Element_Table.Last
3373                     (In_Tree.String_Elements);
3374                   In_Tree.String_Elements.Table
3375                     (Last_Source_Dir) := Element;
3376                end if;
3377             end;
3378          end if;
3379       end Find_Source_Dirs;
3380
3381    --  Start of processing for Get_Directories
3382
3383    begin
3384       if Current_Verbosity = High then
3385          Write_Line ("Starting to look for directories");
3386       end if;
3387
3388       --  Check the object directory
3389
3390       pragma Assert (Object_Dir.Kind = Single,
3391                      "Object_Dir is not a single string");
3392
3393       --  We set the object directory to its default
3394
3395       Data.Object_Directory   := Data.Directory;
3396       Data.Display_Object_Dir := Data.Display_Directory;
3397
3398       if Object_Dir.Value /= Empty_String then
3399          Get_Name_String (Object_Dir.Value);
3400
3401          if Name_Len = 0 then
3402             Error_Msg
3403               (Project, In_Tree,
3404                "Object_Dir cannot be empty",
3405                Object_Dir.Location);
3406
3407          else
3408             --  We check that the specified object directory does exist
3409
3410             Locate_Directory
3411               (Object_Dir.Value, Data.Display_Directory,
3412                Data.Object_Directory, Data.Display_Object_Dir);
3413
3414             if Data.Object_Directory = No_Name then
3415
3416                --  The object directory does not exist, report an error
3417
3418                Err_Vars.Error_Msg_Name_1 := Object_Dir.Value;
3419                Error_Msg
3420                  (Project, In_Tree,
3421                   "the object directory { cannot be found",
3422                   Data.Location);
3423
3424                --  Do not keep a nil Object_Directory. Set it to the specified
3425                --  (relative or absolute) path. This is for the benefit of
3426                --  tools that recover from errors; for example, these tools
3427                --  could create the non existent directory.
3428
3429                Data.Display_Object_Dir := Object_Dir.Value;
3430                Get_Name_String (Object_Dir.Value);
3431                Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3432                Data.Object_Directory := Name_Find;
3433             end if;
3434          end if;
3435       end if;
3436
3437       if Current_Verbosity = High then
3438          if Data.Object_Directory = No_Name then
3439             Write_Line ("No object directory");
3440          else
3441             Write_Str ("Object directory: """);
3442             Write_Str (Get_Name_String (Data.Display_Object_Dir));
3443             Write_Line ("""");
3444          end if;
3445       end if;
3446
3447       --  Check the exec directory
3448
3449       pragma Assert (Exec_Dir.Kind = Single,
3450                      "Exec_Dir is not a single string");
3451
3452       --  We set the object directory to its default
3453
3454       Data.Exec_Directory   := Data.Object_Directory;
3455       Data.Display_Exec_Dir := Data.Display_Object_Dir;
3456
3457       if Exec_Dir.Value /= Empty_String then
3458          Get_Name_String (Exec_Dir.Value);
3459
3460          if Name_Len = 0 then
3461             Error_Msg
3462               (Project, In_Tree,
3463                "Exec_Dir cannot be empty",
3464                Exec_Dir.Location);
3465
3466          else
3467             --  We check that the specified object directory
3468             --  does exist.
3469
3470             Locate_Directory
3471               (Exec_Dir.Value, Data.Directory,
3472                Data.Exec_Directory, Data.Display_Exec_Dir);
3473
3474             if Data.Exec_Directory = No_Name then
3475                Err_Vars.Error_Msg_Name_1 := Exec_Dir.Value;
3476                Error_Msg
3477                  (Project, In_Tree,
3478                   "the exec directory { cannot be found",
3479                   Data.Location);
3480             end if;
3481          end if;
3482       end if;
3483
3484       if Current_Verbosity = High then
3485          if Data.Exec_Directory = No_Name then
3486             Write_Line ("No exec directory");
3487          else
3488             Write_Str ("Exec directory: """);
3489             Write_Str (Get_Name_String (Data.Display_Exec_Dir));
3490             Write_Line ("""");
3491          end if;
3492       end if;
3493
3494       --  Look for the source directories
3495
3496       if Current_Verbosity = High then
3497          Write_Line ("Starting to look for source directories");
3498       end if;
3499
3500       pragma Assert (Source_Dirs.Kind = List, "Source_Dirs is not a list");
3501
3502       if Source_Dirs.Default then
3503
3504          --  No Source_Dirs specified: the single source directory
3505          --  is the one containing the project file
3506
3507          String_Element_Table.Increment_Last
3508            (In_Tree.String_Elements);
3509          Data.Source_Dirs := String_Element_Table.Last
3510            (In_Tree.String_Elements);
3511          In_Tree.String_Elements.Table (Data.Source_Dirs) :=
3512            (Value         => Data.Directory,
3513             Display_Value => Data.Display_Directory,
3514             Location      => No_Location,
3515             Flag          => False,
3516             Next          => Nil_String,
3517             Index         => 0);
3518
3519          if Current_Verbosity = High then
3520             Write_Line ("Single source directory:");
3521             Write_Str ("    """);
3522             Write_Str (Get_Name_String (Data.Display_Directory));
3523             Write_Line ("""");
3524          end if;
3525
3526       elsif Source_Dirs.Values = Nil_String then
3527
3528          --  If Source_Dirs is an empty string list, this means
3529          --  that this project contains no source. For projects that
3530          --  don't extend other projects, this also means that there is no
3531          --  need for an object directory, if not specified.
3532
3533          if Data.Extends = No_Project
3534            and then  Data.Object_Directory = Data.Directory
3535          then
3536             Data.Object_Directory := No_Name;
3537          end if;
3538
3539          Data.Source_Dirs           := Nil_String;
3540          Data.Ada_Sources_Present   := False;
3541          Data.Other_Sources_Present := False;
3542
3543       else
3544          declare
3545             Source_Dir : String_List_Id := Source_Dirs.Values;
3546             Element    : String_Element;
3547
3548          begin
3549             --  We will find the source directories for each
3550             --  element of the list
3551
3552             while Source_Dir /= Nil_String loop
3553                Element :=
3554                  In_Tree.String_Elements.Table (Source_Dir);
3555                Find_Source_Dirs (Element.Value, Element.Location);
3556                Source_Dir := Element.Next;
3557             end loop;
3558          end;
3559       end if;
3560
3561       if Current_Verbosity = High then
3562          Write_Line ("Putting source directories in canonical cases");
3563       end if;
3564
3565       declare
3566          Current : String_List_Id := Data.Source_Dirs;
3567          Element : String_Element;
3568
3569       begin
3570          while Current /= Nil_String loop
3571             Element := In_Tree.String_Elements.Table (Current);
3572             if Element.Value /= No_Name then
3573                Get_Name_String (Element.Value);
3574                Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3575                Element.Value := Name_Find;
3576                In_Tree.String_Elements.Table (Current) := Element;
3577             end if;
3578
3579             Current := Element.Next;
3580          end loop;
3581       end;
3582
3583    end Get_Directories;
3584
3585    ---------------
3586    -- Get_Mains --
3587    ---------------
3588
3589    procedure Get_Mains
3590      (Project : Project_Id;
3591       In_Tree : Project_Tree_Ref;
3592       Data    : in out Project_Data) is
3593       Mains : constant Variable_Value :=
3594                 Prj.Util.Value_Of (Name_Main, Data.Decl.Attributes, In_Tree);
3595
3596    begin
3597       Data.Mains := Mains.Values;
3598
3599       --  If no Mains were specified, and if we are an extending
3600       --  project, inherit the Mains from the project we are extending.
3601
3602       if Mains.Default then
3603          if Data.Extends /= No_Project then
3604             Data.Mains :=
3605               In_Tree.Projects.Table (Data.Extends).Mains;
3606          end if;
3607
3608       --  In a library project file, Main cannot be specified
3609
3610       elsif Data.Library then
3611          Error_Msg
3612            (Project, In_Tree,
3613             "a library project file cannot have Main specified",
3614             Mains.Location);
3615       end if;
3616    end Get_Mains;
3617
3618    ---------------------------
3619    -- Get_Sources_From_File --
3620    ---------------------------
3621
3622    procedure Get_Sources_From_File
3623      (Path     : String;
3624       Location : Source_Ptr;
3625       Project  : Project_Id;
3626       In_Tree  : Project_Tree_Ref)
3627    is
3628       File        : Prj.Util.Text_File;
3629       Line        : String (1 .. 250);
3630       Last        : Natural;
3631       Source_Name : Name_Id;
3632
3633    begin
3634       Source_Names.Reset;
3635
3636       if Current_Verbosity = High then
3637          Write_Str  ("Opening """);
3638          Write_Str  (Path);
3639          Write_Line (""".");
3640       end if;
3641
3642       --  Open the file
3643
3644       Prj.Util.Open (File, Path);
3645
3646       if not Prj.Util.Is_Valid (File) then
3647          Error_Msg (Project, In_Tree, "file does not exist", Location);
3648       else
3649          --  Read the lines one by one
3650
3651          while not Prj.Util.End_Of_File (File) loop
3652             Prj.Util.Get_Line (File, Line, Last);
3653
3654             --  A non empty, non comment line should contain a file name
3655
3656             if Last /= 0
3657               and then (Last = 1 or else Line (1 .. 2) /= "--")
3658             then
3659                --  ??? we should check that there is no directory information
3660
3661                Name_Len := Last;
3662                Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
3663                Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3664                Source_Name := Name_Find;
3665                Source_Names.Set
3666                  (K => Source_Name,
3667                   E =>
3668                     (Name     => Source_Name,
3669                      Location => Location,
3670                      Found    => False));
3671             end if;
3672          end loop;
3673
3674          Prj.Util.Close (File);
3675
3676       end if;
3677    end Get_Sources_From_File;
3678
3679    --------------
3680    -- Get_Unit --
3681    --------------
3682
3683    procedure Get_Unit
3684      (Canonical_File_Name : Name_Id;
3685       Naming              : Naming_Data;
3686       Exception_Id        : out Ada_Naming_Exception_Id;
3687       Unit_Name           : out Name_Id;
3688       Unit_Kind           : out Spec_Or_Body;
3689       Needs_Pragma        : out Boolean)
3690    is
3691       Info_Id  : Ada_Naming_Exception_Id
3692         := Ada_Naming_Exceptions.Get (Canonical_File_Name);
3693       VMS_Name : Name_Id;
3694
3695    begin
3696       if Info_Id = No_Ada_Naming_Exception then
3697          if Hostparm.OpenVMS then
3698             VMS_Name := Canonical_File_Name;
3699             Get_Name_String (VMS_Name);
3700
3701             if Name_Buffer (Name_Len) = '.' then
3702                Name_Len := Name_Len - 1;
3703                VMS_Name := Name_Find;
3704             end if;
3705
3706             Info_Id := Ada_Naming_Exceptions.Get (VMS_Name);
3707          end if;
3708
3709       end if;
3710
3711       if Info_Id /= No_Ada_Naming_Exception then
3712          Exception_Id := Info_Id;
3713          Unit_Name := No_Name;
3714          Unit_Kind := Specification;
3715          Needs_Pragma := True;
3716          return;
3717       end if;
3718
3719       Needs_Pragma := False;
3720       Exception_Id := No_Ada_Naming_Exception;
3721
3722       Get_Name_String (Canonical_File_Name);
3723
3724       declare
3725          File          : String := Name_Buffer (1 .. Name_Len);
3726          First         : constant Positive := File'First;
3727          Last          : Natural           := File'Last;
3728          Standard_GNAT : Boolean;
3729
3730       begin
3731          Standard_GNAT :=
3732            Naming.Ada_Spec_Suffix = Default_Ada_Spec_Suffix
3733              and then Naming.Ada_Body_Suffix = Default_Ada_Body_Suffix;
3734
3735          --  Check if the end of the file name is Specification_Append
3736
3737          Get_Name_String (Naming.Ada_Spec_Suffix);
3738
3739          if File'Length > Name_Len
3740            and then File (Last - Name_Len + 1 .. Last) =
3741                                                 Name_Buffer (1 .. Name_Len)
3742          then
3743             --  We have a spec
3744
3745             Unit_Kind := Specification;
3746             Last := Last - Name_Len;
3747
3748             if Current_Verbosity = High then
3749                Write_Str  ("   Specification: ");
3750                Write_Line (File (First .. Last));
3751             end if;
3752
3753          else
3754             Get_Name_String (Naming.Ada_Body_Suffix);
3755
3756             --  Check if the end of the file name is Body_Append
3757
3758             if File'Length > Name_Len
3759               and then File (Last - Name_Len + 1 .. Last) =
3760                                                 Name_Buffer (1 .. Name_Len)
3761             then
3762                --  We have a body
3763
3764                Unit_Kind := Body_Part;
3765                Last := Last - Name_Len;
3766
3767                if Current_Verbosity = High then
3768                   Write_Str  ("   Body: ");
3769                   Write_Line (File (First .. Last));
3770                end if;
3771
3772             elsif Naming.Separate_Suffix /= Naming.Ada_Spec_Suffix then
3773                Get_Name_String (Naming.Separate_Suffix);
3774
3775                --  Check if the end of the file name is Separate_Append
3776
3777                if File'Length > Name_Len
3778                  and then File (Last - Name_Len + 1 .. Last) =
3779                                                 Name_Buffer (1 .. Name_Len)
3780                then
3781                   --  We have a separate (a body)
3782
3783                   Unit_Kind := Body_Part;
3784                   Last := Last - Name_Len;
3785
3786                   if Current_Verbosity = High then
3787                      Write_Str  ("   Separate: ");
3788                      Write_Line (File (First .. Last));
3789                   end if;
3790
3791                else
3792                   Last := 0;
3793                end if;
3794
3795             else
3796                Last := 0;
3797             end if;
3798          end if;
3799
3800          if Last = 0 then
3801
3802             --  This is not a source file
3803
3804             Unit_Name := No_Name;
3805             Unit_Kind := Specification;
3806
3807             if Current_Verbosity = High then
3808                Write_Line ("   Not a valid file name.");
3809             end if;
3810
3811             return;
3812          end if;
3813
3814          Get_Name_String (Naming.Dot_Replacement);
3815          Standard_GNAT :=
3816            Standard_GNAT and then Name_Buffer (1 .. Name_Len) = "-";
3817
3818          if Name_Buffer (1 .. Name_Len) /= "." then
3819
3820             --  If Dot_Replacement is not a single dot, then there should
3821             --  not be any dot in the name.
3822
3823             for Index in First .. Last loop
3824                if File (Index) = '.' then
3825                   if Current_Verbosity = High then
3826                      Write_Line
3827                        ("   Not a valid file name (some dot not replaced).");
3828                   end if;
3829
3830                   Unit_Name := No_Name;
3831                   return;
3832
3833                end if;
3834             end loop;
3835
3836             --  Replace the substring Dot_Replacement with dots
3837
3838             declare
3839                Index : Positive := First;
3840
3841             begin
3842                while Index <= Last - Name_Len + 1 loop
3843
3844                   if File (Index .. Index + Name_Len - 1) =
3845                     Name_Buffer (1 .. Name_Len)
3846                   then
3847                      File (Index) := '.';
3848
3849                      if Name_Len > 1 and then Index < Last then
3850                         File (Index + 1 .. Last - Name_Len + 1) :=
3851                           File (Index + Name_Len .. Last);
3852                      end if;
3853
3854                      Last := Last - Name_Len + 1;
3855                   end if;
3856
3857                   Index := Index + 1;
3858                end loop;
3859             end;
3860          end if;
3861
3862          --  Check if the casing is right
3863
3864          declare
3865             Src : String := File (First .. Last);
3866
3867          begin
3868             case Naming.Casing is
3869                when All_Lower_Case =>
3870                   Fixed.Translate
3871                     (Source  => Src,
3872                      Mapping => Lower_Case_Map);
3873
3874                when All_Upper_Case =>
3875                   Fixed.Translate
3876                     (Source  => Src,
3877                      Mapping => Upper_Case_Map);
3878
3879                when Mixed_Case | Unknown =>
3880                   null;
3881             end case;
3882
3883             if Src /= File (First .. Last) then
3884                if Current_Verbosity = High then
3885                   Write_Line ("   Not a valid file name (casing).");
3886                end if;
3887
3888                Unit_Name := No_Name;
3889                return;
3890             end if;
3891
3892             --  We put the name in lower case
3893
3894             Fixed.Translate
3895               (Source  => Src,
3896                Mapping => Lower_Case_Map);
3897
3898             --  In the standard GNAT naming scheme, check for special cases:
3899             --  children or separates of A, G, I or S, and run time sources.
3900
3901             if Standard_GNAT and then Src'Length >= 3 then
3902                declare
3903                   S1 : constant Character := Src (Src'First);
3904                   S2 : constant Character := Src (Src'First + 1);
3905
3906                begin
3907                   if S1 = 'a' or else S1 = 'g'
3908                     or else S1 = 'i' or else S1 = 's'
3909                   then
3910                      --  Children or separates of packages A, G, I or S
3911
3912                      if (Hostparm.OpenVMS and then S2 = '$')
3913                        or else (not Hostparm.OpenVMS and then S2 = '~')
3914                      then
3915                         Src (Src'First + 1) := '.';
3916
3917                      --  If it is potentially a run time source, disable
3918                      --  filling of the mapping file to avoid warnings.
3919
3920                      elsif S2 = '.' then
3921                         Set_Mapping_File_Initial_State_To_Empty;
3922                      end if;
3923
3924                   end if;
3925                end;
3926             end if;
3927
3928             if Current_Verbosity = High then
3929                Write_Str  ("      ");
3930                Write_Line (Src);
3931             end if;
3932
3933             --  Now, we check if this name is a valid unit name
3934
3935             Check_Ada_Name (Name => Src, Unit => Unit_Name);
3936          end;
3937
3938       end;
3939    end Get_Unit;
3940
3941    ----------
3942    -- Hash --
3943    ----------
3944
3945    function Hash (Unit : Unit_Info) return Header_Num is
3946    begin
3947       return Header_Num (Unit.Unit mod 2048);
3948    end Hash;
3949
3950    -----------------------
3951    -- Is_Illegal_Suffix --
3952    -----------------------
3953
3954    function Is_Illegal_Suffix
3955      (Suffix                          : String;
3956       Dot_Replacement_Is_A_Single_Dot : Boolean) return Boolean
3957    is
3958    begin
3959       if Suffix'Length = 0 or else Index (Suffix, ".") = 0 then
3960          return True;
3961       end if;
3962
3963       --  If dot replacement is a single dot, and first character of
3964       --  suffix is also a dot
3965
3966       if Dot_Replacement_Is_A_Single_Dot
3967         and then Suffix (Suffix'First) = '.'
3968       then
3969          for Index in Suffix'First + 1 .. Suffix'Last loop
3970
3971             --  If there is another dot
3972
3973             if Suffix (Index) = '.' then
3974
3975                --  It is illegal to have a letter following the initial dot
3976
3977                return Is_Letter (Suffix (Suffix'First + 1));
3978             end if;
3979          end loop;
3980       end if;
3981
3982       --  Everything is OK
3983
3984       return False;
3985    end Is_Illegal_Suffix;
3986
3987    ----------------------
3988    -- Locate_Directory --
3989    ----------------------
3990
3991    procedure Locate_Directory
3992      (Name    : Name_Id;
3993       Parent  : Name_Id;
3994       Dir     : out Name_Id;
3995       Display : out Name_Id)
3996    is
3997       The_Name   : constant String := Get_Name_String (Name);
3998
3999       The_Parent : constant String :=
4000                      Get_Name_String (Parent) & Directory_Separator;
4001
4002       The_Parent_Last : constant Natural :=
4003                      Compute_Directory_Last (The_Parent);
4004
4005    begin
4006       if Current_Verbosity = High then
4007          Write_Str ("Locate_Directory (""");
4008          Write_Str (The_Name);
4009          Write_Str (""", """);
4010          Write_Str (The_Parent);
4011          Write_Line (""")");
4012       end if;
4013
4014       Dir     := No_Name;
4015       Display := No_Name;
4016
4017       if Is_Absolute_Path (The_Name) then
4018          if Is_Directory (The_Name) then
4019             declare
4020                Normed : constant String :=
4021                           Normalize_Pathname
4022                             (The_Name,
4023                              Resolve_Links  => False,
4024                              Case_Sensitive => True);
4025
4026                Canonical_Path : constant String :=
4027                                   Normalize_Pathname
4028                                     (Normed,
4029                                      Resolve_Links  => True,
4030                                      Case_Sensitive => False);
4031
4032             begin
4033                Name_Len := Normed'Length;
4034                Name_Buffer (1 .. Name_Len) := Normed;
4035                Display := Name_Find;
4036
4037                Name_Len := Canonical_Path'Length;
4038                Name_Buffer (1 .. Name_Len) := Canonical_Path;
4039                Dir := Name_Find;
4040             end;
4041          end if;
4042
4043       else
4044          declare
4045             Full_Path : constant String :=
4046                           The_Parent (The_Parent'First .. The_Parent_Last) &
4047                           The_Name;
4048
4049          begin
4050             if Is_Directory (Full_Path) then
4051                declare
4052                   Normed : constant String :=
4053                              Normalize_Pathname
4054                                (Full_Path,
4055                                 Resolve_Links  => False,
4056                                 Case_Sensitive => True);
4057
4058                   Canonical_Path : constant String :=
4059                                      Normalize_Pathname
4060                                        (Normed,
4061                                         Resolve_Links  => True,
4062                                         Case_Sensitive => False);
4063
4064                begin
4065                   Name_Len := Normed'Length;
4066                   Name_Buffer (1 .. Name_Len) := Normed;
4067                   Display := Name_Find;
4068
4069                   Name_Len := Canonical_Path'Length;
4070                   Name_Buffer (1 .. Name_Len) := Canonical_Path;
4071                   Dir := Name_Find;
4072                end;
4073             end if;
4074          end;
4075       end if;
4076    end Locate_Directory;
4077
4078    ----------------------
4079    -- Look_For_Sources --
4080    ----------------------
4081
4082    procedure Look_For_Sources
4083      (Project      : Project_Id;
4084       In_Tree      : Project_Tree_Ref;
4085       Data         : in out Project_Data;
4086       Follow_Links : Boolean)
4087    is
4088       procedure Get_Path_Names_And_Record_Sources (Follow_Links : Boolean);
4089       --  Find the path names of the source files in the Source_Names table
4090       --  in the source directories and record those that are Ada sources.
4091
4092       procedure Get_Sources_From_File
4093         (Path     : String;
4094          Location : Source_Ptr);
4095       --  Get the sources of a project from a text file
4096
4097       ---------------------------------------
4098       -- Get_Path_Names_And_Record_Sources --
4099       ---------------------------------------
4100
4101       procedure Get_Path_Names_And_Record_Sources (Follow_Links : Boolean) is
4102          Source_Dir : String_List_Id := Data.Source_Dirs;
4103          Element    : String_Element;
4104          Path       : Name_Id;
4105
4106          Dir      : Dir_Type;
4107          Name     : Name_Id;
4108          Canonical_Name : Name_Id;
4109          Name_Str : String (1 .. 1_024);
4110          Last     : Natural := 0;
4111          NL       : Name_Location;
4112
4113          Current_Source : String_List_Id := Nil_String;
4114
4115          First_Error : Boolean := True;
4116
4117          Source_Recorded : Boolean := False;
4118
4119       begin
4120          --  We look in all source directories for the file names in the
4121          --  hash table Source_Names
4122
4123          while Source_Dir /= Nil_String loop
4124             Source_Recorded := False;
4125             Element := In_Tree.String_Elements.Table (Source_Dir);
4126
4127             declare
4128                Dir_Path : constant String := Get_Name_String (Element.Value);
4129             begin
4130                if Current_Verbosity = High then
4131                   Write_Str ("checking directory """);
4132                   Write_Str (Dir_Path);
4133                   Write_Line ("""");
4134                end if;
4135
4136                Open (Dir, Dir_Path);
4137
4138                loop
4139                   Read (Dir, Name_Str, Last);
4140                   exit when Last = 0;
4141                   Name_Len := Last;
4142                   Name_Buffer (1 .. Name_Len) := Name_Str (1 .. Last);
4143                   Name := Name_Find;
4144                   Canonical_Case_File_Name (Name_Str (1 .. Last));
4145                   Name_Len := Last;
4146                   Name_Buffer (1 .. Name_Len) := Name_Str (1 .. Last);
4147                   Canonical_Name := Name_Find;
4148                   NL := Source_Names.Get (Canonical_Name);
4149
4150                   if NL /= No_Name_Location and then not NL.Found then
4151                      NL.Found := True;
4152                      Source_Names.Set (Canonical_Name, NL);
4153                      Name_Len := Dir_Path'Length;
4154                      Name_Buffer (1 .. Name_Len) := Dir_Path;
4155
4156                      if Name_Buffer (Name_Len) /= Directory_Separator then
4157                         Add_Char_To_Name_Buffer (Directory_Separator);
4158                      end if;
4159
4160                      Add_Str_To_Name_Buffer (Name_Str (1 .. Last));
4161                      Path := Name_Find;
4162
4163                      if Current_Verbosity = High then
4164                         Write_Str  ("  found ");
4165                         Write_Line (Get_Name_String (Name));
4166                      end if;
4167
4168                      --  Register the source if it is an Ada compilation unit
4169
4170                      Record_Ada_Source
4171                        (File_Name       => Name,
4172                         Path_Name       => Path,
4173                         Project         => Project,
4174                         In_Tree         => In_Tree,
4175                         Data            => Data,
4176                         Location        => NL.Location,
4177                         Current_Source  => Current_Source,
4178                         Source_Recorded => Source_Recorded,
4179                         Follow_Links    => Follow_Links);
4180                   end if;
4181                end loop;
4182
4183                Close (Dir);
4184             end;
4185
4186             if Source_Recorded then
4187                In_Tree.String_Elements.Table (Source_Dir).Flag :=
4188                  True;
4189             end if;
4190
4191             Source_Dir := Element.Next;
4192          end loop;
4193
4194          --  It is an error if a source file name in a source list or
4195          --  in a source list file is not found.
4196
4197          NL := Source_Names.Get_First;
4198
4199          while NL /= No_Name_Location loop
4200             if not NL.Found then
4201                Err_Vars.Error_Msg_Name_1 := NL.Name;
4202
4203                if First_Error then
4204                   Error_Msg
4205                     (Project, In_Tree,
4206                      "source file { cannot be found",
4207                      NL.Location);
4208                   First_Error := False;
4209
4210                else
4211                   Error_Msg
4212                     (Project, In_Tree,
4213                      "\source file { cannot be found",
4214                      NL.Location);
4215                end if;
4216             end if;
4217
4218             NL := Source_Names.Get_Next;
4219          end loop;
4220       end Get_Path_Names_And_Record_Sources;
4221
4222       ---------------------------
4223       -- Get_Sources_From_File --
4224       ---------------------------
4225
4226       procedure Get_Sources_From_File
4227         (Path     : String;
4228          Location : Source_Ptr)
4229       is
4230       begin
4231          --  Get the list of sources from the file and put them in hash table
4232          --  Source_Names.
4233
4234          Get_Sources_From_File (Path, Location, Project, In_Tree);
4235
4236          --  Look in the source directories to find those sources
4237
4238          Get_Path_Names_And_Record_Sources (Follow_Links);
4239
4240          --  We should have found at least one source.
4241          --  If not, report an error.
4242
4243          if Data.Sources = Nil_String then
4244             Error_Msg (Project, In_Tree,
4245                        "there are no Ada sources in this project",
4246                        Location);
4247          end if;
4248       end Get_Sources_From_File;
4249
4250    begin
4251       if Data.Ada_Sources_Present then
4252          declare
4253             Sources          : constant Variable_Value :=
4254                                  Util.Value_Of
4255                                    (Name_Source_Files,
4256                                     Data.Decl.Attributes,
4257                                     In_Tree);
4258
4259             Source_List_File : constant Variable_Value :=
4260                                  Util.Value_Of
4261                                    (Name_Source_List_File,
4262                                     Data.Decl.Attributes,
4263                                     In_Tree);
4264
4265             Locally_Removed  : constant Variable_Value :=
4266                                  Util.Value_Of
4267                                    (Name_Locally_Removed_Files,
4268                                     Data.Decl.Attributes,
4269                                     In_Tree);
4270
4271          begin
4272             pragma Assert
4273               (Sources.Kind = List,
4274                "Source_Files is not a list");
4275
4276             pragma Assert
4277               (Source_List_File.Kind = Single,
4278                "Source_List_File is not a single string");
4279
4280             if not Sources.Default then
4281                if not Source_List_File.Default then
4282                   Error_Msg
4283                     (Project, In_Tree,
4284                      "?both variables source_files and " &
4285                      "source_list_file are present",
4286                      Source_List_File.Location);
4287                end if;
4288
4289                --  Sources is a list of file names
4290
4291                declare
4292                   Current  : String_List_Id := Sources.Values;
4293                   Element  : String_Element;
4294                   Location : Source_Ptr;
4295                   Name     : Name_Id;
4296
4297                begin
4298                   Source_Names.Reset;
4299
4300                   Data.Ada_Sources_Present := Current /= Nil_String;
4301
4302                   while Current /= Nil_String loop
4303                      Element :=
4304                        In_Tree.String_Elements.Table (Current);
4305                      Get_Name_String (Element.Value);
4306                      Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
4307                      Name := Name_Find;
4308
4309                      --  If the element has no location, then use the
4310                      --  location of Sources to report possible errors.
4311
4312                      if Element.Location = No_Location then
4313                         Location := Sources.Location;
4314                      else
4315                         Location := Element.Location;
4316                      end if;
4317
4318                      Source_Names.Set
4319                        (K => Name,
4320                         E =>
4321                           (Name     => Name,
4322                            Location => Location,
4323                            Found    => False));
4324
4325                      Current := Element.Next;
4326                   end loop;
4327
4328                   Get_Path_Names_And_Record_Sources (Follow_Links);
4329                end;
4330
4331                --  No source_files specified
4332
4333                --  We check Source_List_File has been specified
4334
4335             elsif not Source_List_File.Default then
4336
4337                --  Source_List_File is the name of the file
4338                --  that contains the source file names
4339
4340                declare
4341                   Source_File_Path_Name : constant String :=
4342                                             Path_Name_Of
4343                                               (Source_List_File.Value,
4344                                                Data.Directory);
4345
4346                begin
4347                   if Source_File_Path_Name'Length = 0 then
4348                      Err_Vars.Error_Msg_Name_1 := Source_List_File.Value;
4349                      Error_Msg
4350                        (Project, In_Tree,
4351                         "file with sources { does not exist",
4352                         Source_List_File.Location);
4353
4354                   else
4355                      Get_Sources_From_File
4356                        (Source_File_Path_Name,
4357                         Source_List_File.Location);
4358                   end if;
4359                end;
4360
4361             else
4362                --  Neither Source_Files nor Source_List_File has been
4363                --  specified. Find all the files that satisfy the naming
4364                --  scheme in all the source directories.
4365
4366                Find_Sources
4367                  (Project, In_Tree, Data, Ada_Language_Index, Follow_Links);
4368             end if;
4369
4370             --  If there are sources that are locally removed, mark them as
4371             --  such in the Units table.
4372
4373             if not Locally_Removed.Default then
4374
4375                --  Sources can be locally removed only in extending
4376                --  project files.
4377
4378                if Data.Extends = No_Project then
4379                   Error_Msg
4380                     (Project, In_Tree,
4381                      "Locally_Removed_Files can only be used " &
4382                      "in an extending project file",
4383                      Locally_Removed.Location);
4384
4385                else
4386                   declare
4387                      Current  : String_List_Id := Locally_Removed.Values;
4388                      Element  : String_Element;
4389                      Location : Source_Ptr;
4390                      OK       : Boolean;
4391                      Unit     : Unit_Data;
4392                      Name     : Name_Id;
4393                      Extended : Project_Id;
4394
4395                   begin
4396                      while Current /= Nil_String loop
4397                         Element :=
4398                           In_Tree.String_Elements.Table (Current);
4399                         Get_Name_String (Element.Value);
4400                         Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
4401                         Name := Name_Find;
4402
4403                         --  If the element has no location, then use the
4404                         --  location of Locally_Removed to report
4405                         --  possible errors.
4406
4407                         if Element.Location = No_Location then
4408                            Location := Locally_Removed.Location;
4409                         else
4410                            Location := Element.Location;
4411                         end if;
4412
4413                         OK := False;
4414
4415                         for Index in Unit_Table.First ..
4416                                   Unit_Table.Last (In_Tree.Units)
4417                         loop
4418                            Unit := In_Tree.Units.Table (Index);
4419
4420                            if Unit.File_Names (Specification).Name = Name then
4421                               OK := True;
4422
4423                               --  Check that this is from a project that
4424                               --  the current project extends, but not the
4425                               --  current project.
4426
4427                               Extended := Unit.File_Names
4428                                 (Specification).Project;
4429
4430                               if Extended = Project then
4431                                  Error_Msg
4432                                    (Project, In_Tree,
4433                                     "cannot remove a source " &
4434                                     "of the same project",
4435                                     Location);
4436
4437                               elsif
4438                                 Project_Extends (Project, Extended, In_Tree)
4439                               then
4440                                  Unit.File_Names
4441                                    (Specification).Path := Slash;
4442                                  Unit.File_Names
4443                                    (Specification).Needs_Pragma := False;
4444                                  In_Tree.Units.Table (Index) :=
4445                                    Unit;
4446                                  Add_Forbidden_File_Name
4447                                    (Unit.File_Names (Specification).Name);
4448                                  exit;
4449
4450                               else
4451                                  Error_Msg
4452                                    (Project, In_Tree,
4453                                     "cannot remove a source from " &
4454                                     "another project",
4455                                     Location);
4456                               end if;
4457
4458                            elsif
4459                              Unit.File_Names (Body_Part).Name = Name
4460                            then
4461                               OK := True;
4462
4463                               --  Check that this is from a project that
4464                               --  the current project extends, but not the
4465                               --  current project.
4466
4467                               Extended := Unit.File_Names
4468                                 (Body_Part).Project;
4469
4470                               if Extended = Project then
4471                                  Error_Msg
4472                                    (Project, In_Tree,
4473                                     "cannot remove a source " &
4474                                     "of the same project",
4475                                     Location);
4476
4477                               elsif
4478                                 Project_Extends (Project, Extended, In_Tree)
4479                               then
4480                                  Unit.File_Names (Body_Part).Path := Slash;
4481                                  Unit.File_Names (Body_Part).Needs_Pragma
4482                                    := False;
4483                                  In_Tree.Units.Table (Index) :=
4484                                    Unit;
4485                                  Add_Forbidden_File_Name
4486                                    (Unit.File_Names (Body_Part).Name);
4487                                  exit;
4488                               end if;
4489
4490                            end if;
4491                         end loop;
4492
4493                         if not OK then
4494                            Err_Vars.Error_Msg_Name_1 := Name;
4495                            Error_Msg
4496                              (Project, In_Tree, "unknown file {", Location);
4497                         end if;
4498
4499                         Current := Element.Next;
4500                      end loop;
4501                   end;
4502                end if;
4503             end if;
4504          end;
4505       end if;
4506
4507       if Data.Other_Sources_Present then
4508
4509          --  Set Source_Present to False. It will be set back to True
4510          --  whenever a source is found.
4511
4512          Data.Other_Sources_Present := False;
4513          for Lang in Ada_Language_Index + 1 .. Last_Language_Index loop
4514
4515             --  For each language (other than Ada) in the project file
4516
4517             if Is_Present (Lang, Data, In_Tree) then
4518
4519                --  Reset the indication that there are sources of this
4520                --  language. It will be set back to True whenever we find a
4521                --  source of the language.
4522
4523                Set (Lang, False, Data, In_Tree);
4524
4525                --  First, get the source suffix for the language
4526
4527                Set (Suffix       => Suffix_For (Lang, Data.Naming, In_Tree),
4528                     For_Language => Lang,
4529                     In_Project   => Data,
4530                     In_Tree      => In_Tree);
4531
4532                --  Then, deal with the naming exceptions, if any
4533
4534                Source_Names.Reset;
4535
4536                declare
4537                   Naming_Exceptions : constant Variable_Value :=
4538                     Value_Of
4539                       (Index     => Language_Names.Table (Lang),
4540                        Src_Index => 0,
4541                        In_Array  => Data.Naming.Implementation_Exceptions,
4542                        In_Tree   => In_Tree);
4543                   Element_Id        : String_List_Id;
4544                   Element           : String_Element;
4545                   File_Id           : Name_Id;
4546                   Source_Found      : Boolean := False;
4547
4548                begin
4549                   --  If there are naming exceptions, look through them one
4550                   --  by one.
4551
4552                   if Naming_Exceptions /= Nil_Variable_Value then
4553                      Element_Id := Naming_Exceptions.Values;
4554
4555                      while Element_Id /= Nil_String loop
4556                         Element := In_Tree.String_Elements.Table
4557                                                           (Element_Id);
4558                         Get_Name_String (Element.Value);
4559                         Canonical_Case_File_Name
4560                           (Name_Buffer (1 .. Name_Len));
4561                         File_Id := Name_Find;
4562
4563                         --  Put each naming exception in the Source_Names
4564                         --  hash table, but if there are repetition, don't
4565                         --  bother after the first instance.
4566
4567                         if
4568                           Source_Names.Get (File_Id) = No_Name_Location
4569                         then
4570                            Source_Found := True;
4571                            Source_Names.Set
4572                              (File_Id,
4573                               (Name     => File_Id,
4574                                Location => Element.Location,
4575                                Found    => False));
4576                         end if;
4577
4578                         Element_Id := Element.Next;
4579                      end loop;
4580
4581                      --  If there is at least one naming exception, record
4582                      --  those that are found in the source directories.
4583
4584                      if Source_Found then
4585                         Record_Other_Sources
4586                           (Project           => Project,
4587                            In_Tree           => In_Tree,
4588                            Data              => Data,
4589                            Language          => Lang,
4590                            Naming_Exceptions => True);
4591                      end if;
4592
4593                   end if;
4594                end;
4595
4596                --  Now, check if a list of sources is declared either through
4597                --  a string list (attribute Source_Files) or a text file
4598                --  (attribute Source_List_File). If a source list is declared,
4599                --  we will consider only those naming exceptions that are
4600                --  on the list.
4601
4602                declare
4603                   Sources          : constant Variable_Value :=
4604                                        Util.Value_Of
4605                                          (Name_Source_Files,
4606                                           Data.Decl.Attributes,
4607                                           In_Tree);
4608
4609                   Source_List_File : constant Variable_Value :=
4610                                        Util.Value_Of
4611                                          (Name_Source_List_File,
4612                                           Data.Decl.Attributes,
4613                                           In_Tree);
4614
4615                begin
4616                   pragma Assert
4617                     (Sources.Kind = List,
4618                      "Source_Files is not a list");
4619
4620                   pragma Assert
4621                     (Source_List_File.Kind = Single,
4622                      "Source_List_File is not a single string");
4623
4624                   if not Sources.Default then
4625                      if not Source_List_File.Default then
4626                         Error_Msg
4627                           (Project, In_Tree,
4628                            "?both variables source_files and " &
4629                            "source_list_file are present",
4630                            Source_List_File.Location);
4631                      end if;
4632
4633                      --  Sources is a list of file names
4634
4635                      declare
4636                         Current  : String_List_Id := Sources.Values;
4637                         Element  : String_Element;
4638                         Location : Source_Ptr;
4639                         Name     : Name_Id;
4640
4641                      begin
4642                         Source_Names.Reset;
4643
4644                         --  Put all the sources in the Source_Names hash table
4645
4646                         while Current /= Nil_String loop
4647                            Element :=
4648                              In_Tree.String_Elements.Table
4649                                (Current);
4650                            Get_Name_String (Element.Value);
4651                            Canonical_Case_File_Name
4652                              (Name_Buffer (1 .. Name_Len));
4653                            Name := Name_Find;
4654
4655                            --  If the element has no location, then use the
4656                            --  location of Sources to report possible errors.
4657
4658                            if Element.Location = No_Location then
4659                               Location := Sources.Location;
4660                            else
4661                               Location := Element.Location;
4662                            end if;
4663
4664                            Source_Names.Set
4665                              (K => Name,
4666                               E =>
4667                                 (Name     => Name,
4668                                  Location => Location,
4669                                  Found    => False));
4670
4671                            Current := Element.Next;
4672                         end loop;
4673
4674                         --  And look for their directories
4675
4676                         Record_Other_Sources
4677                           (Project           => Project,
4678                            In_Tree           => In_Tree,
4679                            Data              => Data,
4680                            Language          => Lang,
4681                            Naming_Exceptions => False);
4682                      end;
4683
4684                      --  No source_files specified
4685
4686                      --  We check if Source_List_File has been specified
4687
4688                   elsif not Source_List_File.Default then
4689
4690                      --  Source_List_File is the name of the file
4691                      --  that contains the source file names
4692
4693                      declare
4694                         Source_File_Path_Name : constant String :=
4695                           Path_Name_Of
4696                             (Source_List_File.Value,
4697                              Data.Directory);
4698
4699                      begin
4700                         if Source_File_Path_Name'Length = 0 then
4701                            Err_Vars.Error_Msg_Name_1 :=
4702                              Source_List_File.Value;
4703                            Error_Msg
4704                              (Project, In_Tree,
4705                               "file with sources { does not exist",
4706                               Source_List_File.Location);
4707
4708                         else
4709                            --  Read the file, putting each source in the
4710                            --  Source_Names hash table.
4711
4712                            Get_Sources_From_File
4713                              (Source_File_Path_Name,
4714                               Source_List_File.Location,
4715                               Project, In_Tree);
4716
4717                            --  And look for their directories
4718
4719                            Record_Other_Sources
4720                              (Project           => Project,
4721                               In_Tree           => In_Tree,
4722                               Data              => Data,
4723                               Language          => Lang,
4724                               Naming_Exceptions => False);
4725                         end if;
4726                      end;
4727
4728                   --  Neither Source_Files nor Source_List_File was specified
4729
4730                   else
4731                      --  Find all the files that satisfy the naming scheme in
4732                      --  all the source directories. All the naming exceptions
4733                      --  that effectively exist are also part of the source
4734                      --  of this language.
4735
4736                      Find_Sources (Project, In_Tree, Data, Lang);
4737                   end if;
4738                end;
4739             end if;
4740          end loop;
4741       end if;
4742    end Look_For_Sources;
4743
4744    ------------------
4745    -- Path_Name_Of --
4746    ------------------
4747
4748    function Path_Name_Of
4749      (File_Name : Name_Id;
4750       Directory : Name_Id) return String
4751    is
4752       Result : String_Access;
4753
4754       The_Directory : constant String := Get_Name_String (Directory);
4755
4756    begin
4757       Get_Name_String (File_Name);
4758       Result := Locate_Regular_File
4759         (File_Name => Name_Buffer (1 .. Name_Len),
4760          Path      => The_Directory);
4761
4762       if Result = null then
4763          return "";
4764       else
4765          Canonical_Case_File_Name (Result.all);
4766          return Result.all;
4767       end if;
4768    end Path_Name_Of;
4769
4770    -------------------------------
4771    -- Prepare_Ada_Naming_Exceptions --
4772    -------------------------------
4773
4774    procedure Prepare_Ada_Naming_Exceptions
4775      (List    : Array_Element_Id;
4776       In_Tree : Project_Tree_Ref;
4777       Kind    : Spec_Or_Body)
4778    is
4779       Current : Array_Element_Id := List;
4780       Element : Array_Element;
4781
4782       Unit : Unit_Info;
4783
4784    begin
4785       --  Traverse the list
4786
4787       while Current /= No_Array_Element loop
4788          Element := In_Tree.Array_Elements.Table (Current);
4789
4790          if Element.Index /= No_Name then
4791             Unit :=
4792               (Kind => Kind,
4793                Unit => Element.Index,
4794                Next => No_Ada_Naming_Exception);
4795             Reverse_Ada_Naming_Exceptions.Set
4796               (Unit, (Element.Value.Value, Element.Value.Index));
4797             Unit.Next := Ada_Naming_Exceptions.Get (Element.Value.Value);
4798             Ada_Naming_Exception_Table.Increment_Last;
4799             Ada_Naming_Exception_Table.Table
4800               (Ada_Naming_Exception_Table.Last) := Unit;
4801             Ada_Naming_Exceptions.Set
4802               (Element.Value.Value, Ada_Naming_Exception_Table.Last);
4803          end if;
4804
4805          Current := Element.Next;
4806       end loop;
4807    end Prepare_Ada_Naming_Exceptions;
4808
4809    ---------------------
4810    -- Project_Extends --
4811    ---------------------
4812
4813    function Project_Extends
4814      (Extending : Project_Id;
4815       Extended  : Project_Id;
4816       In_Tree   : Project_Tree_Ref) return Boolean
4817    is
4818       Current : Project_Id := Extending;
4819    begin
4820       loop
4821          if Current = No_Project then
4822             return False;
4823
4824          elsif Current = Extended then
4825             return True;
4826          end if;
4827
4828          Current := In_Tree.Projects.Table (Current).Extends;
4829       end loop;
4830    end Project_Extends;
4831
4832    -----------------------
4833    -- Record_Ada_Source --
4834    -----------------------
4835
4836    procedure Record_Ada_Source
4837      (File_Name       : Name_Id;
4838       Path_Name       : Name_Id;
4839       Project         : Project_Id;
4840       In_Tree         : Project_Tree_Ref;
4841       Data            : in out Project_Data;
4842       Location        : Source_Ptr;
4843       Current_Source  : in out String_List_Id;
4844       Source_Recorded : in out Boolean;
4845       Follow_Links    : Boolean)
4846    is
4847       Canonical_File_Name : Name_Id;
4848       Canonical_Path_Name : Name_Id;
4849
4850       Exception_Id : Ada_Naming_Exception_Id;
4851       Unit_Name    : Name_Id;
4852       Unit_Kind    : Spec_Or_Body;
4853       Unit_Index   : Int := 0;
4854       Info         : Unit_Info;
4855       Name_Index   : Name_And_Index;
4856       Needs_Pragma : Boolean;
4857
4858       The_Location    : Source_Ptr              := Location;
4859       Previous_Source : constant String_List_Id := Current_Source;
4860       Except_Name     : Name_And_Index          := No_Name_And_Index;
4861
4862       Unit_Prj : Unit_Project;
4863
4864       File_Name_Recorded : Boolean := False;
4865
4866    begin
4867       Get_Name_String (File_Name);
4868       Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
4869       Canonical_File_Name := Name_Find;
4870
4871       declare
4872          Canonical_Path : constant String :=
4873                             Normalize_Pathname
4874                               (Get_Name_String (Path_Name),
4875                                Resolve_Links => Follow_Links,
4876                                Case_Sensitive => False);
4877       begin
4878          Name_Len := 0;
4879          Add_Str_To_Name_Buffer (Canonical_Path);
4880          Canonical_Path_Name := Name_Find;
4881       end;
4882
4883       --  Find out the unit name, the unit kind and if it needs
4884       --  a specific SFN pragma.
4885
4886       Get_Unit
4887         (Canonical_File_Name => Canonical_File_Name,
4888          Naming              => Data.Naming,
4889          Exception_Id        => Exception_Id,
4890          Unit_Name           => Unit_Name,
4891          Unit_Kind           => Unit_Kind,
4892          Needs_Pragma        => Needs_Pragma);
4893
4894       if Exception_Id = No_Ada_Naming_Exception and then
4895         Unit_Name = No_Name
4896       then
4897          if Current_Verbosity = High then
4898             Write_Str  ("   """);
4899             Write_Str  (Get_Name_String (Canonical_File_Name));
4900             Write_Line (""" is not a valid source file name (ignored).");
4901          end if;
4902
4903       else
4904          --  Check to see if the source has been hidden by an exception,
4905          --  but only if it is not an exception.
4906
4907          if not Needs_Pragma then
4908             Except_Name :=
4909               Reverse_Ada_Naming_Exceptions.Get
4910                 ((Unit_Kind, Unit_Name, No_Ada_Naming_Exception));
4911
4912             if Except_Name /= No_Name_And_Index then
4913                if Current_Verbosity = High then
4914                   Write_Str  ("   """);
4915                   Write_Str  (Get_Name_String (Canonical_File_Name));
4916                   Write_Str  (""" contains a unit that is found in """);
4917                   Write_Str  (Get_Name_String (Except_Name.Name));
4918                   Write_Line (""" (ignored).");
4919                end if;
4920
4921                --  The file is not included in the source of the project,
4922                --  because it is hidden by the exception.
4923                --  So, there is nothing else to do.
4924
4925                return;
4926             end if;
4927          end if;
4928
4929          loop
4930             if Exception_Id /= No_Ada_Naming_Exception then
4931                Info := Ada_Naming_Exception_Table.Table (Exception_Id);
4932                Exception_Id := Info.Next;
4933                Info.Next := No_Ada_Naming_Exception;
4934                Name_Index := Reverse_Ada_Naming_Exceptions.Get (Info);
4935
4936                Unit_Name  := Info.Unit;
4937                Unit_Index := Name_Index.Index;
4938                Unit_Kind  := Info.Kind;
4939             end if;
4940
4941             --  Put the file name in the list of sources of the project
4942
4943             if not File_Name_Recorded then
4944                String_Element_Table.Increment_Last
4945                  (In_Tree.String_Elements);
4946                In_Tree.String_Elements.Table
4947                  (String_Element_Table.Last
4948                    (In_Tree.String_Elements)) :=
4949                  (Value         => Canonical_File_Name,
4950                   Display_Value => File_Name,
4951                   Location      => No_Location,
4952                   Flag          => False,
4953                   Next          => Nil_String,
4954                   Index         => Unit_Index);
4955             end if;
4956
4957             if Current_Source = Nil_String then
4958                Data.Sources := String_Element_Table.Last
4959                                  (In_Tree.String_Elements);
4960             else
4961                In_Tree.String_Elements.Table
4962                  (Current_Source).Next :=
4963                  String_Element_Table.Last
4964                    (In_Tree.String_Elements);
4965             end if;
4966
4967             Current_Source := String_Element_Table.Last
4968                                 (In_Tree.String_Elements);
4969
4970             --  Put the unit in unit list
4971
4972             declare
4973                The_Unit      : Unit_Id :=
4974                  Units_Htable.Get (In_Tree.Units_HT, Unit_Name);
4975                The_Unit_Data : Unit_Data;
4976
4977             begin
4978                if Current_Verbosity = High then
4979                   Write_Str  ("Putting ");
4980                   Write_Str  (Get_Name_String (Unit_Name));
4981                   Write_Line (" in the unit list.");
4982                end if;
4983
4984                --  The unit is already in the list, but may be it is
4985                --  only the other unit kind (spec or body), or what is
4986                --  in the unit list is a unit of a project we are extending.
4987
4988                if The_Unit /= No_Unit then
4989                   The_Unit_Data := In_Tree.Units.Table (The_Unit);
4990
4991                   if The_Unit_Data.File_Names (Unit_Kind).Name = No_Name
4992                     or else Project_Extends
4993                       (Data.Extends,
4994                        The_Unit_Data.File_Names (Unit_Kind).Project,
4995                        In_Tree)
4996                   then
4997                      if The_Unit_Data.File_Names (Unit_Kind).Path = Slash then
4998                         Remove_Forbidden_File_Name
4999                           (The_Unit_Data.File_Names (Unit_Kind).Name);
5000                      end if;
5001
5002                      --  Record the file name in the hash table Files_Htable
5003
5004                      Unit_Prj := (Unit => The_Unit, Project => Project);
5005                      Files_Htable.Set
5006                        (In_Tree.Files_HT,
5007                         Canonical_File_Name,
5008                         Unit_Prj);
5009
5010                      The_Unit_Data.File_Names (Unit_Kind) :=
5011                        (Name         => Canonical_File_Name,
5012                         Index        => Unit_Index,
5013                         Display_Name => File_Name,
5014                         Path         => Canonical_Path_Name,
5015                         Display_Path => Path_Name,
5016                         Project      => Project,
5017                         Needs_Pragma => Needs_Pragma);
5018                      In_Tree.Units.Table (The_Unit) :=
5019                        The_Unit_Data;
5020                      Source_Recorded := True;
5021
5022                   elsif The_Unit_Data.File_Names (Unit_Kind).Project = Project
5023                     and then (Data.Known_Order_Of_Source_Dirs or else
5024                               The_Unit_Data.File_Names (Unit_Kind).Path =
5025                                 Canonical_Path_Name)
5026                   then
5027                      if Previous_Source = Nil_String then
5028                         Data.Sources := Nil_String;
5029                      else
5030                         In_Tree.String_Elements.Table
5031                           (Previous_Source).Next := Nil_String;
5032                         String_Element_Table.Decrement_Last
5033                           (In_Tree.String_Elements);
5034                      end if;
5035
5036                      Current_Source := Previous_Source;
5037
5038                   else
5039                      --  It is an error to have two units with the same name
5040                      --  and the same kind (spec or body).
5041
5042                      if The_Location = No_Location then
5043                         The_Location :=
5044                           In_Tree.Projects.Table
5045                             (Project).Location;
5046                      end if;
5047
5048                      Err_Vars.Error_Msg_Name_1 := Unit_Name;
5049                      Error_Msg
5050                        (Project, In_Tree, "duplicate source {", The_Location);
5051
5052                      Err_Vars.Error_Msg_Name_1 :=
5053                        In_Tree.Projects.Table
5054                          (The_Unit_Data.File_Names (Unit_Kind).Project).Name;
5055                      Err_Vars.Error_Msg_Name_2 :=
5056                        The_Unit_Data.File_Names (Unit_Kind).Path;
5057                      Error_Msg
5058                        (Project, In_Tree,
5059                         "\   project file {, {", The_Location);
5060
5061                      Err_Vars.Error_Msg_Name_1 :=
5062                        In_Tree.Projects.Table (Project).Name;
5063                      Err_Vars.Error_Msg_Name_2 := Canonical_Path_Name;
5064                      Error_Msg
5065                        (Project, In_Tree,
5066                         "\   project file {, {", The_Location);
5067                   end if;
5068
5069                --  It is a new unit, create a new record
5070
5071                else
5072                   --  First, check if there is no other unit with this file
5073                   --  name in another project. If it is, report an error.
5074                   --  Of course, we do that only for the first unit in the
5075                   --  source file.
5076
5077                   Unit_Prj := Files_Htable.Get
5078                     (In_Tree.Files_HT, Canonical_File_Name);
5079
5080                   if not File_Name_Recorded and then
5081                     Unit_Prj /= No_Unit_Project
5082                   then
5083                      Error_Msg_Name_1 := File_Name;
5084                      Error_Msg_Name_2 :=
5085                        In_Tree.Projects.Table
5086                          (Unit_Prj.Project).Name;
5087                      Error_Msg
5088                        (Project, In_Tree,
5089                         "{ is already a source of project {",
5090                         Location);
5091
5092                   else
5093                      Unit_Table.Increment_Last (In_Tree.Units);
5094                      The_Unit := Unit_Table.Last (In_Tree.Units);
5095                      Units_Htable.Set
5096                        (In_Tree.Units_HT, Unit_Name, The_Unit);
5097                      Unit_Prj := (Unit => The_Unit, Project => Project);
5098                      Files_Htable.Set
5099                        (In_Tree.Files_HT,
5100                         Canonical_File_Name,
5101                         Unit_Prj);
5102                      The_Unit_Data.Name := Unit_Name;
5103                      The_Unit_Data.File_Names (Unit_Kind) :=
5104                        (Name         => Canonical_File_Name,
5105                         Index        => Unit_Index,
5106                         Display_Name => File_Name,
5107                         Path         => Canonical_Path_Name,
5108                         Display_Path => Path_Name,
5109                         Project      => Project,
5110                         Needs_Pragma => Needs_Pragma);
5111                      In_Tree.Units.Table (The_Unit) :=
5112                        The_Unit_Data;
5113                      Source_Recorded := True;
5114                   end if;
5115                end if;
5116             end;
5117
5118             exit when Exception_Id = No_Ada_Naming_Exception;
5119             File_Name_Recorded := True;
5120          end loop;
5121       end if;
5122    end Record_Ada_Source;
5123
5124    --------------------------
5125    -- Record_Other_Sources --
5126    --------------------------
5127
5128    procedure Record_Other_Sources
5129      (Project           : Project_Id;
5130       In_Tree           : Project_Tree_Ref;
5131       Data              : in out Project_Data;
5132       Language          : Language_Index;
5133       Naming_Exceptions : Boolean)
5134    is
5135       Source_Dir : String_List_Id := Data.Source_Dirs;
5136       Element    : String_Element;
5137       Path       : Name_Id;
5138
5139       Dir            : Dir_Type;
5140       Canonical_Name : Name_Id;
5141
5142       Name_Str : String (1 .. 1_024);
5143       Last     : Natural := 0;
5144       NL       : Name_Location;
5145
5146       First_Error : Boolean := True;
5147
5148       Suffix : constant String := Body_Suffix_Of (Language, Data, In_Tree);
5149
5150    begin
5151       while Source_Dir /= Nil_String loop
5152          Element := In_Tree.String_Elements.Table (Source_Dir);
5153
5154          declare
5155             Dir_Path : constant String := Get_Name_String (Element.Value);
5156
5157          begin
5158             if Current_Verbosity = High then
5159                Write_Str ("checking directory """);
5160                Write_Str (Dir_Path);
5161                Write_Str (""" for ");
5162
5163                if Naming_Exceptions then
5164                   Write_Str ("naming exceptions");
5165
5166                else
5167                   Write_Str ("sources");
5168                end if;
5169
5170                Write_Str (" of Language ");
5171                Display_Language_Name (Language);
5172             end if;
5173
5174             Open (Dir, Dir_Path);
5175
5176             loop
5177                Read (Dir, Name_Str, Last);
5178                exit when Last = 0;
5179
5180                if Is_Regular_File
5181                  (Dir_Path & Directory_Separator & Name_Str (1 .. Last))
5182                then
5183                   Name_Len := Last;
5184                   Name_Buffer (1 .. Name_Len) := Name_Str (1 .. Last);
5185                   Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
5186                   Canonical_Name := Name_Find;
5187                   NL := Source_Names.Get (Canonical_Name);
5188
5189                   if NL /= No_Name_Location then
5190                      if NL.Found then
5191                         if not Data.Known_Order_Of_Source_Dirs then
5192                            Error_Msg_Name_1 := Canonical_Name;
5193                            Error_Msg
5194                              (Project, In_Tree,
5195                               "{ is found in several source directories",
5196                               NL.Location);
5197                         end if;
5198
5199                      else
5200                         NL.Found := True;
5201                         Source_Names.Set (Canonical_Name, NL);
5202                         Name_Len := Dir_Path'Length;
5203                         Name_Buffer (1 .. Name_Len) := Dir_Path;
5204                         Add_Char_To_Name_Buffer (Directory_Separator);
5205                         Add_Str_To_Name_Buffer (Name_Str (1 .. Last));
5206                         Path := Name_Find;
5207
5208                         Check_For_Source
5209                           (File_Name        => Canonical_Name,
5210                            Path_Name        => Path,
5211                            Project          => Project,
5212                            In_Tree          => In_Tree,
5213                            Data             => Data,
5214                            Location         => NL.Location,
5215                            Language         => Language,
5216                            Suffix           => Suffix,
5217                            Naming_Exception => Naming_Exceptions);
5218                      end if;
5219                   end if;
5220                end if;
5221             end loop;
5222
5223             Close (Dir);
5224          end;
5225
5226          Source_Dir := Element.Next;
5227       end loop;
5228
5229       if not Naming_Exceptions then
5230          NL := Source_Names.Get_First;
5231
5232          --  It is an error if a source file name in a source list or
5233          --  in a source list file is not found.
5234
5235          while NL /= No_Name_Location loop
5236             if not NL.Found then
5237                Err_Vars.Error_Msg_Name_1 := NL.Name;
5238
5239                if First_Error then
5240                   Error_Msg
5241                     (Project, In_Tree,
5242                      "source file { cannot be found",
5243                      NL.Location);
5244                   First_Error := False;
5245
5246                else
5247                   Error_Msg
5248                     (Project, In_Tree,
5249                      "\source file { cannot be found",
5250                      NL.Location);
5251                end if;
5252             end if;
5253
5254             NL := Source_Names.Get_Next;
5255          end loop;
5256
5257          --  Any naming exception of this language that is not in a list
5258          --  of sources must be removed.
5259
5260          declare
5261             Source_Id : Other_Source_Id := Data.First_Other_Source;
5262             Prev_Id   : Other_Source_Id := No_Other_Source;
5263             Source    : Other_Source;
5264
5265          begin
5266             while Source_Id /= No_Other_Source loop
5267                Source := In_Tree.Other_Sources.Table (Source_Id);
5268
5269                if Source.Language = Language
5270                  and then Source.Naming_Exception
5271                then
5272                   if Current_Verbosity = High then
5273                      Write_Str ("Naming exception """);
5274                      Write_Str (Get_Name_String (Source.File_Name));
5275                      Write_Str (""" is not in the list of sources,");
5276                      Write_Line (" so it is removed.");
5277                   end if;
5278
5279                   if Prev_Id = No_Other_Source then
5280                      Data.First_Other_Source := Source.Next;
5281
5282                   else
5283                      In_Tree.Other_Sources.Table
5284                        (Prev_Id).Next := Source.Next;
5285                   end if;
5286
5287                   Source_Id := Source.Next;
5288
5289                   if Source_Id = No_Other_Source then
5290                      Data.Last_Other_Source := Prev_Id;
5291                   end if;
5292
5293                else
5294                   Prev_Id := Source_Id;
5295                   Source_Id := Source.Next;
5296                end if;
5297             end loop;
5298          end;
5299       end if;
5300    end Record_Other_Sources;
5301
5302    ----------------------
5303    -- Show_Source_Dirs --
5304    ----------------------
5305
5306    procedure Show_Source_Dirs
5307      (Project : Project_Id;
5308       In_Tree : Project_Tree_Ref)
5309    is
5310       Current : String_List_Id;
5311       Element : String_Element;
5312
5313    begin
5314       Write_Line ("Source_Dirs:");
5315
5316       Current := In_Tree.Projects.Table (Project).Source_Dirs;
5317       while Current /= Nil_String loop
5318          Element := In_Tree.String_Elements.Table (Current);
5319          Write_Str  ("   ");
5320          Write_Line (Get_Name_String (Element.Value));
5321          Current := Element.Next;
5322       end loop;
5323
5324       Write_Line ("end Source_Dirs.");
5325    end Show_Source_Dirs;
5326
5327    ----------------
5328    -- Suffix_For --
5329    ----------------
5330
5331    function Suffix_For
5332      (Language : Language_Index;
5333       Naming   : Naming_Data;
5334       In_Tree  : Project_Tree_Ref) return Name_Id
5335    is
5336       Suffix : constant Variable_Value :=
5337         Value_Of
5338           (Index     => Language_Names.Table (Language),
5339            Src_Index => 0,
5340            In_Array  => Naming.Body_Suffix,
5341            In_Tree   => In_Tree);
5342    begin
5343       --  If no suffix for this language in package Naming, use the default
5344
5345       if Suffix = Nil_Variable_Value then
5346          Name_Len := 0;
5347
5348          case Language is
5349             when Ada_Language_Index =>
5350                Add_Str_To_Name_Buffer (".adb");
5351
5352             when C_Language_Index =>
5353                Add_Str_To_Name_Buffer (".c");
5354
5355             when C_Plus_Plus_Language_Index =>
5356                Add_Str_To_Name_Buffer (".cpp");
5357
5358             when others =>
5359                return No_Name;
5360          end case;
5361
5362       --  Otherwise use the one specified
5363
5364       else
5365          Get_Name_String (Suffix.Value);
5366       end if;
5367
5368       Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
5369       return Name_Find;
5370    end Suffix_For;
5371
5372    -------------------------
5373    -- Warn_If_Not_Sources --
5374    -------------------------
5375
5376    --  comments needed in this body ???
5377
5378    procedure Warn_If_Not_Sources
5379      (Project     : Project_Id;
5380       In_Tree     : Project_Tree_Ref;
5381       Conventions : Array_Element_Id;
5382       Specs       : Boolean;
5383       Extending   : Boolean)
5384    is
5385       Conv          : Array_Element_Id := Conventions;
5386       Unit          : Name_Id;
5387       The_Unit_Id   : Unit_Id;
5388       The_Unit_Data : Unit_Data;
5389       Location      : Source_Ptr;
5390
5391    begin
5392       while Conv /= No_Array_Element loop
5393          Unit := In_Tree.Array_Elements.Table (Conv).Index;
5394          Error_Msg_Name_1 := Unit;
5395          Get_Name_String (Unit);
5396          To_Lower (Name_Buffer (1 .. Name_Len));
5397          Unit := Name_Find;
5398          The_Unit_Id := Units_Htable.Get
5399            (In_Tree.Units_HT, Unit);
5400          Location := In_Tree.Array_Elements.Table
5401                                             (Conv).Value.Location;
5402
5403          if The_Unit_Id = No_Unit then
5404             Error_Msg
5405               (Project, In_Tree,
5406                "?unknown unit {",
5407                Location);
5408
5409          else
5410             The_Unit_Data := In_Tree.Units.Table (The_Unit_Id);
5411
5412             if Specs then
5413                if not Check_Project
5414                  (The_Unit_Data.File_Names (Specification).Project,
5415                   Project, In_Tree, Extending)
5416                then
5417                   Error_Msg
5418                     (Project, In_Tree,
5419                      "?unit{ has no spec in this project",
5420                      Location);
5421                end if;
5422
5423             else
5424                if not Check_Project
5425                  (The_Unit_Data.File_Names (Body_Part).Project,
5426                   Project, In_Tree, Extending)
5427                then
5428                   Error_Msg
5429                     (Project, In_Tree,
5430                      "?unit{ has no body in this project",
5431                      Location);
5432                end if;
5433             end if;
5434          end if;
5435
5436          Conv := In_Tree.Array_Elements.Table (Conv).Next;
5437       end loop;
5438    end Warn_If_Not_Sources;
5439
5440 end Prj.Nmsc;