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