gcc/ada/prj-nmsc.adb

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