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