gcc/ada/prj-nmsc.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             P R J . N M S C                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2000-2004 Free Software Foundation, Inc.          --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, USA.                                                      --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with Err_Vars; use Err_Vars;
  28 with Fmap;     use Fmap;
  29 with Hostparm;
  30 with MLib.Tgt;
  31 with Namet;    use Namet;
  32 with Osint;    use Osint;
  33 with Output;   use Output;
  34 with MLib.Tgt; use MLib.Tgt;
  35 with Prj.Com;  use Prj.Com;
  36 with Prj.Env;  use Prj.Env;
  37 with Prj.Err;
  38 with Prj.Util; use Prj.Util;
  39 with Sinput.P;
  40 with Snames;   use Snames;
  41 with Types;    use Types;
  42
  43 with Ada.Characters.Handling;    use Ada.Characters.Handling;
  44 with Ada.Strings;                use Ada.Strings;
  45 with Ada.Strings.Fixed;          use Ada.Strings.Fixed;
  46 with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
  47
  48 with GNAT.Case_Util;             use GNAT.Case_Util;
  49 with GNAT.Directory_Operations;  use GNAT.Directory_Operations;
  50 with GNAT.OS_Lib;                use GNAT.OS_Lib;
  51 with GNAT.HTable;
  52
  53 package body Prj.Nmsc is
  54
  55    Error_Report    : Put_Line_Access := null;
  56
  57    ALI_Suffix : constant String := ".ali";
  58
  59    type Name_Location is record
  60       Name     : Name_Id;
  61       Location : Source_Ptr;
  62       Found    : Boolean := False;
  63    end record;
  64    --  Information about file names found in string list attribute
  65    --  Source_Files or in a source list file, stored in hash table
  66    --  Source_Names, used by procedure
  67    --  Ada_Check.Get_Path_Names_And_Record_Sources.
  68
  69    No_Name_Location : constant Name_Location :=
  70      (Name => No_Name, Location => No_Location, Found => False);
  71
  72    package Source_Names is new GNAT.HTable.Simple_HTable
  73      (Header_Num => Header_Num,
  74       Element    => Name_Location,
  75       No_Element => No_Name_Location,
  76       Key        => Name_Id,
  77       Hash       => Hash,
  78       Equal      => "=");
  79    --  Hash table to store file names found in string list attribute
  80    --  Source_Files or in a source list file, stored in hash table
  81    --  Source_Names, used by procedure
  82    --  Ada_Check.Get_Path_Names_And_Record_Sources.
  83
  84    package Recursive_Dirs is new GNAT.HTable.Simple_HTable
  85      (Header_Num => Header_Num,
  86       Element    => Boolean,
  87       No_Element => False,
  88       Key        => Name_Id,
  89       Hash       => Hash,
  90       Equal      => "=");
  91    --  Hash table to store recursive source directories, to avoid looking
  92    --  several times, and to avoid cycles that may be introduced by symbolic
  93    --  links.
  94
  95    function ALI_File_Name (Source : String) return String;
  96    --  Return the ALI file name corresponding to a source.
  97
  98    procedure Check_Ada_Naming_Scheme
  99      (Project : Project_Id;
 100       Naming  : Naming_Data);
 101    --  Check that the package Naming is correct.
 102
 103    procedure Check_Ada_Name
 104      (Name : String;
 105       Unit : out Name_Id);
 106    --  Check that a name is a valid Ada unit name.
 107
 108    procedure Error_Msg
 109      (Project       : Project_Id;
 110       Msg           : String;
 111       Flag_Location : Source_Ptr);
 112    --  Output an error message. If Error_Report is null, simply call
 113    --  Prj.Err.Error_Msg. Otherwise, disregard Flag_Location and use
 114    --  Error_Report.
 115
 116    procedure Get_Unit
 117      (Canonical_File_Name : Name_Id;
 118       Naming              : Naming_Data;
 119       Unit_Name           : out Name_Id;
 120       Unit_Kind           : out Spec_Or_Body;
 121       Needs_Pragma        : out Boolean);
 122    --  Find out, from a file name, the unit name, the unit kind and if a
 123    --  specific SFN pragma is needed. If the file name corresponds to no
 124    --  unit, then Unit_Name will be No_Name.
 125
 126    function Is_Illegal_Suffix
 127      (Suffix                          : String;
 128       Dot_Replacement_Is_A_Single_Dot : Boolean) return Boolean;
 129    --  Returns True if the string Suffix cannot be used as
 130    --  a spec suffix, a body suffix or a separate suffix.
 131
 132    procedure Record_Source
 133      (File_Name       : Name_Id;
 134       Path_Name       : Name_Id;
 135       Project         : Project_Id;
 136       Data            : in out Project_Data;
 137       Location        : Source_Ptr;
 138       Current_Source  : in out String_List_Id;
 139       Source_Recorded : in out Boolean);
 140    --  Put a unit in the list of units of a project, if the file name
 141    --  corresponds to a valid unit name.
 142
 143    procedure Show_Source_Dirs (Project : Project_Id);
 144    --  List all the source directories of a project.
 145
 146    procedure Locate_Directory
 147      (Name    : Name_Id;
 148       Parent  : Name_Id;
 149       Dir     : out Name_Id;
 150       Display : out Name_Id);
 151    --  Locate a directory.
 152    --  Returns No_Name if directory does not exist.
 153
 154    function Path_Name_Of
 155      (File_Name : Name_Id;
 156       Directory : Name_Id) return String;
 157    --  Returns the path name of a (non project) file.
 158    --  Returns an empty string if file cannot be found.
 159
 160    function Project_Extends
 161      (Extending : Project_Id;
 162       Extended  : Project_Id) return Boolean;
 163    --  Returns True if Extending is extending directly or indirectly Extended.
 164
 165    procedure Check_Naming_Scheme
 166      (Data    : in out Project_Data;
 167       Project : Project_Id);
 168    --  Check the naming scheme part of Data
 169
 170    type Unit_Info is record
 171       Kind : Spec_Or_Body;
 172       Unit : Name_Id;
 173    end record;
 174    No_Unit : constant Unit_Info := (Specification, No_Name);
 175
 176    package Naming_Exceptions is new GNAT.HTable.Simple_HTable
 177      (Header_Num => Header_Num,
 178       Element    => Unit_Info,
 179       No_Element => No_Unit,
 180       Key        => Name_Id,
 181       Hash       => Hash,
 182       Equal      => "=");
 183
 184    function Hash (Unit : Unit_Info) return Header_Num;
 185
 186    package Reverse_Naming_Exceptions is new GNAT.HTable.Simple_HTable
 187      (Header_Num => Header_Num,
 188       Element    => Name_Id,
 189       No_Element => No_Name,
 190       Key        => Unit_Info,
 191       Hash       => Hash,
 192       Equal      => "=");
 193    --  A table to check if a unit with an exceptional name will hide
 194    --  a source with a file name following the naming convention.
 195
 196    procedure Prepare_Naming_Exceptions
 197      (List : Array_Element_Id;
 198       Kind : Spec_Or_Body);
 199    --  Prepare the internal hash tables used for checking naming exceptions.
 200    --  Insert all elements of List in the tables.
 201
 202    procedure Free_Naming_Exceptions;
 203    --  Free the internal hash tables used for checking naming exceptions
 204
 205    function Compute_Directory_Last (Dir : String) return Natural;
 206    --  Return the index of the last significant character in Dir. This is used
 207    --  to avoid duplicates '/' at the end of directory names
 208
 209    ----------------------------
 210    -- Compute_Directory_Last --
 211    ----------------------------
 212
 213    function Compute_Directory_Last (Dir : String) return Natural is
 214    begin
 215       if Dir'Length > 1
 216         and then (Dir (Dir'Last - 1) = Directory_Separator
 217                   or else Dir (Dir'Last - 1) = '/')
 218       then
 219          return Dir'Last - 1;
 220       else
 221          return Dir'Last;
 222       end if;
 223    end Compute_Directory_Last;
 224
 225
 226    -------------------------------
 227    -- Prepare_Naming_Exceptions --
 228    -------------------------------
 229
 230    procedure Prepare_Naming_Exceptions
 231      (List : Array_Element_Id;
 232       Kind : Spec_Or_Body)
 233    is
 234       Current : Array_Element_Id := List;
 235       Element : Array_Element;
 236
 237    begin
 238       while Current /= No_Array_Element loop
 239          Element := Array_Elements.Table (Current);
 240
 241          if Element.Index /= No_Name then
 242             Naming_Exceptions.Set
 243               (Element.Value.Value,
 244                (Kind => Kind, Unit => Element.Index));
 245             Reverse_Naming_Exceptions.Set
 246               ((Kind => Kind, Unit => Element.Index),
 247                Element.Value.Value);
 248          end if;
 249
 250          Current := Element.Next;
 251       end loop;
 252    end Prepare_Naming_Exceptions;
 253
 254    ----------
 255    -- Hash --
 256    ----------
 257
 258    function Hash (Unit : Unit_Info) return Header_Num is
 259    begin
 260       return Header_Num (Unit.Unit mod 2048);
 261    end Hash;
 262
 263    ----------------------------
 264    -- Free_Naming_Exceptions --
 265    ----------------------------
 266
 267    procedure Free_Naming_Exceptions is
 268    begin
 269       Naming_Exceptions.Reset;
 270       Reverse_Naming_Exceptions.Reset;
 271    end Free_Naming_Exceptions;
 272
 273    -------------------------
 274    -- Check_Naming_Scheme --
 275    -------------------------
 276
 277    procedure Check_Naming_Scheme
 278      (Data    : in out Project_Data;
 279       Project : Project_Id)
 280    is
 281       Naming_Id : constant Package_Id :=
 282                     Util.Value_Of (Name_Naming, Data.Decl.Packages);
 283
 284       Naming : Package_Element;
 285
 286       procedure Check_Unit_Names (List : Array_Element_Id);
 287       --  Check that a list of unit names contains only valid names.
 288
 289       ----------------------
 290       -- Check_Unit_Names --
 291       ----------------------
 292
 293       procedure Check_Unit_Names (List : Array_Element_Id) is
 294          Current   : Array_Element_Id := List;
 295          Element   : Array_Element;
 296          Unit_Name : Name_Id;
 297
 298       begin
 299          --  Loop through elements of the string list
 300
 301          while Current /= No_Array_Element loop
 302             Element := Array_Elements.Table (Current);
 303
 304             --  Put file name in canonical case
 305
 306             Get_Name_String (Element.Value.Value);
 307             Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
 308             Element.Value.Value := Name_Find;
 309
 310             --  Check that it contains a valid unit name
 311
 312             Get_Name_String (Element.Index);
 313             Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit_Name);
 314
 315             if Unit_Name = No_Name then
 316                Err_Vars.Error_Msg_Name_1 := Element.Index;
 317                Error_Msg
 318                  (Project,
 319                   "{ is not a valid unit name.",
 320                   Element.Value.Location);
 321
 322             else
 323                if Current_Verbosity = High then
 324                   Write_Str ("    Unit (""");
 325                   Write_Str (Get_Name_String (Unit_Name));
 326                   Write_Line (""")");
 327                end if;
 328
 329                Element.Index := Unit_Name;
 330                Array_Elements.Table (Current) := Element;
 331             end if;
 332
 333             Current := Element.Next;
 334          end loop;
 335       end Check_Unit_Names;
 336
 337    --  Start of processing for Check_Naming_Scheme
 338
 339    begin
 340       --  If there is a package Naming, we will put in Data.Naming what is in
 341       --  this package Naming.
 342
 343       if Naming_Id /= No_Package then
 344          Naming := Packages.Table (Naming_Id);
 345
 346          if Current_Verbosity = High then
 347             Write_Line ("Checking ""Naming"" for Ada.");
 348          end if;
 349
 350          declare
 351             Bodies : constant Array_Element_Id :=
 352                        Util.Value_Of (Name_Body, Naming.Decl.Arrays);
 353
 354             Specs : constant Array_Element_Id :=
 355                       Util.Value_Of (Name_Spec, Naming.Decl.Arrays);
 356
 357          begin
 358             if Bodies /= No_Array_Element then
 359
 360                --  We have elements in the array Body_Part
 361
 362                if Current_Verbosity = High then
 363                   Write_Line ("Found Bodies.");
 364                end if;
 365
 366                Data.Naming.Bodies := Bodies;
 367                Check_Unit_Names (Bodies);
 368
 369             else
 370                if Current_Verbosity = High then
 371                   Write_Line ("No Bodies.");
 372                end if;
 373             end if;
 374
 375             if Specs /= No_Array_Element then
 376
 377                --  We have elements in the array Specs
 378
 379                if Current_Verbosity = High then
 380                   Write_Line ("Found Specs.");
 381                end if;
 382
 383                Data.Naming.Specs := Specs;
 384                Check_Unit_Names (Specs);
 385
 386             else
 387                if Current_Verbosity = High then
 388                   Write_Line ("No Specs.");
 389                end if;
 390             end if;
 391          end;
 392
 393          --  We are now checking if variables Dot_Replacement, Casing,
 394          --  Spec_Suffix, Body_Suffix and/or Separate_Suffix
 395          --  exist.
 396
 397          --  For each variable, if it does not exist, we do nothing,
 398          --  because we already have the default.
 399
 400          --  Check Dot_Replacement
 401
 402          declare
 403             Dot_Replacement : constant Variable_Value :=
 404                                 Util.Value_Of
 405                                   (Name_Dot_Replacement,
 406                                    Naming.Decl.Attributes);
 407
 408          begin
 409             pragma Assert (Dot_Replacement.Kind = Single,
 410                            "Dot_Replacement is not a single string");
 411
 412             if not Dot_Replacement.Default then
 413                Get_Name_String (Dot_Replacement.Value);
 414
 415                if Name_Len = 0 then
 416                   Error_Msg
 417                     (Project,
 418                      "Dot_Replacement cannot be empty",
 419                      Dot_Replacement.Location);
 420
 421                else
 422                   Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
 423                   Data.Naming.Dot_Replacement := Name_Find;
 424                   Data.Naming.Dot_Repl_Loc := Dot_Replacement.Location;
 425                end if;
 426             end if;
 427          end;
 428
 429          if Current_Verbosity = High then
 430             Write_Str  ("  Dot_Replacement = """);
 431             Write_Str  (Get_Name_String (Data.Naming.Dot_Replacement));
 432             Write_Char ('"');
 433             Write_Eol;
 434          end if;
 435
 436          --  Check Casing
 437
 438          declare
 439             Casing_String : constant Variable_Value :=
 440                               Util.Value_Of
 441                                 (Name_Casing, Naming.Decl.Attributes);
 442
 443          begin
 444             pragma Assert (Casing_String.Kind = Single,
 445                            "Casing is not a single string");
 446
 447             if not Casing_String.Default then
 448                declare
 449                   Casing_Image : constant String :=
 450                                    Get_Name_String (Casing_String.Value);
 451                begin
 452                   declare
 453                      Casing : constant Casing_Type := Value (Casing_Image);
 454                   begin
 455                      Data.Naming.Casing := Casing;
 456                   end;
 457
 458                exception
 459                   when Constraint_Error =>
 460                      if Casing_Image'Length = 0 then
 461                         Error_Msg
 462                           (Project,
 463                            "Casing cannot be an empty string",
 464                            Casing_String.Location);
 465
 466                      else
 467                         Name_Len := Casing_Image'Length;
 468                         Name_Buffer (1 .. Name_Len) := Casing_Image;
 469                         Err_Vars.Error_Msg_Name_1 := Name_Find;
 470                         Error_Msg
 471                           (Project,
 472                            "{ is not a correct Casing",
 473                            Casing_String.Location);
 474                      end if;
 475                end;
 476             end if;
 477          end;
 478
 479          if Current_Verbosity = High then
 480             Write_Str  ("  Casing = ");
 481             Write_Str  (Image (Data.Naming.Casing));
 482             Write_Char ('.');
 483             Write_Eol;
 484          end if;
 485
 486          --  Check Spec_Suffix
 487
 488          declare
 489             Ada_Spec_Suffix : constant Variable_Value :=
 490                                 Prj.Util.Value_Of
 491                                  (Index => Name_Ada,
 492                                   In_Array => Data.Naming.Spec_Suffix);
 493
 494          begin
 495             if Ada_Spec_Suffix.Kind = Single
 496               and then Get_Name_String (Ada_Spec_Suffix.Value) /= ""
 497             then
 498                Data.Naming.Current_Spec_Suffix := Ada_Spec_Suffix.Value;
 499                Data.Naming.Spec_Suffix_Loc := Ada_Spec_Suffix.Location;
 500
 501             else
 502                Data.Naming.Current_Spec_Suffix := Default_Ada_Spec_Suffix;
 503             end if;
 504          end;
 505
 506          if Current_Verbosity = High then
 507             Write_Str  ("  Spec_Suffix = """);
 508             Write_Str  (Get_Name_String (Data.Naming.Current_Spec_Suffix));
 509             Write_Char ('"');
 510             Write_Eol;
 511          end if;
 512
 513          --  Check Body_Suffix
 514
 515          declare
 516             Ada_Body_Suffix : constant Variable_Value :=
 517               Prj.Util.Value_Of
 518               (Index => Name_Ada,
 519                In_Array => Data.Naming.Body_Suffix);
 520
 521          begin
 522             if Ada_Body_Suffix.Kind = Single
 523               and then Get_Name_String (Ada_Body_Suffix.Value) /= ""
 524             then
 525                Data.Naming.Current_Body_Suffix := Ada_Body_Suffix.Value;
 526                Data.Naming.Body_Suffix_Loc := Ada_Body_Suffix.Location;
 527
 528             else
 529                Data.Naming.Current_Body_Suffix := Default_Ada_Body_Suffix;
 530             end if;
 531          end;
 532
 533          if Current_Verbosity = High then
 534             Write_Str  ("  Body_Suffix = """);
 535             Write_Str  (Get_Name_String (Data.Naming.Current_Body_Suffix));
 536             Write_Char ('"');
 537             Write_Eol;
 538          end if;
 539
 540          --  Check Separate_Suffix
 541
 542          declare
 543             Ada_Sep_Suffix : constant Variable_Value :=
 544                                Prj.Util.Value_Of
 545                                  (Variable_Name => Name_Separate_Suffix,
 546                                   In_Variables  => Naming.Decl.Attributes);
 547
 548          begin
 549             if Ada_Sep_Suffix.Default then
 550                Data.Naming.Separate_Suffix :=
 551                  Data.Naming.Current_Body_Suffix;
 552
 553             else
 554                if Get_Name_String (Ada_Sep_Suffix.Value) = "" then
 555                   Error_Msg
 556                     (Project,
 557                      "Separate_Suffix cannot be empty",
 558                      Ada_Sep_Suffix.Location);
 559
 560                else
 561                   Data.Naming.Separate_Suffix := Ada_Sep_Suffix.Value;
 562                   Data.Naming.Sep_Suffix_Loc  := Ada_Sep_Suffix.Location;
 563                end if;
 564             end if;
 565          end;
 566
 567          if Current_Verbosity = High then
 568             Write_Str  ("  Separate_Suffix = """);
 569             Write_Str  (Get_Name_String (Data.Naming.Separate_Suffix));
 570             Write_Char ('"');
 571             Write_Eol;
 572          end if;
 573
 574          --  Check if Data.Naming is valid
 575
 576          Check_Ada_Naming_Scheme (Project, Data.Naming);
 577
 578       else
 579          Data.Naming.Current_Spec_Suffix := Default_Ada_Spec_Suffix;
 580          Data.Naming.Current_Body_Suffix := Default_Ada_Body_Suffix;
 581          Data.Naming.Separate_Suffix     := Default_Ada_Body_Suffix;
 582       end if;
 583    end Check_Naming_Scheme;
 584
 585    ---------------
 586    -- Ada_Check --
 587    ---------------
 588
 589    procedure Ada_Check
 590      (Project      : Project_Id;
 591       Report_Error : Put_Line_Access)
 592    is
 593       Data         : Project_Data;
 594       Languages    : Variable_Value := Nil_Variable_Value;
 595
 596       Extending    : Boolean := False;
 597
 598       function Check_Project (P : Project_Id) return Boolean;
 599       --  Returns True if P is Project or a project extended by Project
 600
 601       procedure Find_Sources;
 602       --  Find all the sources in all of the source directories
 603       --  of a project.
 604
 605       procedure Get_Path_Names_And_Record_Sources;
 606       --  Find the path names of the source files in the Source_Names table
 607       --  in the source directories and record those that are Ada sources.
 608
 609       procedure Get_Sources_From_File
 610         (Path     : String;
 611          Location : Source_Ptr);
 612       --  Get the sources of a project from a text file
 613
 614       procedure Warn_If_Not_Sources
 615         (Conventions : Array_Element_Id;
 616          Specs       : Boolean);
 617       --  Check that individual naming conventions apply to immediate
 618       --  sources of the project; if not, issue a warning.
 619
 620       -------------------
 621       -- Check_Project --
 622       -------------------
 623
 624       function Check_Project (P : Project_Id) return Boolean is
 625       begin
 626          if P = Project then
 627             return True;
 628          elsif Extending then
 629             declare
 630                Data : Project_Data := Projects.Table (Project);
 631
 632             begin
 633                while Data.Extends /= No_Project loop
 634                   if P = Data.Extends then
 635                      return True;
 636                   end if;
 637
 638                   Data := Projects.Table (Data.Extends);
 639                end loop;
 640             end;
 641          end if;
 642
 643          return False;
 644       end Check_Project;
 645
 646       ------------------
 647       -- Find_Sources --
 648       ------------------
 649
 650       procedure Find_Sources is
 651          Source_Dir      : String_List_Id := Data.Source_Dirs;
 652          Element         : String_Element;
 653          Dir             : Dir_Type;
 654          Current_Source  : String_List_Id := Nil_String;
 655          Source_Recorded : Boolean := False;
 656
 657       begin
 658          if Current_Verbosity = High then
 659             Write_Line ("Looking for sources:");
 660          end if;
 661
 662          --  For each subdirectory
 663
 664          while Source_Dir /= Nil_String loop
 665             begin
 666                Source_Recorded := False;
 667                Element := String_Elements.Table (Source_Dir);
 668                if Element.Value /= No_Name then
 669                   declare
 670                      Source_Directory : constant String :=
 671                        Get_Name_String (Element.Value);
 672
 673                   begin
 674                      if Current_Verbosity = High then
 675                         Write_Str ("Source_Dir = ");
 676                         Write_Line (Source_Directory);
 677                      end if;
 678
 679                      --  We look to every entry in the source directory
 680
 681                      Open (Dir, Source_Directory);
 682
 683                      --  Canonical_Case_File_Name (Source_Directory);
 684
 685                      loop
 686                         Read (Dir, Name_Buffer, Name_Len);
 687
 688                         if Current_Verbosity = High then
 689                            Write_Str  ("   Checking ");
 690                            Write_Line (Name_Buffer (1 .. Name_Len));
 691                         end if;
 692
 693                         exit when Name_Len = 0;
 694
 695                         --  Canonical_Case_File_Name
 696                         --    (Name_Buffer (1 .. Name_Len));
 697
 698                         declare
 699                            File_Name : constant Name_Id := Name_Find;
 700                            Dir       : constant String :=
 701                                          Source_Directory &
 702                                          Directory_Separator;
 703                            Dir_Last  : constant Natural :=
 704                                          Compute_Directory_Last (Dir);
 705                            Path      : constant String :=
 706                                   Normalize_Pathname
 707                                     (Name      => Name_Buffer (1 .. Name_Len),
 708                                      Directory => Dir (Dir'First .. Dir_Last));
 709                            Path_Name : Name_Id;
 710
 711                         begin
 712                            if Is_Regular_File (Path) then
 713
 714                               Name_Len := Path'Length;
 715                               Name_Buffer (1 .. Name_Len) := Path;
 716                               Path_Name := Name_Find;
 717
 718                               --  We attempt to register it as a source.
 719                               --  However, there is no error if the file
 720                               --  does not contain a valid source.
 721                               --  But there is an error if we have a
 722                               --  duplicate unit name.
 723
 724                               Record_Source
 725                                 (File_Name       => File_Name,
 726                                  Path_Name       => Path_Name,
 727                                  Project         => Project,
 728                                  Data            => Data,
 729                                  Location        => No_Location,
 730                                  Current_Source  => Current_Source,
 731                                  Source_Recorded => Source_Recorded);
 732                            end if;
 733                         end;
 734                      end loop;
 735
 736                      Close (Dir);
 737                   end;
 738                end if;
 739
 740             exception
 741                when Directory_Error =>
 742                   null;
 743             end;
 744
 745             if Source_Recorded then
 746                String_Elements.Table (Source_Dir).Flag := True;
 747             end if;
 748
 749             Source_Dir := Element.Next;
 750          end loop;
 751
 752          if Current_Verbosity = High then
 753             Write_Line ("end Looking for sources.");
 754          end if;
 755
 756          --  If we have looked for sources and found none, then
 757          --  it is an error, except if it is an extending project.
 758          --  If a non extending project is not supposed to contain
 759          --  any source, then we never call Find_Sources.
 760
 761          if Current_Source /= Nil_String then
 762             Data.Sources_Present := True;
 763
 764          elsif Data.Extends = No_Project then
 765             Error_Msg
 766               (Project,
 767                "there are no Ada sources in this project",
 768                Data.Location);
 769          end if;
 770       end Find_Sources;
 771
 772       ---------------------------------------
 773       -- Get_Path_Names_And_Record_Sources --
 774       ---------------------------------------
 775
 776       procedure Get_Path_Names_And_Record_Sources is
 777          Source_Dir : String_List_Id := Data.Source_Dirs;
 778          Element    : String_Element;
 779          Path       : Name_Id;
 780
 781          Dir      : Dir_Type;
 782          Name     : Name_Id;
 783          Canonical_Name : Name_Id;
 784          Name_Str : String (1 .. 1_024);
 785          Last     : Natural := 0;
 786          NL       : Name_Location;
 787
 788          Current_Source : String_List_Id := Nil_String;
 789
 790          First_Error : Boolean := True;
 791
 792          Source_Recorded : Boolean := False;
 793
 794       begin
 795          --  We look in all source directories for this file name
 796
 797          while Source_Dir /= Nil_String loop
 798             Source_Recorded := False;
 799             Element := String_Elements.Table (Source_Dir);
 800
 801             declare
 802                Dir_Path : constant String := Get_Name_String (Element.Value);
 803             begin
 804                if Current_Verbosity = High then
 805                   Write_Str ("checking directory """);
 806                   Write_Str (Dir_Path);
 807                   Write_Line ("""");
 808                end if;
 809
 810                Open (Dir, Dir_Path);
 811
 812                loop
 813                   Read (Dir, Name_Str, Last);
 814                   exit when Last = 0;
 815                   Name_Len := Last;
 816                   Name_Buffer (1 .. Name_Len) := Name_Str (1 .. Last);
 817                   Name := Name_Find;
 818                   Canonical_Case_File_Name (Name_Str (1 .. Last));
 819                   Name_Len := Last;
 820                   Name_Buffer (1 .. Name_Len) := Name_Str (1 .. Last);
 821                   Canonical_Name := Name_Find;
 822                   NL := Source_Names.Get (Canonical_Name);
 823
 824                   if NL /= No_Name_Location and then not NL.Found then
 825                      NL.Found := True;
 826                      Source_Names.Set (Canonical_Name, NL);
 827                      Name_Len := Dir_Path'Length;
 828                      Name_Buffer (1 .. Name_Len) := Dir_Path;
 829                      Add_Char_To_Name_Buffer (Directory_Separator);
 830                      Add_Str_To_Name_Buffer (Name_Str (1 .. Last));
 831                      Path := Name_Find;
 832
 833                      if Current_Verbosity = High then
 834                         Write_Str  ("  found ");
 835                         Write_Line (Get_Name_String (Name));
 836                      end if;
 837
 838                      --  Register the source if it is an Ada compilation unit..
 839
 840                      Record_Source
 841                        (File_Name       => Name,
 842                         Path_Name       => Path,
 843                         Project         => Project,
 844                         Data            => Data,
 845                         Location        => NL.Location,
 846                         Current_Source  => Current_Source,
 847                         Source_Recorded => Source_Recorded);
 848                   end if;
 849                end loop;
 850
 851                Close (Dir);
 852             end;
 853
 854             if Source_Recorded then
 855                String_Elements.Table (Source_Dir).Flag := True;
 856             end if;
 857
 858             Source_Dir := Element.Next;
 859          end loop;
 860
 861          --  It is an error if a source file name in a source list or
 862          --  in a source list file is not found.
 863
 864          NL := Source_Names.Get_First;
 865
 866          while NL /= No_Name_Location loop
 867             if not NL.Found then
 868                Err_Vars.Error_Msg_Name_1 := NL.Name;
 869
 870                if First_Error then
 871                   Error_Msg
 872                     (Project,
 873                      "source file { cannot be found",
 874                      NL.Location);
 875                   First_Error := False;
 876
 877                else
 878                   Error_Msg
 879                     (Project,
 880                      "\source file { cannot be found",
 881                      NL.Location);
 882                end if;
 883             end if;
 884
 885             NL := Source_Names.Get_Next;
 886          end loop;
 887       end Get_Path_Names_And_Record_Sources;
 888
 889       ---------------------------
 890       -- Get_Sources_From_File --
 891       ---------------------------
 892
 893       procedure Get_Sources_From_File
 894         (Path     : String;
 895          Location : Source_Ptr)
 896       is
 897          File           : Prj.Util.Text_File;
 898          Line           : String (1 .. 250);
 899          Last           : Natural;
 900          Source_Name    : Name_Id;
 901
 902       begin
 903          if Current_Verbosity = High then
 904             Write_Str  ("Opening """);
 905             Write_Str  (Path);
 906             Write_Line (""".");
 907          end if;
 908
 909          --  We open the file
 910
 911          Prj.Util.Open (File, Path);
 912
 913          if not Prj.Util.Is_Valid (File) then
 914             Error_Msg (Project, "file does not exist", Location);
 915          else
 916             Source_Names.Reset;
 917
 918             while not Prj.Util.End_Of_File (File) loop
 919                Prj.Util.Get_Line (File, Line, Last);
 920
 921                --  If the line is not empty and does not start with "--",
 922                --  then it should contain a file name. However, if the
 923                --  file name does not exist, it may be for another language
 924                --  and we don't fail.
 925
 926                if Last /= 0
 927                  and then (Last = 1 or else Line (1 .. 2) /= "--")
 928                then
 929                   Name_Len := Last;
 930                   Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
 931                   Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
 932                   Source_Name := Name_Find;
 933                   Source_Names.Set
 934                     (K => Source_Name,
 935                      E =>
 936                        (Name     => Source_Name,
 937                         Location => Location,
 938                         Found    => False));
 939                end if;
 940             end loop;
 941
 942             Prj.Util.Close (File);
 943
 944          end if;
 945
 946          Get_Path_Names_And_Record_Sources;
 947
 948          --  We should have found at least one source.
 949          --  If not, report an error.
 950
 951          if Data.Sources = Nil_String then
 952             Error_Msg (Project,
 953                        "there are no Ada sources in this project",
 954                        Location);
 955          end if;
 956       end Get_Sources_From_File;
 957
 958       -------------------------
 959       -- Warn_If_Not_Sources --
 960       -------------------------
 961
 962       procedure Warn_If_Not_Sources
 963         (Conventions : Array_Element_Id;
 964          Specs       : Boolean)
 965       is
 966          Conv          : Array_Element_Id := Conventions;
 967          Unit          : Name_Id;
 968          The_Unit_Id   : Unit_Id;
 969          The_Unit_Data : Unit_Data;
 970          Location      : Source_Ptr;
 971
 972       begin
 973          while Conv /= No_Array_Element loop
 974             Unit := Array_Elements.Table (Conv).Index;
 975             Error_Msg_Name_1 := Unit;
 976             Get_Name_String (Unit);
 977             To_Lower (Name_Buffer (1 .. Name_Len));
 978             Unit := Name_Find;
 979             The_Unit_Id := Units_Htable.Get (Unit);
 980             Location := Array_Elements.Table (Conv).Value.Location;
 981
 982             if The_Unit_Id = Prj.Com.No_Unit then
 983                Error_Msg
 984                  (Project,
 985                   "?unknown unit {",
 986                   Location);
 987
 988             else
 989                The_Unit_Data := Units.Table (The_Unit_Id);
 990
 991                if Specs then
 992                   if not Check_Project
 993                     (The_Unit_Data.File_Names (Specification).Project)
 994                   then
 995                      Error_Msg
 996                        (Project,
 997                         "?unit{ has no spec in this project",
 998                         Location);
 999                   end if;
1000
1001                else
1002                   if not Check_Project
1003                     (The_Unit_Data.File_Names (Com.Body_Part).Project)
1004                   then
1005                      Error_Msg
1006                        (Project,
1007                         "?unit{ has no body in this project",
1008                         Location);
1009                   end if;
1010                end if;
1011             end if;
1012
1013             Conv := Array_Elements.Table (Conv).Next;
1014          end loop;
1015       end Warn_If_Not_Sources;
1016
1017    --  Start of processing for Ada_Check
1018
1019    begin
1020       Language_Independent_Check (Project, Report_Error);
1021
1022       Error_Report    := Report_Error;
1023
1024       Data      := Projects.Table (Project);
1025       Extending := Data.Extends /= No_Project;
1026       Languages := Prj.Util.Value_Of (Name_Languages, Data.Decl.Attributes);
1027
1028       Data.Naming.Current_Language := Name_Ada;
1029       Data.Sources_Present         := Data.Source_Dirs /= Nil_String;
1030
1031       if not Languages.Default then
1032          declare
1033             Current   : String_List_Id := Languages.Values;
1034             Element   : String_Element;
1035             Ada_Found : Boolean := False;
1036
1037          begin
1038             Look_For_Ada : while Current /= Nil_String loop
1039                Element := String_Elements.Table (Current);
1040                Get_Name_String (Element.Value);
1041                To_Lower (Name_Buffer (1 .. Name_Len));
1042
1043                if Name_Buffer (1 .. Name_Len) = "ada" then
1044                   Ada_Found := True;
1045                   exit Look_For_Ada;
1046                end if;
1047
1048                Current := Element.Next;
1049             end loop Look_For_Ada;
1050
1051             if not Ada_Found then
1052
1053                --  Mark the project file as having no sources for Ada
1054
1055                Data.Sources_Present := False;
1056             end if;
1057          end;
1058       end if;
1059
1060       Check_Naming_Scheme (Data, Project);
1061
1062       Prepare_Naming_Exceptions (Data.Naming.Bodies, Body_Part);
1063       Prepare_Naming_Exceptions (Data.Naming.Specs,  Specification);
1064
1065       --  If we have source directories, then find the sources
1066
1067       if Data.Sources_Present then
1068          if Data.Source_Dirs = Nil_String then
1069             Data.Sources_Present := False;
1070
1071          else
1072             declare
1073                Sources : constant Variable_Value :=
1074                            Util.Value_Of
1075                              (Name_Source_Files,
1076                               Data.Decl.Attributes);
1077
1078                Source_List_File : constant Variable_Value :=
1079                                     Util.Value_Of
1080                                       (Name_Source_List_File,
1081                                        Data.Decl.Attributes);
1082
1083                Locally_Removed : constant Variable_Value :=
1084                            Util.Value_Of
1085                              (Name_Locally_Removed_Files,
1086                               Data.Decl.Attributes);
1087
1088
1089             begin
1090                pragma Assert
1091                  (Sources.Kind = List,
1092                     "Source_Files is not a list");
1093
1094                pragma Assert
1095                  (Source_List_File.Kind = Single,
1096                     "Source_List_File is not a single string");
1097
1098                if not Sources.Default then
1099                   if not Source_List_File.Default then
1100                      Error_Msg
1101                        (Project,
1102                         "?both variables source_files and " &
1103                         "source_list_file are present",
1104                         Source_List_File.Location);
1105                   end if;
1106
1107                   --  Sources is a list of file names
1108
1109                   declare
1110                      Current        : String_List_Id := Sources.Values;
1111                      Element        : String_Element;
1112                      Location       : Source_Ptr;
1113                      Name           : Name_Id;
1114
1115                   begin
1116                      Source_Names.Reset;
1117
1118                      Data.Sources_Present := Current /= Nil_String;
1119
1120                      while Current /= Nil_String loop
1121                         Element := String_Elements.Table (Current);
1122                         Get_Name_String (Element.Value);
1123                         Canonical_Case_File_Name
1124                           (Name_Buffer (1 .. Name_Len));
1125                         Name := Name_Find;
1126
1127                         --  If the element has no location, then use the
1128                         --  location of Sources to report possible errors.
1129
1130                         if Element.Location = No_Location then
1131                            Location := Sources.Location;
1132
1133                         else
1134                            Location := Element.Location;
1135                         end if;
1136
1137                         Source_Names.Set
1138                           (K => Name,
1139                            E =>
1140                              (Name     => Name,
1141                               Location => Location,
1142                               Found    => False));
1143
1144                         Current := Element.Next;
1145                      end loop;
1146
1147                      Get_Path_Names_And_Record_Sources;
1148                   end;
1149
1150                   --  No source_files specified.
1151                   --  We check Source_List_File has been specified.
1152
1153                elsif not Source_List_File.Default then
1154
1155                   --  Source_List_File is the name of the file
1156                   --  that contains the source file names
1157
1158                   declare
1159                      Source_File_Path_Name : constant String :=
1160                        Path_Name_Of
1161                        (Source_List_File.Value,
1162                         Data.Directory);
1163
1164                   begin
1165                      if Source_File_Path_Name'Length = 0 then
1166                         Err_Vars.Error_Msg_Name_1 := Source_List_File.Value;
1167                         Error_Msg
1168                           (Project,
1169                            "file with sources { does not exist",
1170                            Source_List_File.Location);
1171
1172                      else
1173                         Get_Sources_From_File
1174                           (Source_File_Path_Name,
1175                            Source_List_File.Location);
1176                      end if;
1177                   end;
1178
1179                else
1180                   --  Neither Source_Files nor Source_List_File has been
1181                   --  specified.
1182                   --  Find all the files that satisfy
1183                   --  the naming scheme in all the source directories.
1184
1185                   Find_Sources;
1186                end if;
1187
1188                --  If there are sources that are locally removed, mark them as
1189                --  such in the Units table.
1190
1191                if not Locally_Removed.Default then
1192                   --  Sources can be locally removed only in extending
1193                   --  project files.
1194
1195                   if Data.Extends = No_Project then
1196                      Error_Msg
1197                        (Project,
1198                         "Locally_Removed_Files can only be used " &
1199                         "in an extending project file",
1200                         Locally_Removed.Location);
1201
1202                   else
1203                      declare
1204                         Current        : String_List_Id :=
1205                                            Locally_Removed.Values;
1206                         Element        : String_Element;
1207                         Location       : Source_Ptr;
1208                         OK             : Boolean;
1209                         Unit           : Unit_Data;
1210                         Name           : Name_Id;
1211                         Extended       : Project_Id;
1212
1213                      begin
1214                         while Current /= Nil_String loop
1215                            Element := String_Elements.Table (Current);
1216                            Get_Name_String (Element.Value);
1217                            Canonical_Case_File_Name
1218                              (Name_Buffer (1 .. Name_Len));
1219                            Name := Name_Find;
1220
1221                            --  If the element has no location, then use the
1222                            --  location of Locally_Removed to report
1223                            --  possible errors.
1224
1225                            if Element.Location = No_Location then
1226                               Location := Locally_Removed.Location;
1227
1228                            else
1229                               Location := Element.Location;
1230                            end if;
1231
1232                            OK := False;
1233
1234                            for Index in 1 .. Units.Last loop
1235                               Unit := Units.Table (Index);
1236
1237                               if
1238                                 Unit.File_Names (Specification).Name = Name
1239                               then
1240                                  OK := True;
1241
1242                                  --  Check that this is from a project that
1243                                  --  the current project extends, but not the
1244                                  --  current project.
1245
1246                                  Extended := Unit.File_Names
1247                                                     (Specification).Project;
1248
1249                                  if Extended = Project then
1250                                     Error_Msg
1251                                       (Project,
1252                                        "cannot remove a source " &
1253                                        "of the same project",
1254                                        Location);
1255
1256                                  elsif
1257                                    Project_Extends (Project, Extended)
1258                                  then
1259                                     Unit.File_Names
1260                                       (Specification).Path := Slash;
1261                                     Unit.File_Names
1262                                       (Specification).Needs_Pragma := False;
1263                                     Units.Table (Index) := Unit;
1264                                     Add_Forbidden_File_Name
1265                                       (Unit.File_Names (Specification).Name);
1266                                     exit;
1267
1268                                  else
1269                                     Error_Msg
1270                                       (Project,
1271                                        "cannot remove a source from " &
1272                                        "another project",
1273                                        Location);
1274                                  end if;
1275
1276                               elsif
1277                                 Unit.File_Names (Body_Part).Name = Name
1278                               then
1279                                  OK := True;
1280
1281                                  --  Check that this is from a project that
1282                                  --  the current project extends, but not the
1283                                  --  current project.
1284
1285                                  Extended := Unit.File_Names
1286                                                     (Body_Part).Project;
1287
1288                                  if Extended = Project then
1289                                     Error_Msg
1290                                       (Project,
1291                                        "cannot remove a source " &
1292                                        "of the same project",
1293                                        Location);
1294
1295                                  elsif
1296                                    Project_Extends (Project, Extended)
1297                                  then
1298                                     Unit.File_Names (Body_Part).Path := Slash;
1299                                     Unit.File_Names (Body_Part).Needs_Pragma
1300                                       := False;
1301                                     Units.Table (Index) := Unit;
1302                                     Add_Forbidden_File_Name
1303                                       (Unit.File_Names (Body_Part).Name);
1304                                     exit;
1305                                  end if;
1306
1307                               end if;
1308                            end loop;
1309
1310                            if not OK then
1311                               Err_Vars.Error_Msg_Name_1 := Name;
1312                               Error_Msg (Project, "unknown file {", Location);
1313                            end if;
1314
1315                            Current := Element.Next;
1316                         end loop;
1317                      end;
1318                   end if;
1319                end if;
1320             end;
1321          end if;
1322       end if;
1323
1324       if Data.Sources_Present then
1325
1326          --  Check that all individual naming conventions apply to
1327          --  sources of this project file.
1328
1329          Warn_If_Not_Sources (Data.Naming.Bodies, Specs => False);
1330          Warn_If_Not_Sources (Data.Naming.Specs,  Specs => True);
1331       end if;
1332
1333       --  If it is a library project file, check if it is a standalone library
1334
1335       if Data.Library then
1336          Standalone_Library : declare
1337             Lib_Interfaces : constant Prj.Variable_Value :=
1338                                Prj.Util.Value_Of
1339                                  (Snames.Name_Library_Interface,
1340                                   Data.Decl.Attributes);
1341             Lib_Auto_Init  : constant Prj.Variable_Value :=
1342                                Prj.Util.Value_Of
1343                                  (Snames.Name_Library_Auto_Init,
1344                                   Data.Decl.Attributes);
1345
1346             Lib_Src_Dir : constant Prj.Variable_Value :=
1347                             Prj.Util.Value_Of
1348                               (Snames.Name_Library_Src_Dir,
1349                                Data.Decl.Attributes);
1350
1351             Lib_Symbol_File : constant Prj.Variable_Value :=
1352                                 Prj.Util.Value_Of
1353                                   (Snames.Name_Library_Symbol_File,
1354                                    Data.Decl.Attributes);
1355
1356             Lib_Symbol_Policy : constant Prj.Variable_Value :=
1357                                   Prj.Util.Value_Of
1358                                     (Snames.Name_Library_Symbol_Policy,
1359                                      Data.Decl.Attributes);
1360
1361             Lib_Ref_Symbol_File : constant Prj.Variable_Value :=
1362                                   Prj.Util.Value_Of
1363                                     (Snames.Name_Library_Reference_Symbol_File,
1364                                      Data.Decl.Attributes);
1365
1366             Auto_Init_Supported : constant Boolean :=
1367                                     MLib.Tgt.
1368                                      Standalone_Library_Auto_Init_Is_Supported;
1369
1370             OK : Boolean := True;
1371
1372          begin
1373             pragma Assert (Lib_Interfaces.Kind = List);
1374
1375             --  It is a stand-alone library project file if attribute
1376             --  Library_Interface is defined.
1377
1378             if not Lib_Interfaces.Default then
1379                declare
1380                   Interfaces : String_List_Id := Lib_Interfaces.Values;
1381                   Interface_ALIs : String_List_Id := Nil_String;
1382                   Unit : Name_Id;
1383                   The_Unit_Id : Unit_Id;
1384                   The_Unit_Data : Unit_Data;
1385
1386                   procedure Add_ALI_For (Source : Name_Id);
1387                   --  Add an ALI file name to the list of Interface ALIs
1388
1389                   -----------------
1390                   -- Add_ALI_For --
1391                   -----------------
1392
1393                   procedure Add_ALI_For (Source : Name_Id) is
1394                   begin
1395                      Get_Name_String (Source);
1396
1397                      declare
1398                         ALI : constant String :=
1399                                 ALI_File_Name (Name_Buffer (1 .. Name_Len));
1400                         ALI_Name_Id : Name_Id;
1401                      begin
1402                         Name_Len := ALI'Length;
1403                         Name_Buffer (1 .. Name_Len) := ALI;
1404                         ALI_Name_Id := Name_Find;
1405
1406                         String_Elements.Increment_Last;
1407                         String_Elements.Table (String_Elements.Last) :=
1408                           (Value    => ALI_Name_Id,
1409                            Display_Value => ALI_Name_Id,
1410                            Location => String_Elements.Table
1411                                                          (Interfaces).Location,
1412                            Flag     => False,
1413                            Next     => Interface_ALIs);
1414                         Interface_ALIs := String_Elements.Last;
1415                      end;
1416                   end Add_ALI_For;
1417
1418                begin
1419                   Data.Standalone_Library := True;
1420
1421                   --  Library_Interface cannot be an empty list
1422
1423                   if Interfaces = Nil_String then
1424                      Error_Msg
1425                        (Project,
1426                         "Library_Interface cannot be an empty list",
1427                         Lib_Interfaces.Location);
1428                   end if;
1429
1430                   --  Process each unit name specified in the attribute
1431                   --  Library_Interface.
1432
1433                   while Interfaces /= Nil_String loop
1434                      Get_Name_String
1435                        (String_Elements.Table (Interfaces).Value);
1436                      To_Lower (Name_Buffer (1 .. Name_Len));
1437
1438                      if Name_Len = 0 then
1439                         Error_Msg
1440                           (Project,
1441                            "an interface cannot be an empty string",
1442                            String_Elements.Table (Interfaces).Location);
1443
1444                      else
1445                         Unit := Name_Find;
1446                         Error_Msg_Name_1 := Unit;
1447                         The_Unit_Id := Units_Htable.Get (Unit);
1448
1449                         if The_Unit_Id = Prj.Com.No_Unit then
1450                            Error_Msg
1451                              (Project,
1452                               "unknown unit {",
1453                               String_Elements.Table (Interfaces).Location);
1454
1455                         else
1456                            --  Check that the unit is part of the project
1457
1458                            The_Unit_Data := Units.Table (The_Unit_Id);
1459
1460                            if The_Unit_Data.File_Names
1461                                 (Com.Body_Part).Name /= No_Name
1462                              and then The_Unit_Data.File_Names
1463                                         (Com.Body_Part).Path /= Slash
1464                            then
1465                               if Check_Project
1466                                  (The_Unit_Data.File_Names (Body_Part).Project)
1467                               then
1468                                  --  There is a body for this unit.
1469                                  --  If there is no spec, we need to check
1470                                  --  that it is not a subunit.
1471
1472                                  if The_Unit_Data.File_Names
1473                                       (Specification).Name = No_Name
1474                                  then
1475                                     declare
1476                                        Src_Ind : Source_File_Index;
1477
1478                                     begin
1479                                        Src_Ind := Sinput.P.Load_Project_File
1480                                                    (Get_Name_String
1481                                                       (The_Unit_Data.File_Names
1482                                                          (Body_Part).Path));
1483
1484                                        if Sinput.P.Source_File_Is_Subunit
1485                                                      (Src_Ind)
1486                                        then
1487                                           Error_Msg
1488                                             (Project,
1489                                              "{ is a subunit; " &
1490                                              "it cannot be an interface",
1491                                              String_Elements.Table
1492                                                (Interfaces).Location);
1493                                        end if;
1494                                     end;
1495                                  end if;
1496
1497                                  --  The unit is not a subunit, so we add
1498                                  --  to the Interface ALIs the ALI file
1499                                  --  corresponding to the body.
1500
1501                                  Add_ALI_For
1502                                    (The_Unit_Data.File_Names (Body_Part).Name);
1503
1504                               else
1505                                  Error_Msg
1506                                    (Project,
1507                                     "{ is not an unit of this project",
1508                                     String_Elements.Table
1509                                       (Interfaces).Location);
1510                               end if;
1511
1512                            elsif The_Unit_Data.File_Names
1513                                    (Com.Specification).Name /= No_Name
1514                               and then The_Unit_Data.File_Names
1515                                          (Com.Specification).Path /= Slash
1516                               and then Check_Project
1517                                          (The_Unit_Data.File_Names
1518                                             (Specification).Project)
1519
1520                            then
1521                               --  The unit is part of the project, it has
1522                               --  a spec, but no body. We add to the Interface
1523                               --  ALIs the ALI file corresponding to the spec.
1524
1525                               Add_ALI_For
1526                                (The_Unit_Data.File_Names (Specification).Name);
1527
1528                            else
1529                               Error_Msg
1530                                 (Project,
1531                                  "{ is not an unit of this project",
1532                                  String_Elements.Table (Interfaces).Location);
1533                            end if;
1534                         end if;
1535
1536                      end if;
1537
1538                      Interfaces := String_Elements.Table (Interfaces).Next;
1539                   end loop;
1540
1541                   --  Put the list of Interface ALIs in the project data
1542
1543                   Data.Lib_Interface_ALIs := Interface_ALIs;
1544
1545                   --  Check value of attribute Library_Auto_Init and set
1546                   --  Lib_Auto_Init accordingly.
1547
1548                   if Lib_Auto_Init.Default then
1549                      --  If no attribute Library_Auto_Init is declared, then
1550                      --  set auto init only if it is supported.
1551
1552                      Data.Lib_Auto_Init := Auto_Init_Supported;
1553
1554                   else
1555                      Get_Name_String (Lib_Auto_Init.Value);
1556                      To_Lower (Name_Buffer (1 .. Name_Len));
1557
1558                      if Name_Buffer (1 .. Name_Len) = "false" then
1559                         Data.Lib_Auto_Init := False;
1560
1561                      elsif Name_Buffer (1 .. Name_Len) = "true" then
1562                         if Auto_Init_Supported then
1563                            Data.Lib_Auto_Init := True;
1564
1565                         else
1566                            --  Library_Auto_Init cannot be "true" if auto init
1567                            --  is not supported
1568
1569                            Error_Msg
1570                              (Project,
1571                               "library auto init not supported " &
1572                               "on this platform",
1573                               Lib_Auto_Init.Location);
1574                         end if;
1575
1576                      else
1577                         Error_Msg
1578                           (Project,
1579                            "invalid value for attribute Library_Auto_Init",
1580                            Lib_Auto_Init.Location);
1581                      end if;
1582                   end if;
1583                end;
1584
1585                --  If attribute Library_Src_Dir is defined and not the
1586                --  empty string, check if the directory exist and is not
1587                --  the object directory or one of the source directories.
1588                --  This is the directory where copies of the interface
1589                --  sources will be copied. Note that this directory may be
1590                --  the library directory.
1591
1592                if Lib_Src_Dir.Value /= Empty_String then
1593                   declare
1594                      Dir_Id : constant Name_Id := Lib_Src_Dir.Value;
1595
1596                   begin
1597                      Locate_Directory
1598                        (Dir_Id, Data.Display_Directory,
1599                         Data.Library_Src_Dir,
1600                         Data.Display_Library_Src_Dir);
1601
1602                      --  If directory does not exist, report an error
1603
1604                      if Data.Library_Src_Dir = No_Name then
1605
1606                         --  Get the absolute name of the library directory
1607                         --  that does not exist, to report an error.
1608
1609                         declare
1610                            Dir_Name : constant String :=
1611                                         Get_Name_String (Dir_Id);
1612
1613                         begin
1614                            if Is_Absolute_Path (Dir_Name) then
1615                               Err_Vars.Error_Msg_Name_1 := Dir_Id;
1616
1617                            else
1618                               Get_Name_String (Data.Directory);
1619
1620                               if Name_Buffer (Name_Len) /=
1621                                 Directory_Separator
1622                               then
1623                                  Name_Len := Name_Len + 1;
1624                                  Name_Buffer (Name_Len) :=
1625                                    Directory_Separator;
1626                               end if;
1627
1628                               Name_Buffer
1629                                 (Name_Len + 1 ..
1630                                    Name_Len + Dir_Name'Length) :=
1631                                   Dir_Name;
1632                               Name_Len := Name_Len + Dir_Name'Length;
1633                               Err_Vars.Error_Msg_Name_1 := Name_Find;
1634                            end if;
1635
1636                            --  Report the error
1637
1638                            Error_Msg
1639                              (Project,
1640                               "Directory { does not exist",
1641                               Lib_Src_Dir.Location);
1642                         end;
1643
1644                      --  Report an error if it is the same as the object
1645                      --  directory.
1646
1647                      elsif Data.Library_Src_Dir = Data.Object_Directory then
1648                         Error_Msg
1649                           (Project,
1650                            "directory to copy interfaces cannot be " &
1651                            "the object directory",
1652                            Lib_Src_Dir.Location);
1653                         Data.Library_Src_Dir := No_Name;
1654
1655                      --  Check if it is the same as one of the source
1656                      --  directories.
1657
1658                      else
1659                         declare
1660                            Src_Dirs : String_List_Id := Data.Source_Dirs;
1661                            Src_Dir  : String_Element;
1662
1663                         begin
1664                            while Src_Dirs /= Nil_String loop
1665                               Src_Dir := String_Elements.Table (Src_Dirs);
1666                               Src_Dirs := Src_Dir.Next;
1667
1668                               --  Report an error if it is one of the
1669                               --  source directories.
1670
1671                               if Data.Library_Src_Dir = Src_Dir.Value then
1672                                  Error_Msg
1673                                    (Project,
1674                                     "directory to copy interfaces cannot " &
1675                                     "be one of the source directories",
1676                                     Lib_Src_Dir.Location);
1677                                  Data.Library_Src_Dir := No_Name;
1678                                  exit;
1679                               end if;
1680                            end loop;
1681                         end;
1682
1683                         if Data.Library_Src_Dir /= No_Name
1684                           and then Current_Verbosity = High
1685                         then
1686                            Write_Str ("Directory to copy interfaces =""");
1687                            Write_Str (Get_Name_String (Data.Library_Dir));
1688                            Write_Line ("""");
1689                         end if;
1690                      end if;
1691                   end;
1692                end if;
1693
1694                if not Lib_Symbol_File.Default then
1695                   Data.Symbol_Data.Symbol_File := Lib_Symbol_File.Value;
1696
1697                   Get_Name_String (Lib_Symbol_File.Value);
1698
1699                   if Name_Len = 0 then
1700                      Error_Msg
1701                        (Project,
1702                         "symbol file name cannot be an empty string",
1703                         Lib_Symbol_File.Location);
1704
1705                   else
1706                      OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len));
1707
1708                      if OK then
1709                         for J in 1 .. Name_Len loop
1710                            if Name_Buffer (J) = '/'
1711                              or else Name_Buffer (J) = Directory_Separator
1712                            then
1713                               OK := False;
1714                               exit;
1715                            end if;
1716                         end loop;
1717                      end if;
1718
1719                      if not OK then
1720                         Error_Msg_Name_1 := Lib_Symbol_File.Value;
1721                         Error_Msg
1722                           (Project,
1723                            "symbol file name { is illegal. " &
1724                            "Name canot include directory info.",
1725                            Lib_Symbol_File.Location);
1726                      end if;
1727                   end if;
1728                end if;
1729
1730                if not Lib_Symbol_Policy.Default then
1731                   declare
1732                      Value : constant String :=
1733                                To_Lower
1734                                  (Get_Name_String (Lib_Symbol_Policy.Value));
1735
1736                   begin
1737                      if Value = "autonomous" or else Value = "default" then
1738                         Data.Symbol_Data.Symbol_Policy := Autonomous;
1739
1740                      elsif Value = "compliant" then
1741                         Data.Symbol_Data.Symbol_Policy := Compliant;
1742
1743                      elsif Value = "controlled" then
1744                         Data.Symbol_Data.Symbol_Policy := Controlled;
1745
1746                      else
1747                         Error_Msg
1748                           (Project,
1749                            "illegal value for Library_Symbol_Policy",
1750                            Lib_Symbol_Policy.Location);
1751                      end if;
1752                   end;
1753                end if;
1754
1755                if Lib_Ref_Symbol_File.Default then
1756                   if Data.Symbol_Data.Symbol_Policy /= Autonomous then
1757                      Error_Msg
1758                        (Project,
1759                         "a reference symbol file need to be defined",
1760                         Lib_Symbol_Policy.Location);
1761                   end if;
1762
1763                else
1764                   Data.Symbol_Data.Reference := Lib_Ref_Symbol_File.Value;
1765
1766                   Get_Name_String (Lib_Symbol_File.Value);
1767
1768                   if Name_Len = 0 then
1769                      Error_Msg
1770                        (Project,
1771                         "reference symbol file name cannot be an empty string",
1772                         Lib_Symbol_File.Location);
1773
1774                   else
1775                      OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len));
1776
1777                      if OK then
1778                         for J in 1 .. Name_Len loop
1779                            if Name_Buffer (J) = '/'
1780                              or else Name_Buffer (J) = Directory_Separator
1781                            then
1782                               OK := False;
1783                               exit;
1784                            end if;
1785                         end loop;
1786                      end if;
1787
1788                      if not OK then
1789                         Error_Msg_Name_1 := Lib_Ref_Symbol_File.Value;
1790                         Error_Msg
1791                           (Project,
1792                            "reference symbol file { name is illegal. " &
1793                            "Name canot include directory info.",
1794                            Lib_Ref_Symbol_File.Location);
1795                      end if;
1796
1797                      if not Is_Regular_File
1798                        (Get_Name_String (Data.Object_Directory) &
1799                         Directory_Separator &
1800                         Get_Name_String (Lib_Ref_Symbol_File.Value))
1801                      then
1802                         Error_Msg_Name_1 := Lib_Ref_Symbol_File.Value;
1803                         Error_Msg
1804                           (Project,
1805                            "library reference symbol file { does not exist",
1806                            Lib_Ref_Symbol_File.Location);
1807                      end if;
1808
1809                      if Data.Symbol_Data.Symbol_File /= No_Name then
1810                         declare
1811                            Symbol : String :=
1812                                       Get_Name_String
1813                                         (Data.Symbol_Data.Symbol_File);
1814
1815                            Reference : String :=
1816                                          Get_Name_String
1817                                            (Data.Symbol_Data.Reference);
1818
1819                         begin
1820                            Canonical_Case_File_Name (Symbol);
1821                            Canonical_Case_File_Name (Reference);
1822
1823                            if Symbol = Reference then
1824                               Error_Msg
1825                                 (Project,
1826                                  "reference symbol file and symbol file " &
1827                                  "cannot be the same file",
1828                                  Lib_Ref_Symbol_File.Location);
1829                            end if;
1830                         end;
1831                      end if;
1832                   end if;
1833                end if;
1834             end if;
1835          end Standalone_Library;
1836       end if;
1837
1838       --  Put the list of Mains, if any, in the project data
1839
1840       declare
1841          Mains : constant Variable_Value :=
1842                    Prj.Util.Value_Of (Name_Main, Data.Decl.Attributes);
1843
1844       begin
1845          Data.Mains := Mains.Values;
1846
1847          --  If no Mains were specified, and if we are an extending
1848          --  project, inherit the Mains from the project we are extending.
1849
1850          if Mains.Default then
1851             if Data.Extends /= No_Project then
1852                Data.Mains := Projects.Table (Data.Extends).Mains;
1853             end if;
1854
1855          --  In a library project file, Main cannot be specified
1856
1857          elsif Data.Library then
1858             Error_Msg
1859               (Project,
1860                "a library project file cannot have Main specified",
1861                Mains.Location);
1862          end if;
1863       end;
1864
1865       Projects.Table (Project) := Data;
1866
1867       Free_Naming_Exceptions;
1868    end Ada_Check;
1869
1870    -------------------
1871    -- ALI_File_Name --
1872    -------------------
1873
1874    function ALI_File_Name (Source : String) return String is
1875    begin
1876       --  If the source name has an extension, then replace it with
1877       --  the ALI suffix.
1878
1879       for Index in reverse Source'First + 1 .. Source'Last loop
1880          if Source (Index) = '.' then
1881             return Source (Source'First .. Index - 1) & ALI_Suffix;
1882          end if;
1883       end loop;
1884
1885       --  If there is no dot, or if it is the first character, just add the
1886       --  ALI suffix.
1887
1888       return Source & ALI_Suffix;
1889    end ALI_File_Name;
1890
1891    --------------------
1892    -- Check_Ada_Name --
1893    --------------------
1894
1895    procedure Check_Ada_Name
1896      (Name : String;
1897       Unit : out Name_Id)
1898    is
1899       The_Name        : String := Name;
1900       Real_Name       : Name_Id;
1901       Need_Letter     : Boolean := True;
1902       Last_Underscore : Boolean := False;
1903       OK              : Boolean := The_Name'Length > 0;
1904
1905    begin
1906       To_Lower (The_Name);
1907
1908       Name_Len := The_Name'Length;
1909       Name_Buffer (1 .. Name_Len) := The_Name;
1910       Real_Name := Name_Find;
1911
1912       --  Check first that the given name is not an Ada reserved word
1913
1914       if Get_Name_Table_Byte (Real_Name) /= 0
1915         and then Real_Name /= Name_Project
1916         and then Real_Name /= Name_Extends
1917         and then Real_Name /= Name_External
1918       then
1919          Unit := No_Name;
1920
1921          if Current_Verbosity = High then
1922             Write_Str (The_Name);
1923             Write_Line (" is an Ada reserved word.");
1924          end if;
1925
1926          return;
1927       end if;
1928
1929       for Index in The_Name'Range loop
1930          if Need_Letter then
1931
1932             --  We need a letter (at the beginning, and following a dot),
1933             --  but we don't have one.
1934
1935             if Is_Letter (The_Name (Index)) then
1936                Need_Letter := False;
1937
1938             else
1939                OK := False;
1940
1941                if Current_Verbosity = High then
1942                   Write_Int  (Types.Int (Index));
1943                   Write_Str  (": '");
1944                   Write_Char (The_Name (Index));
1945                   Write_Line ("' is not a letter.");
1946                end if;
1947
1948                exit;
1949             end if;
1950
1951          elsif Last_Underscore
1952            and then (The_Name (Index) = '_' or else The_Name (Index) = '.')
1953          then
1954             --  Two underscores are illegal, and a dot cannot follow
1955             --  an underscore.
1956
1957             OK := False;
1958
1959             if Current_Verbosity = High then
1960                Write_Int  (Types.Int (Index));
1961                Write_Str  (": '");
1962                Write_Char (The_Name (Index));
1963                Write_Line ("' is illegal here.");
1964             end if;
1965
1966             exit;
1967
1968          elsif The_Name (Index) = '.' then
1969
1970             --  We need a letter after a dot
1971
1972             Need_Letter := True;
1973
1974          elsif The_Name (Index) = '_' then
1975             Last_Underscore := True;
1976
1977          else
1978             --  We need an letter or a digit
1979
1980             Last_Underscore := False;
1981
1982             if not Is_Alphanumeric (The_Name (Index)) then
1983                OK := False;
1984
1985                if Current_Verbosity = High then
1986                   Write_Int  (Types.Int (Index));
1987                   Write_Str  (": '");
1988                   Write_Char (The_Name (Index));
1989                   Write_Line ("' is not alphanumeric.");
1990                end if;
1991
1992                exit;
1993             end if;
1994          end if;
1995       end loop;
1996
1997       --  Cannot end with an underscore or a dot
1998
1999       OK := OK and then not Need_Letter and then not Last_Underscore;
2000
2001       if OK then
2002          Unit := Real_Name;
2003
2004       else
2005          --  Signal a problem with No_Name
2006
2007          Unit := No_Name;
2008       end if;
2009    end Check_Ada_Name;
2010
2011    -----------------------------
2012    -- Check_Ada_Naming_Scheme --
2013    -----------------------------
2014
2015    procedure Check_Ada_Naming_Scheme
2016      (Project : Project_Id;
2017       Naming  : Naming_Data)
2018    is
2019    begin
2020       --  Only check if we are not using the standard naming scheme
2021
2022       if Naming /= Standard_Naming_Data then
2023          declare
2024             Dot_Replacement       : constant String :=
2025                                      Get_Name_String
2026                                        (Naming.Dot_Replacement);
2027
2028             Spec_Suffix : constant String :=
2029                                      Get_Name_String
2030                                        (Naming.Current_Spec_Suffix);
2031
2032             Body_Suffix : constant String :=
2033                                      Get_Name_String
2034                                        (Naming.Current_Body_Suffix);
2035
2036             Separate_Suffix       : constant String :=
2037                                      Get_Name_String
2038                                        (Naming.Separate_Suffix);
2039
2040          begin
2041             --  Dot_Replacement cannot
2042             --   - be empty
2043             --   - start or end with an alphanumeric
2044             --   - be a single '_'
2045             --   - start with an '_' followed by an alphanumeric
2046             --   - contain a '.' except if it is "."
2047
2048             if Dot_Replacement'Length = 0
2049               or else Is_Alphanumeric
2050                         (Dot_Replacement (Dot_Replacement'First))
2051               or else Is_Alphanumeric
2052                         (Dot_Replacement (Dot_Replacement'Last))
2053               or else (Dot_Replacement (Dot_Replacement'First) = '_'
2054                         and then
2055                         (Dot_Replacement'Length = 1
2056                           or else
2057                            Is_Alphanumeric
2058                              (Dot_Replacement (Dot_Replacement'First + 1))))
2059               or else (Dot_Replacement'Length > 1
2060                          and then
2061                            Index (Source => Dot_Replacement,
2062                                   Pattern => ".") /= 0)
2063             then
2064                Error_Msg
2065                  (Project,
2066                   '"' & Dot_Replacement &
2067                   """ is illegal for Dot_Replacement.",
2068                   Naming.Dot_Repl_Loc);
2069             end if;
2070
2071             --  Suffixes cannot
2072             --   - be empty
2073
2074             if Is_Illegal_Suffix
2075                  (Spec_Suffix, Dot_Replacement = ".")
2076             then
2077                Err_Vars.Error_Msg_Name_1 := Naming.Current_Spec_Suffix;
2078                Error_Msg
2079                  (Project,
2080                   "{ is illegal for Spec_Suffix",
2081                   Naming.Spec_Suffix_Loc);
2082             end if;
2083
2084             if Is_Illegal_Suffix
2085                  (Body_Suffix, Dot_Replacement = ".")
2086             then
2087                Err_Vars.Error_Msg_Name_1 := Naming.Current_Body_Suffix;
2088                Error_Msg
2089                  (Project,
2090                   "{ is illegal for Body_Suffix",
2091                   Naming.Body_Suffix_Loc);
2092             end if;
2093
2094             if Body_Suffix /= Separate_Suffix then
2095                if Is_Illegal_Suffix
2096                     (Separate_Suffix, Dot_Replacement = ".")
2097                then
2098                   Err_Vars.Error_Msg_Name_1 := Naming.Separate_Suffix;
2099                   Error_Msg
2100                     (Project,
2101                      "{ is illegal for Separate_Suffix",
2102                      Naming.Sep_Suffix_Loc);
2103                end if;
2104             end if;
2105
2106             --  Spec_Suffix cannot have the same termination as
2107             --  Body_Suffix or Separate_Suffix
2108
2109             if Spec_Suffix'Length <= Body_Suffix'Length
2110               and then
2111                 Body_Suffix (Body_Suffix'Last -
2112                              Spec_Suffix'Length + 1 ..
2113                              Body_Suffix'Last) = Spec_Suffix
2114             then
2115                Error_Msg
2116                  (Project,
2117                   "Body_Suffix (""" &
2118                   Body_Suffix &
2119                   """) cannot end with" &
2120                   " Spec_Suffix  (""" &
2121                   Spec_Suffix & """).",
2122                   Naming.Body_Suffix_Loc);
2123             end if;
2124
2125             if Body_Suffix /= Separate_Suffix
2126               and then Spec_Suffix'Length <= Separate_Suffix'Length
2127               and then
2128                 Separate_Suffix
2129                   (Separate_Suffix'Last - Spec_Suffix'Length + 1
2130                     ..
2131                    Separate_Suffix'Last) = Spec_Suffix
2132             then
2133                Error_Msg
2134                  (Project,
2135                   "Separate_Suffix (""" &
2136                   Separate_Suffix &
2137                   """) cannot end with" &
2138                   " Spec_Suffix (""" &
2139                   Spec_Suffix & """).",
2140                   Naming.Sep_Suffix_Loc);
2141             end if;
2142          end;
2143       end if;
2144    end Check_Ada_Naming_Scheme;
2145
2146    ---------------
2147    -- Error_Msg --
2148    ---------------
2149
2150    procedure Error_Msg
2151      (Project       : Project_Id;
2152       Msg           : String;
2153       Flag_Location : Source_Ptr)
2154    is
2155       Error_Buffer : String (1 .. 5_000);
2156       Error_Last   : Natural := 0;
2157       Msg_Name     : Natural := 0;
2158       First        : Positive := Msg'First;
2159
2160       procedure Add (C : Character);
2161       --  Add a character to the buffer
2162
2163       procedure Add (S : String);
2164       --  Add a string to the buffer
2165
2166       procedure Add (Id : Name_Id);
2167       --  Add a name to the buffer
2168
2169       ---------
2170       -- Add --
2171       ---------
2172
2173       procedure Add (C : Character) is
2174       begin
2175          Error_Last := Error_Last + 1;
2176          Error_Buffer (Error_Last) := C;
2177       end Add;
2178
2179       procedure Add (S : String) is
2180       begin
2181          Error_Buffer (Error_Last + 1 .. Error_Last + S'Length) := S;
2182          Error_Last := Error_Last + S'Length;
2183       end Add;
2184
2185       procedure Add (Id : Name_Id) is
2186       begin
2187          Get_Name_String (Id);
2188          Add (Name_Buffer (1 .. Name_Len));
2189       end Add;
2190
2191    --  Start of processing for Error_Msg
2192
2193    begin
2194       if Error_Report = null then
2195          Prj.Err.Error_Msg (Msg, Flag_Location);
2196          return;
2197       end if;
2198
2199       if Msg (First) = '\' then
2200
2201          --  Continuation character, ignore.
2202
2203          First := First + 1;
2204
2205       elsif Msg (First) = '?' then
2206
2207          --  Warning character. It is always the first one in this package
2208
2209          First := First + 1;
2210          Add ("Warning: ");
2211       end if;
2212
2213       for Index in First .. Msg'Last loop
2214          if Msg (Index) = '{' or else Msg (Index) = '%' then
2215
2216             --  Include a name between double quotes.
2217
2218             Msg_Name := Msg_Name + 1;
2219             Add ('"');
2220
2221             case Msg_Name is
2222                when 1 => Add (Err_Vars.Error_Msg_Name_1);
2223                when 2 => Add (Err_Vars.Error_Msg_Name_2);
2224                when 3 => Add (Err_Vars.Error_Msg_Name_3);
2225
2226                when others => null;
2227             end case;
2228
2229             Add ('"');
2230
2231          else
2232             Add (Msg (Index));
2233          end if;
2234
2235       end loop;
2236
2237       Error_Report (Error_Buffer (1 .. Error_Last), Project);
2238    end Error_Msg;
2239
2240    --------------
2241    -- Get_Unit --
2242    --------------
2243
2244    procedure Get_Unit
2245      (Canonical_File_Name : Name_Id;
2246       Naming              : Naming_Data;
2247       Unit_Name           : out Name_Id;
2248       Unit_Kind           : out Spec_Or_Body;
2249       Needs_Pragma        : out Boolean)
2250    is
2251       function Check_Exception (Canonical : Name_Id) return Boolean;
2252       pragma Inline (Check_Exception);
2253       --  Check if Canonical is one of the exceptions in List.
2254       --  Returns True if Get_Unit should exit
2255
2256       ---------------------
2257       -- Check_Exception --
2258       ---------------------
2259
2260       function Check_Exception (Canonical : Name_Id) return Boolean is
2261          Info     : Unit_Info := Naming_Exceptions.Get (Canonical);
2262          VMS_Name : Name_Id;
2263
2264       begin
2265          if Info = No_Unit then
2266             if Hostparm.OpenVMS then
2267                VMS_Name := Canonical;
2268                Get_Name_String (VMS_Name);
2269
2270                if Name_Buffer (Name_Len) = '.' then
2271                   Name_Len := Name_Len - 1;
2272                   VMS_Name := Name_Find;
2273                end if;
2274
2275                Info := Naming_Exceptions.Get (VMS_Name);
2276             end if;
2277
2278             if Info = No_Unit then
2279                return False;
2280             end if;
2281          end if;
2282
2283          Unit_Kind := Info.Kind;
2284          Unit_Name := Info.Unit;
2285          Needs_Pragma := True;
2286          return True;
2287       end Check_Exception;
2288
2289    --  Start of processing for Get_Unit
2290
2291    begin
2292       Needs_Pragma := False;
2293
2294       if Check_Exception (Canonical_File_Name) then
2295          return;
2296       end if;
2297
2298       Get_Name_String (Canonical_File_Name);
2299
2300       declare
2301          File          : String := Name_Buffer (1 .. Name_Len);
2302          First         : constant Positive := File'First;
2303          Last          : Natural           := File'Last;
2304          Standard_GNAT : Boolean;
2305
2306       begin
2307          Standard_GNAT :=
2308            Naming.Current_Spec_Suffix = Default_Ada_Spec_Suffix
2309              and then Naming.Current_Body_Suffix = Default_Ada_Body_Suffix;
2310
2311          --  Check if the end of the file name is Specification_Append
2312
2313          Get_Name_String (Naming.Current_Spec_Suffix);
2314
2315          if File'Length > Name_Len
2316            and then File (Last - Name_Len + 1 .. Last) =
2317                                                 Name_Buffer (1 .. Name_Len)
2318          then
2319             --  We have a spec
2320
2321             Unit_Kind := Specification;
2322             Last := Last - Name_Len;
2323
2324             if Current_Verbosity = High then
2325                Write_Str  ("   Specification: ");
2326                Write_Line (File (First .. Last));
2327             end if;
2328
2329          else
2330             Get_Name_String (Naming.Current_Body_Suffix);
2331
2332             --  Check if the end of the file name is Body_Append
2333
2334             if File'Length > Name_Len
2335               and then File (Last - Name_Len + 1 .. Last) =
2336                                                 Name_Buffer (1 .. Name_Len)
2337             then
2338                --  We have a body
2339
2340                Unit_Kind := Body_Part;
2341                Last := Last - Name_Len;
2342
2343                if Current_Verbosity = High then
2344                   Write_Str  ("   Body: ");
2345                   Write_Line (File (First .. Last));
2346                end if;
2347
2348             elsif Naming.Separate_Suffix /= Naming.Current_Spec_Suffix then
2349                Get_Name_String (Naming.Separate_Suffix);
2350
2351                --  Check if the end of the file name is Separate_Append
2352
2353                if File'Length > Name_Len
2354                  and then File (Last - Name_Len + 1 .. Last) =
2355                                                 Name_Buffer (1 .. Name_Len)
2356                then
2357                   --  We have a separate (a body)
2358
2359                   Unit_Kind := Body_Part;
2360                   Last := Last - Name_Len;
2361
2362                   if Current_Verbosity = High then
2363                      Write_Str  ("   Separate: ");
2364                      Write_Line (File (First .. Last));
2365                   end if;
2366
2367                else
2368                   Last := 0;
2369                end if;
2370
2371             else
2372                Last := 0;
2373             end if;
2374          end if;
2375
2376          if Last = 0 then
2377
2378             --  This is not a source file
2379
2380             Unit_Name := No_Name;
2381             Unit_Kind := Specification;
2382
2383             if Current_Verbosity = High then
2384                Write_Line ("   Not a valid file name.");
2385             end if;
2386
2387             return;
2388          end if;
2389
2390          Get_Name_String (Naming.Dot_Replacement);
2391          Standard_GNAT :=
2392            Standard_GNAT and then Name_Buffer (1 .. Name_Len) = "-";
2393
2394          if Name_Buffer (1 .. Name_Len) /= "." then
2395
2396             --  If Dot_Replacement is not a single dot,
2397             --  then there should not be any dot in the name.
2398
2399             for Index in First .. Last loop
2400                if File (Index) = '.' then
2401                   if Current_Verbosity = High then
2402                      Write_Line
2403                        ("   Not a valid file name (some dot not replaced).");
2404                   end if;
2405
2406                   Unit_Name := No_Name;
2407                   return;
2408
2409                end if;
2410             end loop;
2411
2412             --  Replace the substring Dot_Replacement with dots
2413
2414             declare
2415                Index : Positive := First;
2416
2417             begin
2418                while Index <= Last - Name_Len + 1 loop
2419
2420                   if File (Index .. Index + Name_Len - 1) =
2421                     Name_Buffer (1 .. Name_Len)
2422                   then
2423                      File (Index) := '.';
2424
2425                      if Name_Len > 1 and then Index < Last then
2426                         File (Index + 1 .. Last - Name_Len + 1) :=
2427                           File (Index + Name_Len .. Last);
2428                      end if;
2429
2430                      Last := Last - Name_Len + 1;
2431                   end if;
2432
2433                   Index := Index + 1;
2434                end loop;
2435             end;
2436          end if;
2437
2438          --  Check if the casing is right
2439
2440          declare
2441             Src : String := File (First .. Last);
2442
2443          begin
2444             case Naming.Casing is
2445                when All_Lower_Case =>
2446                   Fixed.Translate
2447                     (Source  => Src,
2448                      Mapping => Lower_Case_Map);
2449
2450                when All_Upper_Case =>
2451                   Fixed.Translate
2452                     (Source  => Src,
2453                      Mapping => Upper_Case_Map);
2454
2455                when Mixed_Case | Unknown =>
2456                   null;
2457             end case;
2458
2459             if Src /= File (First .. Last) then
2460                if Current_Verbosity = High then
2461                   Write_Line ("   Not a valid file name (casing).");
2462                end if;
2463
2464                Unit_Name := No_Name;
2465                return;
2466             end if;
2467
2468             --  We put the name in lower case
2469
2470             Fixed.Translate
2471               (Source  => Src,
2472                Mapping => Lower_Case_Map);
2473
2474             --  In the standard GNAT naming scheme, check for special cases:
2475             --  children or separates of A, G, I or S, and run time sources.
2476
2477             if Standard_GNAT and then Src'Length >= 3 then
2478                declare
2479                   S1 : constant Character := Src (Src'First);
2480                   S2 : constant Character := Src (Src'First + 1);
2481
2482                begin
2483                   if S1 = 'a' or else S1 = 'g'
2484                     or else S1 = 'i' or else S1 = 's'
2485                   then
2486                      --  Children or separates of packages A, G, I or S
2487
2488                      if (Hostparm.OpenVMS and then S2 = '$')
2489                        or else (not Hostparm.OpenVMS and then S2 = '~')
2490                      then
2491                         Src (Src'First + 1) := '.';
2492
2493                      --  If it is potentially a run time source, disable
2494                      --  filling of the mapping file to avoid warnings.
2495
2496                      elsif S2 = '.' then
2497                         Set_Mapping_File_Initial_State_To_Empty;
2498                      end if;
2499
2500                   end if;
2501                end;
2502             end if;
2503
2504             if Current_Verbosity = High then
2505                Write_Str  ("      ");
2506                Write_Line (Src);
2507             end if;
2508
2509             --  Now, we check if this name is a valid unit name
2510
2511             Check_Ada_Name (Name => Src, Unit => Unit_Name);
2512          end;
2513
2514       end;
2515    end Get_Unit;
2516
2517    -----------------------
2518    -- Is_Illegal_Suffix --
2519    -----------------------
2520
2521    function Is_Illegal_Suffix
2522      (Suffix                          : String;
2523       Dot_Replacement_Is_A_Single_Dot : Boolean) return Boolean
2524    is
2525    begin
2526       if Suffix'Length = 0 or else Index (Suffix, ".") = 0 then
2527          return True;
2528       end if;
2529
2530       --  If dot replacement is a single dot, and first character of
2531       --  suffix is also a dot
2532
2533       if Dot_Replacement_Is_A_Single_Dot
2534         and then Suffix (Suffix'First) = '.'
2535       then
2536          for Index in Suffix'First + 1 .. Suffix'Last loop
2537
2538             --  If there is another dot
2539
2540             if Suffix (Index) = '.' then
2541
2542                --  It is illegal to have a letter following the initial dot
2543
2544                return Is_Letter (Suffix (Suffix'First + 1));
2545             end if;
2546          end loop;
2547       end if;
2548
2549       --  Everything is OK
2550
2551       return False;
2552    end Is_Illegal_Suffix;
2553
2554    --------------------------------
2555    -- Language_Independent_Check --
2556    --------------------------------
2557
2558    procedure Language_Independent_Check
2559      (Project      : Project_Id;
2560       Report_Error : Put_Line_Access)
2561    is
2562       Last_Source_Dir : String_List_Id  := Nil_String;
2563       Data            : Project_Data    := Projects.Table (Project);
2564
2565       procedure Find_Source_Dirs (From : Name_Id; Location : Source_Ptr);
2566       --  Find one or several source directories, and add them
2567       --  to the list of source directories of the project.
2568
2569       ----------------------
2570       -- Find_Source_Dirs --
2571       ----------------------
2572
2573       procedure Find_Source_Dirs (From : Name_Id; Location : Source_Ptr) is
2574          Directory : constant String := Get_Name_String (From);
2575          Element   : String_Element;
2576
2577          procedure Recursive_Find_Dirs (Path : Name_Id);
2578          --  Find all the subdirectories (recursively) of Path and add them
2579          --  to the list of source directories of the project.
2580
2581          -------------------------
2582          -- Recursive_Find_Dirs --
2583          -------------------------
2584
2585          procedure Recursive_Find_Dirs (Path : Name_Id) is
2586             Dir      : Dir_Type;
2587             Name     : String (1 .. 250);
2588             Last     : Natural;
2589             List     : String_List_Id := Data.Source_Dirs;
2590             Element  : String_Element;
2591             Found    : Boolean := False;
2592
2593             Non_Canonical_Path : Name_Id := No_Name;
2594             Canonical_Path     : Name_Id := No_Name;
2595
2596             The_Path : constant String :=
2597                          Normalize_Pathname (Get_Name_String (Path)) &
2598             Directory_Separator;
2599
2600             The_Path_Last : constant Natural :=
2601                               Compute_Directory_Last (The_Path);
2602
2603          begin
2604             Name_Len := The_Path_Last - The_Path'First + 1;
2605             Name_Buffer (1 .. Name_Len) :=
2606               The_Path (The_Path'First .. The_Path_Last);
2607             Non_Canonical_Path := Name_Find;
2608             Get_Name_String (Non_Canonical_Path);
2609             Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2610             Canonical_Path := Name_Find;
2611
2612             --  To avoid processing the same directory several times, check
2613             --  if the directory is already in Recursive_Dirs. If it is,
2614             --  then there is nothing to do, just return. If it is not, put
2615             --  it there and continue recursive processing.
2616
2617             if Recursive_Dirs.Get (Canonical_Path) then
2618                return;
2619
2620             else
2621                Recursive_Dirs.Set (Canonical_Path, True);
2622             end if;
2623
2624             --  Check if directory is already in list
2625
2626             while List /= Nil_String loop
2627                Element := String_Elements.Table (List);
2628
2629                if Element.Value /= No_Name then
2630                   Found := Element.Value = Canonical_Path;
2631                   exit when Found;
2632                end if;
2633
2634                List := Element.Next;
2635             end loop;
2636
2637             --  If directory is not already in list, put it there
2638
2639             if not Found then
2640                if Current_Verbosity = High then
2641                   Write_Str  ("   ");
2642                   Write_Line (The_Path (The_Path'First .. The_Path_Last));
2643                end if;
2644
2645                String_Elements.Increment_Last;
2646                Element :=
2647                  (Value    => Canonical_Path,
2648                   Display_Value => Non_Canonical_Path,
2649                   Location => No_Location,
2650                   Flag     => False,
2651                   Next     => Nil_String);
2652
2653                --  Case of first source directory
2654
2655                if Last_Source_Dir = Nil_String then
2656                   Data.Source_Dirs := String_Elements.Last;
2657
2658                   --  Here we already have source directories.
2659
2660                else
2661                   --  Link the previous last to the new one
2662
2663                   String_Elements.Table (Last_Source_Dir).Next :=
2664                     String_Elements.Last;
2665                end if;
2666
2667                --  And register this source directory as the new last
2668
2669                Last_Source_Dir  := String_Elements.Last;
2670                String_Elements.Table (Last_Source_Dir) := Element;
2671             end if;
2672
2673             --  Now look for subdirectories. We do that even when this
2674             --  directory is already in the list, because some of its
2675             --  subdirectories may not be in the list yet.
2676
2677             Open (Dir, The_Path (The_Path'First .. The_Path_Last));
2678
2679             loop
2680                Read (Dir, Name, Last);
2681                exit when Last = 0;
2682
2683                if Name (1 .. Last) /= "."
2684                  and then Name (1 .. Last) /= ".."
2685                then
2686                   --  Avoid . and ..
2687
2688                   if Current_Verbosity = High then
2689                      Write_Str  ("   Checking ");
2690                      Write_Line (Name (1 .. Last));
2691                   end if;
2692
2693                   declare
2694                      Path_Name : constant String :=
2695                                    Normalize_Pathname
2696                                      (Name      => Name (1 .. Last),
2697                                       Directory =>
2698                                         The_Path
2699                                           (The_Path'First .. The_Path_Last));
2700
2701                   begin
2702                      if Is_Directory (Path_Name) then
2703
2704                         --  We have found a new subdirectory, call self
2705
2706                         Name_Len := Path_Name'Length;
2707                         Name_Buffer (1 .. Name_Len) := Path_Name;
2708                         Recursive_Find_Dirs (Name_Find);
2709                      end if;
2710                   end;
2711                end if;
2712             end loop;
2713
2714             Close (Dir);
2715
2716          exception
2717             when Directory_Error =>
2718                null;
2719          end Recursive_Find_Dirs;
2720
2721       --  Start of processing for Find_Source_Dirs
2722
2723       begin
2724          if Current_Verbosity = High then
2725             Write_Str ("Find_Source_Dirs (""");
2726          end if;
2727
2728          Get_Name_String (From);
2729          Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2730
2731          --  Directory    := Name_Buffer (1 .. Name_Len);
2732          --  Why is above line commented out ???
2733
2734          if Current_Verbosity = High then
2735             Write_Str (Directory);
2736             Write_Line (""")");
2737          end if;
2738
2739          --  First, check if we are looking for a directory tree,
2740          --  indicated by "/**" at the end.
2741
2742          if Directory'Length >= 3
2743            and then Directory (Directory'Last - 1 .. Directory'Last) = "**"
2744            and then (Directory (Directory'Last - 2) = '/'
2745                        or else
2746                      Directory (Directory'Last - 2) = Directory_Separator)
2747          then
2748             Data.Known_Order_Of_Source_Dirs := False;
2749
2750             Name_Len := Directory'Length - 3;
2751
2752             if Name_Len = 0 then
2753
2754                --  This is the case of "/**": all directories
2755                --  in the file system.
2756
2757                Name_Len := 1;
2758                Name_Buffer (1) := Directory (Directory'First);
2759
2760             else
2761                Name_Buffer (1 .. Name_Len) :=
2762                  Directory (Directory'First .. Directory'Last - 3);
2763             end if;
2764
2765             if Current_Verbosity = High then
2766                Write_Str ("Looking for all subdirectories of """);
2767                Write_Str (Name_Buffer (1 .. Name_Len));
2768                Write_Line ("""");
2769             end if;
2770
2771             declare
2772                Base_Dir : constant Name_Id := Name_Find;
2773                Root_Dir : constant String :=
2774                             Normalize_Pathname
2775                               (Name      => Get_Name_String (Base_Dir),
2776                                Directory =>
2777                                  Get_Name_String (Data.Display_Directory));
2778
2779             begin
2780                if Root_Dir'Length = 0 then
2781                   Err_Vars.Error_Msg_Name_1 := Base_Dir;
2782
2783                   if Location = No_Location then
2784                      Error_Msg
2785                        (Project,
2786                         "{ is not a valid directory.",
2787                         Data.Location);
2788                   else
2789                      Error_Msg
2790                        (Project,
2791                         "{ is not a valid directory.",
2792                         Location);
2793                   end if;
2794
2795                else
2796                   --  We have an existing directory,
2797                   --  we register it and all of its subdirectories.
2798
2799                   if Current_Verbosity = High then
2800                      Write_Line ("Looking for source directories:");
2801                   end if;
2802
2803                   Name_Len := Root_Dir'Length;
2804                   Name_Buffer (1 .. Name_Len) := Root_Dir;
2805                   Recursive_Find_Dirs (Name_Find);
2806
2807                   if Current_Verbosity = High then
2808                      Write_Line ("End of looking for source directories.");
2809                   end if;
2810                end if;
2811             end;
2812
2813          --  We have a single directory
2814
2815          else
2816             declare
2817                Path_Name : Name_Id;
2818                Display_Path_Name : Name_Id;
2819             begin
2820                Locate_Directory
2821                  (From, Data.Display_Directory, Path_Name, Display_Path_Name);
2822                if Path_Name = No_Name then
2823                   Err_Vars.Error_Msg_Name_1 := From;
2824
2825                   if Location = No_Location then
2826                      Error_Msg
2827                        (Project,
2828                         "{ is not a valid directory",
2829                         Data.Location);
2830                   else
2831                      Error_Msg
2832                        (Project,
2833                         "{ is not a valid directory",
2834                         Location);
2835                   end if;
2836                else
2837
2838                   --  As it is an existing directory, we add it to
2839                   --  the list of directories.
2840
2841                   String_Elements.Increment_Last;
2842                   Element.Value := Path_Name;
2843                   Element.Display_Value := Display_Path_Name;
2844
2845                   if Last_Source_Dir = Nil_String then
2846
2847                      --  This is the first source directory
2848
2849                      Data.Source_Dirs := String_Elements.Last;
2850
2851                   else
2852                      --  We already have source directories,
2853                      --  link the previous last to the new one.
2854
2855                      String_Elements.Table (Last_Source_Dir).Next :=
2856                        String_Elements.Last;
2857                   end if;
2858
2859                   --  And register this source directory as the new last
2860
2861                   Last_Source_Dir := String_Elements.Last;
2862                   String_Elements.Table (Last_Source_Dir) := Element;
2863                end if;
2864             end;
2865          end if;
2866       end Find_Source_Dirs;
2867
2868    --  Start of processing for Language_Independent_Check
2869
2870    begin
2871       if Data.Language_Independent_Checked then
2872          return;
2873       end if;
2874
2875       Data.Language_Independent_Checked := True;
2876
2877       Error_Report := Report_Error;
2878
2879       Recursive_Dirs.Reset;
2880
2881       if Current_Verbosity = High then
2882          Write_Line ("Starting to look for directories");
2883       end if;
2884
2885       --  Check the object directory
2886
2887       declare
2888          Object_Dir : constant Variable_Value :=
2889                         Util.Value_Of (Name_Object_Dir, Data.Decl.Attributes);
2890
2891       begin
2892          pragma Assert (Object_Dir.Kind = Single,
2893                         "Object_Dir is not a single string");
2894
2895          --  We set the object directory to its default
2896
2897          Data.Object_Directory   := Data.Directory;
2898          Data.Display_Object_Dir := Data.Display_Directory;
2899
2900          if Object_Dir.Value /= Empty_String then
2901
2902             Get_Name_String (Object_Dir.Value);
2903
2904             if Name_Len = 0 then
2905                Error_Msg
2906                  (Project,
2907                   "Object_Dir cannot be empty",
2908                   Object_Dir.Location);
2909
2910             else
2911                --  We check that the specified object directory
2912                --  does exist.
2913
2914                Locate_Directory
2915                  (Object_Dir.Value, Data.Display_Directory,
2916                   Data.Object_Directory, Data.Display_Object_Dir);
2917
2918                if Data.Object_Directory = No_Name then
2919                   --  The object directory does not exist, report an error
2920                   Err_Vars.Error_Msg_Name_1 := Object_Dir.Value;
2921                   Error_Msg
2922                     (Project,
2923                      "the object directory { cannot be found",
2924                      Data.Location);
2925
2926                   --  Do not keep a nil Object_Directory. Set it to the
2927                   --  specified (relative or absolute) path.
2928                   --  This is for the benefit of tools that recover from
2929                   --  errors; for example, these tools could create the
2930                   --  non existent directory.
2931
2932                   Data.Display_Object_Dir := Object_Dir.Value;
2933                   Get_Name_String (Object_Dir.Value);
2934                   Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2935                   Data.Object_Directory := Name_Find;
2936                end if;
2937             end if;
2938          end if;
2939       end;
2940
2941       if Current_Verbosity = High then
2942          if Data.Object_Directory = No_Name then
2943             Write_Line ("No object directory");
2944          else
2945             Write_Str ("Object directory: """);
2946             Write_Str (Get_Name_String (Data.Display_Object_Dir));
2947             Write_Line ("""");
2948          end if;
2949       end if;
2950
2951       --  Check the exec directory
2952
2953       declare
2954          Exec_Dir : constant Variable_Value :=
2955                       Util.Value_Of (Name_Exec_Dir, Data.Decl.Attributes);
2956
2957       begin
2958          pragma Assert (Exec_Dir.Kind = Single,
2959                         "Exec_Dir is not a single string");
2960
2961          --  We set the object directory to its default
2962
2963          Data.Exec_Directory   := Data.Object_Directory;
2964          Data.Display_Exec_Dir := Data.Display_Object_Dir;
2965
2966          if Exec_Dir.Value /= Empty_String then
2967
2968             Get_Name_String (Exec_Dir.Value);
2969
2970             if Name_Len = 0 then
2971                Error_Msg
2972                  (Project,
2973                   "Exec_Dir cannot be empty",
2974                   Exec_Dir.Location);
2975
2976             else
2977                --  We check that the specified object directory
2978                --  does exist.
2979
2980                Locate_Directory
2981                  (Exec_Dir.Value, Data.Directory,
2982                   Data.Exec_Directory, Data.Display_Exec_Dir);
2983
2984                if Data.Exec_Directory = No_Name then
2985                   Err_Vars.Error_Msg_Name_1 := Exec_Dir.Value;
2986                   Error_Msg
2987                     (Project,
2988                      "the exec directory { cannot be found",
2989                      Data.Location);
2990                end if;
2991             end if;
2992          end if;
2993       end;
2994
2995       if Current_Verbosity = High then
2996          if Data.Exec_Directory = No_Name then
2997             Write_Line ("No exec directory");
2998          else
2999             Write_Str ("Exec directory: """);
3000             Write_Str (Get_Name_String (Data.Display_Exec_Dir));
3001             Write_Line ("""");
3002          end if;
3003       end if;
3004
3005       --  Look for the source directories
3006
3007       declare
3008          Source_Dirs : constant Variable_Value :=
3009                          Util.Value_Of
3010                            (Name_Source_Dirs, Data.Decl.Attributes);
3011
3012       begin
3013          if Current_Verbosity = High then
3014             Write_Line ("Starting to look for source directories");
3015          end if;
3016
3017          pragma Assert (Source_Dirs.Kind = List,
3018                           "Source_Dirs is not a list");
3019
3020          if Source_Dirs.Default then
3021
3022             --  No Source_Dirs specified: the single source directory
3023             --  is the one containing the project file
3024
3025             String_Elements.Increment_Last;
3026             Data.Source_Dirs := String_Elements.Last;
3027             String_Elements.Table (Data.Source_Dirs) :=
3028               (Value    => Data.Directory,
3029                Display_Value => Data.Display_Directory,
3030                Location => No_Location,
3031                Flag     => False,
3032                Next     => Nil_String);
3033
3034             if Current_Verbosity = High then
3035                Write_Line ("Single source directory:");
3036                Write_Str ("    """);
3037                Write_Str (Get_Name_String (Data.Display_Directory));
3038                Write_Line ("""");
3039             end if;
3040
3041          elsif Source_Dirs.Values = Nil_String then
3042
3043             --  If Source_Dirs is an empty string list, this means
3044             --  that this project contains no source. For projects that
3045             --  don't extend other projects, this also means that there is no
3046             --  need for an object directory, if not specified.
3047
3048             if Data.Extends = No_Project
3049               and then  Data.Object_Directory = Data.Directory
3050             then
3051                Data.Object_Directory := No_Name;
3052             end if;
3053
3054             Data.Source_Dirs     := Nil_String;
3055             Data.Sources_Present := False;
3056
3057          else
3058             declare
3059                Source_Dir : String_List_Id := Source_Dirs.Values;
3060                Element    : String_Element;
3061
3062             begin
3063                --  We will find the source directories for each
3064                --  element of the list
3065
3066                while Source_Dir /= Nil_String loop
3067                   Element := String_Elements.Table (Source_Dir);
3068                   Find_Source_Dirs (Element.Value, Element.Location);
3069                   Source_Dir := Element.Next;
3070                end loop;
3071             end;
3072          end if;
3073
3074          if Current_Verbosity = High then
3075             Write_Line ("Putting source directories in canonical cases");
3076          end if;
3077
3078          declare
3079             Current : String_List_Id := Data.Source_Dirs;
3080             Element : String_Element;
3081
3082          begin
3083             while Current /= Nil_String loop
3084                Element := String_Elements.Table (Current);
3085                if Element.Value /= No_Name then
3086                   Get_Name_String (Element.Value);
3087                   Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3088                   Element.Value := Name_Find;
3089                   String_Elements.Table (Current) := Element;
3090                end if;
3091
3092                Current := Element.Next;
3093             end loop;
3094          end;
3095       end;
3096
3097       --  Library attributes
3098
3099       declare
3100          Attributes : constant Prj.Variable_Id := Data.Decl.Attributes;
3101
3102          Lib_Dir : constant Prj.Variable_Value :=
3103                      Prj.Util.Value_Of (Snames.Name_Library_Dir, Attributes);
3104
3105          Lib_Name : constant Prj.Variable_Value :=
3106                       Prj.Util.Value_Of (Snames.Name_Library_Name, Attributes);
3107
3108          Lib_Version : constant Prj.Variable_Value :=
3109                          Prj.Util.Value_Of
3110                            (Snames.Name_Library_Version, Attributes);
3111
3112          The_Lib_Kind : constant Prj.Variable_Value :=
3113                           Prj.Util.Value_Of
3114                             (Snames.Name_Library_Kind, Attributes);
3115
3116       begin
3117          --  Special case of extending project
3118
3119          if Data.Extends /= No_Project then
3120             declare
3121                Extended_Data : constant Project_Data :=
3122                  Projects.Table (Data.Extends);
3123
3124             begin
3125                --  If the project extended is a library project, we inherit
3126                --  the library name, if it is not redefined; we check that
3127                --  the library directory is specified; and we reset the
3128                --  library flag for the extended project.
3129
3130                if Extended_Data.Library then
3131                   if Lib_Name.Default then
3132                      Data.Library_Name := Extended_Data.Library_Name;
3133                   end if;
3134
3135                   if Lib_Dir.Default then
3136
3137                      --  If the extending project is a virtual project, we
3138                      --  put the error message in the library project that
3139                      --  is extended, rather than in the extending all project.
3140                      --  Of course, we cannot put it in the virtual extending
3141                      --  project, because it has no source.
3142
3143                      if Data.Virtual then
3144                         Error_Msg_Name_1 := Extended_Data.Name;
3145
3146                         Error_Msg
3147                           (Project,
3148                            "library project % cannot be virtually extended",
3149                            Extended_Data.Location);
3150
3151                      else
3152                         Error_Msg
3153                           (Project,
3154                            "a project extending a library project must " &
3155                            "specify an attribute Library_Dir",
3156                            Data.Location);
3157                      end if;
3158                   end if;
3159
3160                   Projects.Table (Data.Extends).Library := False;
3161                end if;
3162             end;
3163          end if;
3164
3165          pragma Assert (Lib_Dir.Kind = Single);
3166
3167          if Lib_Dir.Value = Empty_String then
3168
3169             if Current_Verbosity = High then
3170                Write_Line ("No library directory");
3171             end if;
3172
3173          else
3174             --  Find path name, check that it is a directory
3175
3176             Locate_Directory
3177               (Lib_Dir.Value, Data.Display_Directory,
3178                Data.Library_Dir, Data.Display_Library_Dir);
3179
3180             if Data.Library_Dir = No_Name then
3181
3182                --  Get the absolute name of the library directory that
3183                --  does not exist, to report an error.
3184
3185                declare
3186                   Dir_Name : constant String :=
3187                     Get_Name_String (Lib_Dir.Value);
3188                begin
3189                   if Is_Absolute_Path (Dir_Name) then
3190                      Err_Vars.Error_Msg_Name_1 := Lib_Dir.Value;
3191
3192                   else
3193                      Get_Name_String (Data.Display_Directory);
3194
3195                      if Name_Buffer (Name_Len) /= Directory_Separator then
3196                         Name_Len := Name_Len + 1;
3197                         Name_Buffer (Name_Len) := Directory_Separator;
3198                      end if;
3199
3200                      Name_Buffer
3201                        (Name_Len + 1 .. Name_Len + Dir_Name'Length) :=
3202                        Dir_Name;
3203                      Name_Len := Name_Len + Dir_Name'Length;
3204                      Err_Vars.Error_Msg_Name_1 := Name_Find;
3205                   end if;
3206
3207                   --  Report the error
3208
3209                   Error_Msg
3210                     (Project,
3211                      "library directory { does not exist",
3212                      Lib_Dir.Location);
3213                end;
3214
3215             elsif Data.Library_Dir = Data.Object_Directory then
3216                Error_Msg
3217                  (Project,
3218                   "library directory cannot be the same " &
3219                   "as object directory",
3220                   Lib_Dir.Location);
3221                Data.Library_Dir := No_Name;
3222                Data.Display_Library_Dir := No_Name;
3223
3224             else
3225                if Current_Verbosity = High then
3226                   Write_Str ("Library directory =""");
3227                   Write_Str (Get_Name_String (Data.Display_Library_Dir));
3228                   Write_Line ("""");
3229                end if;
3230             end if;
3231          end if;
3232
3233          pragma Assert (Lib_Name.Kind = Single);
3234
3235          if Lib_Name.Value = Empty_String then
3236             if Current_Verbosity = High
3237               and then Data.Library_Name = No_Name
3238             then
3239                Write_Line ("No library name");
3240             end if;
3241
3242          else
3243             --  There is no restriction on the syntax of library names
3244
3245             Data.Library_Name := Lib_Name.Value;
3246          end if;
3247
3248          if Data.Library_Name /= No_Name
3249            and then Current_Verbosity = High
3250          then
3251             Write_Str ("Library name = """);
3252             Write_Str (Get_Name_String (Data.Library_Name));
3253             Write_Line ("""");
3254          end if;
3255
3256          Data.Library :=
3257            Data.Library_Dir /= No_Name
3258              and then
3259            Data.Library_Name /= No_Name;
3260
3261          if Data.Library then
3262             if MLib.Tgt.Support_For_Libraries = MLib.Tgt.None then
3263                Error_Msg
3264                  (Project,
3265                   "?libraries are not supported on this platform",
3266                   Lib_Name.Location);
3267                Data.Library := False;
3268
3269             else
3270                pragma Assert (Lib_Version.Kind = Single);
3271
3272                if Lib_Version.Value = Empty_String then
3273                   if Current_Verbosity = High then
3274                      Write_Line ("No library version specified");
3275                   end if;
3276
3277                else
3278                   Data.Lib_Internal_Name := Lib_Version.Value;
3279                end if;
3280
3281                pragma Assert (The_Lib_Kind.Kind = Single);
3282
3283                if The_Lib_Kind.Value = Empty_String then
3284                   if Current_Verbosity = High then
3285                      Write_Line ("No library kind specified");
3286                   end if;
3287
3288                else
3289                   Get_Name_String (The_Lib_Kind.Value);
3290
3291                   declare
3292                      Kind_Name : constant String :=
3293                                    To_Lower (Name_Buffer (1 .. Name_Len));
3294
3295                      OK : Boolean := True;
3296
3297                   begin
3298                      if Kind_Name = "static" then
3299                         Data.Library_Kind := Static;
3300
3301                      elsif Kind_Name = "dynamic" then
3302                         Data.Library_Kind := Dynamic;
3303
3304                      elsif Kind_Name = "relocatable" then
3305                         Data.Library_Kind := Relocatable;
3306
3307                      else
3308                         Error_Msg
3309                           (Project,
3310                            "illegal value for Library_Kind",
3311                            The_Lib_Kind.Location);
3312                         OK := False;
3313                      end if;
3314
3315                      if Current_Verbosity = High and then OK then
3316                         Write_Str ("Library kind = ");
3317                         Write_Line (Kind_Name);
3318                      end if;
3319
3320                      if Data.Library_Kind /= Static and then
3321                        MLib.Tgt.Support_For_Libraries = MLib.Tgt.Static_Only
3322                      then
3323                         Error_Msg
3324                           (Project,
3325                            "only static libraries are supported " &
3326                            "on this platform",
3327                           The_Lib_Kind.Location);
3328                         Data.Library := False;
3329                      end if;
3330                   end;
3331                end if;
3332
3333                if Data.Library and then Current_Verbosity = High then
3334                   Write_Line ("This is a library project file");
3335                end if;
3336
3337             end if;
3338          end if;
3339       end;
3340
3341       if Current_Verbosity = High then
3342          Show_Source_Dirs (Project);
3343       end if;
3344
3345       declare
3346          Naming_Id : constant Package_Id :=
3347                        Util.Value_Of (Name_Naming, Data.Decl.Packages);
3348
3349          Naming    : Package_Element;
3350
3351       begin
3352          --  If there is a package Naming, we will put in Data.Naming
3353          --  what is in this package Naming.
3354
3355          if Naming_Id /= No_Package then
3356             Naming := Packages.Table (Naming_Id);
3357
3358             if Current_Verbosity = High then
3359                Write_Line ("Checking ""Naming"".");
3360             end if;
3361
3362             --  Check Spec_Suffix
3363
3364             declare
3365                Spec_Suffixs : Array_Element_Id :=
3366                                 Util.Value_Of
3367                                   (Name_Spec_Suffix,
3368                                    Naming.Decl.Arrays);
3369                Suffix  : Array_Element_Id;
3370                Element : Array_Element;
3371                Suffix2 : Array_Element_Id;
3372
3373             begin
3374                --  If some suffixs have been specified, we make sure that
3375                --  for each language for which a default suffix has been
3376                --  specified, there is a suffix specified, either the one
3377                --  in the project file or if there were none, the default.
3378
3379                if Spec_Suffixs /= No_Array_Element then
3380                   Suffix := Data.Naming.Spec_Suffix;
3381
3382                   while Suffix /= No_Array_Element loop
3383                      Element := Array_Elements.Table (Suffix);
3384                      Suffix2 := Spec_Suffixs;
3385
3386                      while Suffix2 /= No_Array_Element loop
3387                         exit when Array_Elements.Table (Suffix2).Index =
3388                           Element.Index;
3389                         Suffix2 := Array_Elements.Table (Suffix2).Next;
3390                      end loop;
3391
3392                      --  There is a registered default suffix, but no
3393                      --  suffix specified in the project file.
3394                      --  Add the default to the array.
3395
3396                      if Suffix2 = No_Array_Element then
3397                         Array_Elements.Increment_Last;
3398                         Array_Elements.Table (Array_Elements.Last) :=
3399                           (Index => Element.Index,
3400                            Index_Case_Sensitive => False,
3401                            Value => Element.Value,
3402                            Next  => Spec_Suffixs);
3403                         Spec_Suffixs := Array_Elements.Last;
3404                      end if;
3405
3406                      Suffix := Element.Next;
3407                   end loop;
3408
3409                   --  Put the resulting array as the specification suffixs
3410
3411                   Data.Naming.Spec_Suffix := Spec_Suffixs;
3412                end if;
3413             end;
3414
3415             declare
3416                Current : Array_Element_Id := Data.Naming.Spec_Suffix;
3417                Element : Array_Element;
3418
3419             begin
3420                while Current /= No_Array_Element loop
3421                   Element := Array_Elements.Table (Current);
3422                   Get_Name_String (Element.Value.Value);
3423
3424                   if Name_Len = 0 then
3425                      Error_Msg
3426                        (Project,
3427                         "Spec_Suffix cannot be empty",
3428                         Element.Value.Location);
3429                   end if;
3430
3431                   Array_Elements.Table (Current) := Element;
3432                   Current := Element.Next;
3433                end loop;
3434             end;
3435
3436             --  Check Body_Suffix
3437
3438             declare
3439                Impl_Suffixs : Array_Element_Id :=
3440                                 Util.Value_Of
3441                                   (Name_Body_Suffix,
3442                                    Naming.Decl.Arrays);
3443
3444                Suffix  : Array_Element_Id;
3445                Element : Array_Element;
3446                Suffix2 : Array_Element_Id;
3447
3448             begin
3449                --  If some suffixs have been specified, we make sure that
3450                --  for each language for which a default suffix has been
3451                --  specified, there is a suffix specified, either the one
3452                --  in the project file or if there were noe, the default.
3453
3454                if Impl_Suffixs /= No_Array_Element then
3455                   Suffix := Data.Naming.Body_Suffix;
3456
3457                   while Suffix /= No_Array_Element loop
3458                      Element := Array_Elements.Table (Suffix);
3459                      Suffix2 := Impl_Suffixs;
3460
3461                      while Suffix2 /= No_Array_Element loop
3462                         exit when Array_Elements.Table (Suffix2).Index =
3463                           Element.Index;
3464                         Suffix2 := Array_Elements.Table (Suffix2).Next;
3465                      end loop;
3466
3467                      --  There is a registered default suffix, but no
3468                      --  suffix specified in the project file.
3469                      --  Add the default to the array.
3470
3471                      if Suffix2 = No_Array_Element then
3472                         Array_Elements.Increment_Last;
3473                         Array_Elements.Table (Array_Elements.Last) :=
3474                           (Index => Element.Index,
3475                            Index_Case_Sensitive => False,
3476                            Value => Element.Value,
3477                            Next  => Impl_Suffixs);
3478                         Impl_Suffixs := Array_Elements.Last;
3479                      end if;
3480
3481                      Suffix := Element.Next;
3482                   end loop;
3483
3484                   --  Put the resulting array as the implementation suffixs
3485
3486                   Data.Naming.Body_Suffix := Impl_Suffixs;
3487                end if;
3488             end;
3489
3490             declare
3491                Current : Array_Element_Id := Data.Naming.Body_Suffix;
3492                Element : Array_Element;
3493
3494             begin
3495                while Current /= No_Array_Element loop
3496                   Element := Array_Elements.Table (Current);
3497                   Get_Name_String (Element.Value.Value);
3498
3499                   if Name_Len = 0 then
3500                      Error_Msg
3501                        (Project,
3502                         "Body_Suffix cannot be empty",
3503                         Element.Value.Location);
3504                   end if;
3505
3506                   Array_Elements.Table (Current) := Element;
3507                   Current := Element.Next;
3508                end loop;
3509             end;
3510
3511             --  Get the exceptions, if any
3512
3513             Data.Naming.Specification_Exceptions :=
3514               Util.Value_Of
3515                 (Name_Specification_Exceptions,
3516                  In_Arrays => Naming.Decl.Arrays);
3517
3518             Data.Naming.Implementation_Exceptions :=
3519               Util.Value_Of
3520                 (Name_Implementation_Exceptions,
3521                  In_Arrays => Naming.Decl.Arrays);
3522          end if;
3523       end;
3524
3525       Projects.Table (Project) := Data;
3526    end Language_Independent_Check;
3527
3528    ----------------------
3529    -- Locate_Directory --
3530    ----------------------
3531
3532    procedure Locate_Directory
3533      (Name    : Name_Id;
3534       Parent  : Name_Id;
3535       Dir     : out Name_Id;
3536       Display : out Name_Id)
3537    is
3538       The_Name   : constant String := Get_Name_String (Name);
3539       The_Parent : constant String :=
3540                      Get_Name_String (Parent) & Directory_Separator;
3541       The_Parent_Last : constant Natural :=
3542                      Compute_Directory_Last (The_Parent);
3543
3544    begin
3545       if Current_Verbosity = High then
3546          Write_Str ("Locate_Directory (""");
3547          Write_Str (The_Name);
3548          Write_Str (""", """);
3549          Write_Str (The_Parent);
3550          Write_Line (""")");
3551       end if;
3552
3553       Dir     := No_Name;
3554       Display := No_Name;
3555
3556       if Is_Absolute_Path (The_Name) then
3557          if Is_Directory (The_Name) then
3558             declare
3559                Normed : constant String :=
3560                  Normalize_Pathname (The_Name);
3561
3562             begin
3563                Name_Len := Normed'Length;
3564                Name_Buffer (1 .. Name_Len) := Normed;
3565                Display := Name_Find;
3566                Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3567                Dir := Name_Find;
3568             end;
3569          end if;
3570
3571       else
3572          declare
3573             Full_Path : constant String :=
3574                           The_Parent (The_Parent'First .. The_Parent_Last) &
3575                           The_Name;
3576
3577          begin
3578             if Is_Directory (Full_Path) then
3579                declare
3580                   Normed : constant String :=
3581                              Normalize_Pathname (Full_Path);
3582
3583                begin
3584                   Name_Len := Normed'Length;
3585                   Name_Buffer (1 .. Name_Len) := Normed;
3586                   Display := Name_Find;
3587                   Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3588                   Dir := Name_Find;
3589                end;
3590             end if;
3591          end;
3592       end if;
3593    end Locate_Directory;
3594
3595    ------------------
3596    -- Path_Name_Of --
3597    ------------------
3598
3599    function Path_Name_Of
3600      (File_Name : Name_Id;
3601       Directory : Name_Id) return String
3602    is
3603       Result : String_Access;
3604       The_Directory : constant String := Get_Name_String (Directory);
3605
3606    begin
3607       Get_Name_String (File_Name);
3608       Result := Locate_Regular_File
3609         (File_Name => Name_Buffer (1 .. Name_Len),
3610          Path      => The_Directory);
3611
3612       if Result = null then
3613          return "";
3614       else
3615          Canonical_Case_File_Name (Result.all);
3616          return Result.all;
3617       end if;
3618    end Path_Name_Of;
3619
3620    ---------------------
3621    -- Project_Extends --
3622    ---------------------
3623
3624    function Project_Extends
3625      (Extending : Project_Id;
3626       Extended  : Project_Id) return Boolean
3627    is
3628       Current : Project_Id := Extending;
3629    begin
3630       loop
3631          if Current = No_Project then
3632             return False;
3633
3634          elsif Current = Extended then
3635             return True;
3636          end if;
3637
3638          Current := Projects.Table (Current).Extends;
3639       end loop;
3640    end Project_Extends;
3641
3642    -------------------
3643    -- Record_Source --
3644    -------------------
3645
3646    procedure Record_Source
3647      (File_Name       : Name_Id;
3648       Path_Name       : Name_Id;
3649       Project         : Project_Id;
3650       Data            : in out Project_Data;
3651       Location        : Source_Ptr;
3652       Current_Source  : in out String_List_Id;
3653       Source_Recorded : in out Boolean)
3654    is
3655       Canonical_File_Name : Name_Id;
3656       Canonical_Path_Name : Name_Id;
3657       Unit_Name    : Name_Id;
3658       Unit_Kind    : Spec_Or_Body;
3659       Needs_Pragma : Boolean;
3660
3661       The_Location    : Source_Ptr     := Location;
3662       Previous_Source : constant String_List_Id := Current_Source;
3663       Except_Name     : Name_Id        := No_Name;
3664
3665    begin
3666       Get_Name_String (File_Name);
3667       Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3668       Canonical_File_Name := Name_Find;
3669       Get_Name_String (Path_Name);
3670       Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3671       Canonical_Path_Name := Name_Find;
3672
3673       --  Find out the unit name, the unit kind and if it needs
3674       --  a specific SFN pragma.
3675
3676       Get_Unit
3677         (Canonical_File_Name => Canonical_File_Name,
3678          Naming              => Data.Naming,
3679          Unit_Name           => Unit_Name,
3680          Unit_Kind           => Unit_Kind,
3681          Needs_Pragma        => Needs_Pragma);
3682
3683       if Unit_Name = No_Name then
3684          if Current_Verbosity = High then
3685             Write_Str  ("   """);
3686             Write_Str  (Get_Name_String (Canonical_File_Name));
3687             Write_Line (""" is not a valid source file name (ignored).");
3688          end if;
3689
3690       else
3691          --  Check to see if the source has been hidden by an exception,
3692          --  but only if it is not an exception.
3693
3694          if not Needs_Pragma then
3695             Except_Name :=
3696               Reverse_Naming_Exceptions.Get ((Unit_Kind, Unit_Name));
3697
3698             if Except_Name /= No_Name then
3699                if Current_Verbosity = High then
3700                   Write_Str  ("   """);
3701                   Write_Str  (Get_Name_String (Canonical_File_Name));
3702                   Write_Str  (""" contains a unit that is found in """);
3703                   Write_Str  (Get_Name_String (Except_Name));
3704                   Write_Line (""" (ignored).");
3705                end if;
3706
3707                --  The file is not included in the source of the project,
3708                --  because it is hidden by the exception.
3709                --  So, there is nothing else to do.
3710
3711                return;
3712             end if;
3713          end if;
3714
3715          --  Put the file name in the list of sources of the project
3716
3717          String_Elements.Increment_Last;
3718          String_Elements.Table (String_Elements.Last) :=
3719            (Value         => Canonical_File_Name,
3720             Display_Value => File_Name,
3721             Location      => No_Location,
3722             Flag          => False,
3723             Next          => Nil_String);
3724
3725          if Current_Source = Nil_String then
3726             Data.Sources := String_Elements.Last;
3727
3728          else
3729             String_Elements.Table (Current_Source).Next :=
3730               String_Elements.Last;
3731          end if;
3732
3733          Current_Source := String_Elements.Last;
3734
3735          --  Put the unit in unit list
3736
3737          declare
3738             The_Unit      : Unit_Id := Units_Htable.Get (Unit_Name);
3739             The_Unit_Data : Unit_Data;
3740
3741          begin
3742             if Current_Verbosity = High then
3743                Write_Str  ("Putting ");
3744                Write_Str  (Get_Name_String (Unit_Name));
3745                Write_Line (" in the unit list.");
3746             end if;
3747
3748             --  The unit is already in the list, but may be it is
3749             --  only the other unit kind (spec or body), or what is
3750             --  in the unit list is a unit of a project we are extending.
3751
3752             if The_Unit /= Prj.Com.No_Unit then
3753                The_Unit_Data := Units.Table (The_Unit);
3754
3755                if The_Unit_Data.File_Names (Unit_Kind).Name = No_Name
3756                  or else Project_Extends
3757                            (Data.Extends,
3758                             The_Unit_Data.File_Names (Unit_Kind).Project)
3759                then
3760                   if The_Unit_Data.File_Names (Unit_Kind).Path = Slash then
3761                      Remove_Forbidden_File_Name
3762                        (The_Unit_Data.File_Names (Unit_Kind).Name);
3763                   end if;
3764
3765                   The_Unit_Data.File_Names (Unit_Kind) :=
3766                     (Name         => Canonical_File_Name,
3767                      Display_Name => File_Name,
3768                      Path         => Canonical_Path_Name,
3769                      Display_Path => Path_Name,
3770                      Project      => Project,
3771                      Needs_Pragma => Needs_Pragma);
3772                   Units.Table (The_Unit) := The_Unit_Data;
3773                   Source_Recorded := True;
3774
3775                elsif The_Unit_Data.File_Names (Unit_Kind).Project = Project
3776                  and then (Data.Known_Order_Of_Source_Dirs or else
3777                            The_Unit_Data.File_Names (Unit_Kind).Path =
3778                                                           Canonical_Path_Name)
3779                then
3780                   if Previous_Source = Nil_String then
3781                      Data.Sources := Nil_String;
3782                   else
3783                      String_Elements.Table (Previous_Source).Next :=
3784                        Nil_String;
3785                      String_Elements.Decrement_Last;
3786                   end if;
3787
3788                   Current_Source := Previous_Source;
3789
3790                else
3791                   --  It is an error to have two units with the same name
3792                   --  and the same kind (spec or body).
3793
3794                   if The_Location = No_Location then
3795                      The_Location := Projects.Table (Project).Location;
3796                   end if;
3797
3798                   Err_Vars.Error_Msg_Name_1 := Unit_Name;
3799                   Error_Msg (Project, "duplicate source {", The_Location);
3800
3801                   Err_Vars.Error_Msg_Name_1 :=
3802                     Projects.Table
3803                       (The_Unit_Data.File_Names (Unit_Kind).Project).Name;
3804                   Err_Vars.Error_Msg_Name_2 :=
3805                     The_Unit_Data.File_Names (Unit_Kind).Path;
3806                   Error_Msg (Project, "\   project file {, {", The_Location);
3807
3808                   Err_Vars.Error_Msg_Name_1 := Projects.Table (Project).Name;
3809                   Err_Vars.Error_Msg_Name_2 := Canonical_Path_Name;
3810                   Error_Msg (Project, "\   project file {, {", The_Location);
3811
3812                end if;
3813
3814             --  It is a new unit, create a new record
3815
3816             else
3817                Units.Increment_Last;
3818                The_Unit := Units.Last;
3819                Units_Htable.Set (Unit_Name, The_Unit);
3820                The_Unit_Data.Name := Unit_Name;
3821                The_Unit_Data.File_Names (Unit_Kind) :=
3822                  (Name         => Canonical_File_Name,
3823                   Display_Name => File_Name,
3824                   Path         => Canonical_Path_Name,
3825                   Display_Path => Path_Name,
3826                   Project      => Project,
3827                   Needs_Pragma => Needs_Pragma);
3828                Units.Table (The_Unit) := The_Unit_Data;
3829                Source_Recorded := True;
3830             end if;
3831          end;
3832       end if;
3833    end Record_Source;
3834
3835    ----------------------
3836    -- Show_Source_Dirs --
3837    ----------------------
3838
3839    procedure Show_Source_Dirs (Project : Project_Id) is
3840       Current : String_List_Id := Projects.Table (Project).Source_Dirs;
3841       Element : String_Element;
3842
3843    begin
3844       Write_Line ("Source_Dirs:");
3845
3846       while Current /= Nil_String loop
3847          Element := String_Elements.Table (Current);
3848          Write_Str  ("   ");
3849          Write_Line (Get_Name_String (Element.Value));
3850          Current := Element.Next;
3851       end loop;
3852
3853       Write_Line ("end Source_Dirs.");
3854    end Show_Source_Dirs;
3855
3856 end Prj.Nmsc;