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