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 The_Unit_Data.File_Names (Specification).Project /=
 995                     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 The_Unit_Data.File_Names (Com.Body_Part).Project /=
1005                     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             Auto_Init_Supported
1354                            : constant Boolean :=
1355                                MLib.Tgt.
1356                                  Standalone_Library_Auto_Init_Is_Supported;
1357
1358          begin
1359             pragma Assert (Lib_Interfaces.Kind = List);
1360
1361             --  It is a library project file if attribute Library_Interface
1362             --  is defined.
1363
1364             if not Lib_Interfaces.Default then
1365                declare
1366                   Interfaces : String_List_Id := Lib_Interfaces.Values;
1367                   Interface_ALIs : String_List_Id := Nil_String;
1368                   Unit : Name_Id;
1369                   The_Unit_Id : Unit_Id;
1370                   The_Unit_Data : Unit_Data;
1371
1372                   procedure Add_ALI_For (Source : Name_Id);
1373                   --  Add an ALI file name to the list of Interface ALIs
1374
1375                   -----------------
1376                   -- Add_ALI_For --
1377                   -----------------
1378
1379                   procedure Add_ALI_For (Source : Name_Id) is
1380                   begin
1381                      Get_Name_String (Source);
1382
1383                      declare
1384                         ALI : constant String :=
1385                                 ALI_File_Name (Name_Buffer (1 .. Name_Len));
1386                         ALI_Name_Id : Name_Id;
1387                      begin
1388                         Name_Len := ALI'Length;
1389                         Name_Buffer (1 .. Name_Len) := ALI;
1390                         ALI_Name_Id := Name_Find;
1391
1392                         String_Elements.Increment_Last;
1393                         String_Elements.Table (String_Elements.Last) :=
1394                           (Value    => ALI_Name_Id,
1395                            Display_Value => No_Name,
1396                            Location => String_Elements.Table
1397                                                          (Interfaces).Location,
1398                            Flag     => False,
1399                            Next     => Interface_ALIs);
1400                         Interface_ALIs := String_Elements.Last;
1401                      end;
1402                   end Add_ALI_For;
1403
1404                begin
1405                   Data.Standalone_Library := True;
1406
1407                   --  Library_Interface cannot be an empty list
1408
1409                   if Interfaces = Nil_String then
1410                      Error_Msg
1411                        (Project,
1412                         "Library_Interface cannot be an empty list",
1413                         Lib_Interfaces.Location);
1414                   end if;
1415
1416                   --  Process each unit name specified in the attribute
1417                   --  Library_Interface.
1418
1419                   while Interfaces /= Nil_String loop
1420                      Get_Name_String
1421                        (String_Elements.Table (Interfaces).Value);
1422                      To_Lower (Name_Buffer (1 .. Name_Len));
1423
1424                      if Name_Len = 0 then
1425                         Error_Msg
1426                           (Project,
1427                            "an interface cannot be an empty string",
1428                            String_Elements.Table (Interfaces).Location);
1429
1430                      else
1431                         Unit := Name_Find;
1432                         Error_Msg_Name_1 := Unit;
1433                         The_Unit_Id := Units_Htable.Get (Unit);
1434
1435                         if The_Unit_Id = Prj.Com.No_Unit then
1436                            Error_Msg
1437                              (Project,
1438                               "unknown unit {",
1439                               String_Elements.Table (Interfaces).Location);
1440
1441                         else
1442                            --  Check that the unit is part of the project
1443
1444                            The_Unit_Data := Units.Table (The_Unit_Id);
1445
1446                            if The_Unit_Data.File_Names
1447                                 (Com.Body_Part).Name /= No_Name
1448                              and then The_Unit_Data.File_Names
1449                                         (Com.Body_Part).Path /= Slash
1450                            then
1451                               if Check_Project
1452                                  (The_Unit_Data.File_Names (Body_Part).Project)
1453                               then
1454                                  --  There is a body for this unit.
1455                                  --  If there is no spec, we need to check
1456                                  --  that it is not a subunit.
1457
1458                                  if The_Unit_Data.File_Names
1459                                       (Specification).Name = No_Name
1460                                  then
1461                                     declare
1462                                        Src_Ind : Source_File_Index;
1463
1464                                     begin
1465                                        Src_Ind := Sinput.P.Load_Project_File
1466                                                    (Get_Name_String
1467                                                       (The_Unit_Data.File_Names
1468                                                          (Body_Part).Path));
1469
1470                                        if Sinput.P.Source_File_Is_Subunit
1471                                                      (Src_Ind)
1472                                        then
1473                                           Error_Msg
1474                                             (Project,
1475                                              "{ is a subunit; " &
1476                                              "it cannot be an interface",
1477                                              String_Elements.Table
1478                                                (Interfaces).Location);
1479                                        end if;
1480                                     end;
1481                                  end if;
1482
1483                                  --  The unit is not a subunit, so we add
1484                                  --  to the Interface ALIs the ALI file
1485                                  --  corresponding to the body.
1486
1487                                  Add_ALI_For
1488                                    (The_Unit_Data.File_Names (Body_Part).Name);
1489
1490                               else
1491                                  Error_Msg
1492                                    (Project,
1493                                     "{ is not an unit of this project",
1494                                     String_Elements.Table
1495                                       (Interfaces).Location);
1496                               end if;
1497
1498                            elsif The_Unit_Data.File_Names
1499                                    (Com.Specification).Name /= No_Name
1500                               and then The_Unit_Data.File_Names
1501                                          (Com.Specification).Path /= Slash
1502                               and then Check_Project
1503                                          (The_Unit_Data.File_Names
1504                                             (Specification).Project)
1505
1506                            then
1507                               --  The unit is part of the project, it has
1508                               --  a spec, but no body. We add to the Interface
1509                               --  ALIs the ALI file corresponding to the spec.
1510
1511                               Add_ALI_For
1512                                (The_Unit_Data.File_Names (Specification).Name);
1513
1514                            else
1515                               Error_Msg
1516                                 (Project,
1517                                  "{ is not an unit of this project",
1518                                  String_Elements.Table (Interfaces).Location);
1519                            end if;
1520                         end if;
1521
1522                      end if;
1523
1524                      Interfaces := String_Elements.Table (Interfaces).Next;
1525                   end loop;
1526
1527                   --  Put the list of Interface ALIs in the project data
1528
1529                   Data.Lib_Interface_ALIs := Interface_ALIs;
1530
1531                   --  Check value of attribute Library_Auto_Init and set
1532                   --  Lib_Auto_Init accordingly.
1533
1534                   if Lib_Auto_Init.Default then
1535                      --  If no attribute Library_Auto_Init is declared, then
1536                      --  set auto init only if it is supported.
1537
1538                      Data.Lib_Auto_Init := Auto_Init_Supported;
1539
1540                   else
1541                      Get_Name_String (Lib_Auto_Init.Value);
1542                      To_Lower (Name_Buffer (1 .. Name_Len));
1543
1544                      if Name_Buffer (1 .. Name_Len) = "false" then
1545                         Data.Lib_Auto_Init := False;
1546
1547                      elsif Name_Buffer (1 .. Name_Len) = "true" then
1548                         if Auto_Init_Supported then
1549                            Data.Lib_Auto_Init := True;
1550
1551                         else
1552                            --  Library_Auto_Init cannot be "true" if auto init
1553                            --  is not supported
1554
1555                            Error_Msg
1556                              (Project,
1557                               "library auto init not supported " &
1558                               "on this platform",
1559                               Lib_Auto_Init.Location);
1560                         end if;
1561
1562                      else
1563                         Error_Msg
1564                           (Project,
1565                            "invalid value for attribute Library_Auto_Init",
1566                            Lib_Auto_Init.Location);
1567                      end if;
1568                   end if;
1569
1570                   if Lib_Src_Dir.Value /= Empty_String then
1571                      declare
1572                         Dir_Id : constant Name_Id := Lib_Src_Dir.Value;
1573
1574                      begin
1575                         Locate_Directory
1576                           (Dir_Id, Data.Display_Directory,
1577                            Data.Library_Src_Dir,
1578                            Data.Display_Library_Src_Dir);
1579
1580                         --  Comment needed here ???
1581
1582                         if Data.Library_Src_Dir = No_Name then
1583
1584                            --  Get the absolute name of the library directory
1585                            --  that does not exist, to report an error.
1586
1587                            declare
1588                               Dir_Name : constant String :=
1589                                            Get_Name_String (Dir_Id);
1590                            begin
1591                               if Is_Absolute_Path (Dir_Name) then
1592                                  Err_Vars.Error_Msg_Name_1 := Dir_Id;
1593
1594                               else
1595                                  Get_Name_String (Data.Directory);
1596
1597                                  if Name_Buffer (Name_Len) /=
1598                                     Directory_Separator
1599                                  then
1600                                     Name_Len := Name_Len + 1;
1601                                     Name_Buffer (Name_Len) :=
1602                                       Directory_Separator;
1603                                  end if;
1604
1605                                  Name_Buffer
1606                                    (Name_Len + 1 ..
1607                                       Name_Len + Dir_Name'Length) :=
1608                                    Dir_Name;
1609                                  Name_Len := Name_Len + Dir_Name'Length;
1610                                  Err_Vars.Error_Msg_Name_1 := Name_Find;
1611                               end if;
1612
1613                               --  Report the error
1614
1615                               Error_Msg
1616                                 (Project,
1617                                  "Directory { does not exist",
1618                                  Lib_Src_Dir.Location);
1619                            end;
1620
1621                         --  And comment needed here ???
1622
1623                         elsif Data.Library_Src_Dir = Data.Object_Directory then
1624                            Error_Msg
1625                              (Project,
1626                               "directory to copy interfaces cannot be " &
1627                               "the object directory",
1628                               Lib_Src_Dir.Location);
1629                            Data.Library_Src_Dir := No_Name;
1630
1631                         --  And comment needed here ???
1632
1633                         else
1634                            declare
1635                               Src_Dirs : String_List_Id := Data.Source_Dirs;
1636                               Src_Dir : String_Element;
1637                            begin
1638                               while Src_Dirs /= Nil_String loop
1639                                  Src_Dir := String_Elements.Table (Src_Dirs);
1640                                  Src_Dirs := Src_Dir.Next;
1641
1642                                  if Data.Library_Src_Dir = Src_Dir.Value then
1643                                     Error_Msg
1644                                       (Project,
1645                                        "directory to copy interfaces cannot " &
1646                                        "be one of the source directories",
1647                                        Lib_Src_Dir.Location);
1648                                     Data.Library_Src_Dir := No_Name;
1649                                     exit;
1650                                  end if;
1651                               end loop;
1652                            end;
1653
1654                            if Data.Library_Src_Dir /= No_Name
1655                              and then Current_Verbosity = High
1656                            then
1657                               Write_Str ("Directory to copy interfaces =""");
1658                               Write_Str (Get_Name_String (Data.Library_Dir));
1659                               Write_Line ("""");
1660                            end if;
1661                         end if;
1662                      end;
1663                   end if;
1664                end;
1665             end if;
1666          end Standalone_Library;
1667       end if;
1668
1669       --  Put the list of Mains, if any, in the project data
1670
1671       declare
1672          Mains : constant Variable_Value :=
1673                    Prj.Util.Value_Of (Name_Main, Data.Decl.Attributes);
1674
1675       begin
1676          Data.Mains := Mains.Values;
1677
1678          --  If no Mains were specified, and if we are an extending
1679          --  project, inherit the Mains from the project we are extending.
1680
1681          if Mains.Default then
1682             if Data.Extends /= No_Project then
1683                Data.Mains := Projects.Table (Data.Extends).Mains;
1684             end if;
1685
1686          --  In a library project file, Main cannot be specified
1687
1688          elsif Data.Library then
1689             Error_Msg
1690               (Project,
1691                "a library project file cannot have Main specified",
1692                Mains.Location);
1693          end if;
1694       end;
1695
1696       Projects.Table (Project) := Data;
1697
1698       Free_Naming_Exceptions;
1699    end Ada_Check;
1700
1701    -------------------
1702    -- ALI_File_Name --
1703    -------------------
1704
1705    function ALI_File_Name (Source : String) return String is
1706    begin
1707       --  If the source name has an extension, then replace it with
1708       --  the ALI suffix.
1709
1710       for Index in reverse Source'First + 1 .. Source'Last loop
1711          if Source (Index) = '.' then
1712             return Source (Source'First .. Index - 1) & ALI_Suffix;
1713          end if;
1714       end loop;
1715
1716       --  If there is no dot, or if it is the first character, just add the
1717       --  ALI suffix.
1718
1719       return Source & ALI_Suffix;
1720    end ALI_File_Name;
1721
1722    --------------------
1723    -- Check_Ada_Name --
1724    --------------------
1725
1726    procedure Check_Ada_Name
1727      (Name : String;
1728       Unit : out Name_Id)
1729    is
1730       The_Name        : String := Name;
1731       Real_Name       : Name_Id;
1732       Need_Letter     : Boolean := True;
1733       Last_Underscore : Boolean := False;
1734       OK              : Boolean := The_Name'Length > 0;
1735
1736    begin
1737       To_Lower (The_Name);
1738
1739       Name_Len := The_Name'Length;
1740       Name_Buffer (1 .. Name_Len) := The_Name;
1741       Real_Name := Name_Find;
1742
1743       --  Check first that the given name is not an Ada reserved word
1744
1745       if Get_Name_Table_Byte (Real_Name) /= 0
1746         and then Real_Name /= Name_Project
1747         and then Real_Name /= Name_Extends
1748         and then Real_Name /= Name_External
1749       then
1750          Unit := No_Name;
1751
1752          if Current_Verbosity = High then
1753             Write_Str (The_Name);
1754             Write_Line (" is an Ada reserved word.");
1755          end if;
1756
1757          return;
1758       end if;
1759
1760       for Index in The_Name'Range loop
1761          if Need_Letter then
1762
1763             --  We need a letter (at the beginning, and following a dot),
1764             --  but we don't have one.
1765
1766             if Is_Letter (The_Name (Index)) then
1767                Need_Letter := False;
1768
1769             else
1770                OK := False;
1771
1772                if Current_Verbosity = High then
1773                   Write_Int  (Types.Int (Index));
1774                   Write_Str  (": '");
1775                   Write_Char (The_Name (Index));
1776                   Write_Line ("' is not a letter.");
1777                end if;
1778
1779                exit;
1780             end if;
1781
1782          elsif Last_Underscore
1783            and then (The_Name (Index) = '_' or else The_Name (Index) = '.')
1784          then
1785             --  Two underscores are illegal, and a dot cannot follow
1786             --  an underscore.
1787
1788             OK := False;
1789
1790             if Current_Verbosity = High then
1791                Write_Int  (Types.Int (Index));
1792                Write_Str  (": '");
1793                Write_Char (The_Name (Index));
1794                Write_Line ("' is illegal here.");
1795             end if;
1796
1797             exit;
1798
1799          elsif The_Name (Index) = '.' then
1800
1801             --  We need a letter after a dot
1802
1803             Need_Letter := True;
1804
1805          elsif The_Name (Index) = '_' then
1806             Last_Underscore := True;
1807
1808          else
1809             --  We need an letter or a digit
1810
1811             Last_Underscore := False;
1812
1813             if not Is_Alphanumeric (The_Name (Index)) then
1814                OK := False;
1815
1816                if Current_Verbosity = High then
1817                   Write_Int  (Types.Int (Index));
1818                   Write_Str  (": '");
1819                   Write_Char (The_Name (Index));
1820                   Write_Line ("' is not alphanumeric.");
1821                end if;
1822
1823                exit;
1824             end if;
1825          end if;
1826       end loop;
1827
1828       --  Cannot end with an underscore or a dot
1829
1830       OK := OK and then not Need_Letter and then not Last_Underscore;
1831
1832       if OK then
1833          Unit := Real_Name;
1834
1835       else
1836          --  Signal a problem with No_Name
1837
1838          Unit := No_Name;
1839       end if;
1840    end Check_Ada_Name;
1841
1842    -----------------------------
1843    -- Check_Ada_Naming_Scheme --
1844    -----------------------------
1845
1846    procedure Check_Ada_Naming_Scheme
1847      (Project : Project_Id;
1848       Naming  : Naming_Data)
1849    is
1850    begin
1851       --  Only check if we are not using the standard naming scheme
1852
1853       if Naming /= Standard_Naming_Data then
1854          declare
1855             Dot_Replacement       : constant String :=
1856                                      Get_Name_String
1857                                        (Naming.Dot_Replacement);
1858
1859             Spec_Suffix : constant String :=
1860                                      Get_Name_String
1861                                        (Naming.Current_Spec_Suffix);
1862
1863             Body_Suffix : constant String :=
1864                                      Get_Name_String
1865                                        (Naming.Current_Body_Suffix);
1866
1867             Separate_Suffix       : constant String :=
1868                                      Get_Name_String
1869                                        (Naming.Separate_Suffix);
1870
1871          begin
1872             --  Dot_Replacement cannot
1873             --   - be empty
1874             --   - start or end with an alphanumeric
1875             --   - be a single '_'
1876             --   - start with an '_' followed by an alphanumeric
1877             --   - contain a '.' except if it is "."
1878
1879             if Dot_Replacement'Length = 0
1880               or else Is_Alphanumeric
1881                         (Dot_Replacement (Dot_Replacement'First))
1882               or else Is_Alphanumeric
1883                         (Dot_Replacement (Dot_Replacement'Last))
1884               or else (Dot_Replacement (Dot_Replacement'First) = '_'
1885                         and then
1886                         (Dot_Replacement'Length = 1
1887                           or else
1888                            Is_Alphanumeric
1889                              (Dot_Replacement (Dot_Replacement'First + 1))))
1890               or else (Dot_Replacement'Length > 1
1891                          and then
1892                            Index (Source => Dot_Replacement,
1893                                   Pattern => ".") /= 0)
1894             then
1895                Error_Msg
1896                  (Project,
1897                   '"' & Dot_Replacement &
1898                   """ is illegal for Dot_Replacement.",
1899                   Naming.Dot_Repl_Loc);
1900             end if;
1901
1902             --  Suffixes cannot
1903             --   - be empty
1904
1905             if Is_Illegal_Suffix
1906                  (Spec_Suffix, Dot_Replacement = ".")
1907             then
1908                Err_Vars.Error_Msg_Name_1 := Naming.Current_Spec_Suffix;
1909                Error_Msg
1910                  (Project,
1911                   "{ is illegal for Spec_Suffix",
1912                   Naming.Spec_Suffix_Loc);
1913             end if;
1914
1915             if Is_Illegal_Suffix
1916                  (Body_Suffix, Dot_Replacement = ".")
1917             then
1918                Err_Vars.Error_Msg_Name_1 := Naming.Current_Body_Suffix;
1919                Error_Msg
1920                  (Project,
1921                   "{ is illegal for Body_Suffix",
1922                   Naming.Body_Suffix_Loc);
1923             end if;
1924
1925             if Body_Suffix /= Separate_Suffix then
1926                if Is_Illegal_Suffix
1927                     (Separate_Suffix, Dot_Replacement = ".")
1928                then
1929                   Err_Vars.Error_Msg_Name_1 := Naming.Separate_Suffix;
1930                   Error_Msg
1931                     (Project,
1932                      "{ is illegal for Separate_Suffix",
1933                      Naming.Sep_Suffix_Loc);
1934                end if;
1935             end if;
1936
1937             --  Spec_Suffix cannot have the same termination as
1938             --  Body_Suffix or Separate_Suffix
1939
1940             if Spec_Suffix'Length <= Body_Suffix'Length
1941               and then
1942                 Body_Suffix (Body_Suffix'Last -
1943                              Spec_Suffix'Length + 1 ..
1944                              Body_Suffix'Last) = Spec_Suffix
1945             then
1946                Error_Msg
1947                  (Project,
1948                   "Body_Suffix (""" &
1949                   Body_Suffix &
1950                   """) cannot end with" &
1951                   " Spec_Suffix  (""" &
1952                   Spec_Suffix & """).",
1953                   Naming.Body_Suffix_Loc);
1954             end if;
1955
1956             if Body_Suffix /= Separate_Suffix
1957               and then Spec_Suffix'Length <= Separate_Suffix'Length
1958               and then
1959                 Separate_Suffix
1960                   (Separate_Suffix'Last - Spec_Suffix'Length + 1
1961                     ..
1962                    Separate_Suffix'Last) = Spec_Suffix
1963             then
1964                Error_Msg
1965                  (Project,
1966                   "Separate_Suffix (""" &
1967                   Separate_Suffix &
1968                   """) cannot end with" &
1969                   " Spec_Suffix (""" &
1970                   Spec_Suffix & """).",
1971                   Naming.Sep_Suffix_Loc);
1972             end if;
1973          end;
1974       end if;
1975    end Check_Ada_Naming_Scheme;
1976
1977    ---------------
1978    -- Error_Msg --
1979    ---------------
1980
1981    procedure Error_Msg
1982      (Project       : Project_Id;
1983       Msg           : String;
1984       Flag_Location : Source_Ptr)
1985    is
1986       Error_Buffer : String (1 .. 5_000);
1987       Error_Last   : Natural := 0;
1988       Msg_Name     : Natural := 0;
1989       First        : Positive := Msg'First;
1990
1991       procedure Add (C : Character);
1992       --  Add a character to the buffer
1993
1994       procedure Add (S : String);
1995       --  Add a string to the buffer
1996
1997       procedure Add (Id : Name_Id);
1998       --  Add a name to the buffer
1999
2000       ---------
2001       -- Add --
2002       ---------
2003
2004       procedure Add (C : Character) is
2005       begin
2006          Error_Last := Error_Last + 1;
2007          Error_Buffer (Error_Last) := C;
2008       end Add;
2009
2010       procedure Add (S : String) is
2011       begin
2012          Error_Buffer (Error_Last + 1 .. Error_Last + S'Length) := S;
2013          Error_Last := Error_Last + S'Length;
2014       end Add;
2015
2016       procedure Add (Id : Name_Id) is
2017       begin
2018          Get_Name_String (Id);
2019          Add (Name_Buffer (1 .. Name_Len));
2020       end Add;
2021
2022    --  Start of processing for Error_Msg
2023
2024    begin
2025       if Error_Report = null then
2026          Prj.Err.Error_Msg (Msg, Flag_Location);
2027          return;
2028       end if;
2029
2030       if Msg (First) = '\' then
2031
2032          --  Continuation character, ignore.
2033
2034          First := First + 1;
2035
2036       elsif Msg (First) = '?' then
2037
2038          --  Warning character. It is always the first one in this package
2039
2040          First := First + 1;
2041          Add ("Warning: ");
2042       end if;
2043
2044       for Index in First .. Msg'Last loop
2045          if Msg (Index) = '{' or else Msg (Index) = '%' then
2046
2047             --  Include a name between double quotes.
2048
2049             Msg_Name := Msg_Name + 1;
2050             Add ('"');
2051
2052             case Msg_Name is
2053                when 1 => Add (Err_Vars.Error_Msg_Name_1);
2054                when 2 => Add (Err_Vars.Error_Msg_Name_2);
2055                when 3 => Add (Err_Vars.Error_Msg_Name_3);
2056
2057                when others => null;
2058             end case;
2059
2060             Add ('"');
2061
2062          else
2063             Add (Msg (Index));
2064          end if;
2065
2066       end loop;
2067
2068       Error_Report (Error_Buffer (1 .. Error_Last), Project);
2069    end Error_Msg;
2070
2071    --------------
2072    -- Get_Unit --
2073    --------------
2074
2075    procedure Get_Unit
2076      (Canonical_File_Name : Name_Id;
2077       Naming              : Naming_Data;
2078       Unit_Name           : out Name_Id;
2079       Unit_Kind           : out Spec_Or_Body;
2080       Needs_Pragma        : out Boolean)
2081    is
2082       function Check_Exception (Canonical : Name_Id) return Boolean;
2083       pragma Inline (Check_Exception);
2084       --  Check if Canonical is one of the exceptions in List.
2085       --  Returns True if Get_Unit should exit
2086
2087       ---------------------
2088       -- Check_Exception --
2089       ---------------------
2090
2091       function Check_Exception (Canonical : Name_Id) return Boolean is
2092          Info     : Unit_Info := Naming_Exceptions.Get (Canonical);
2093          VMS_Name : Name_Id;
2094
2095       begin
2096          if Info = No_Unit then
2097             if Hostparm.OpenVMS then
2098                VMS_Name := Canonical;
2099                Get_Name_String (VMS_Name);
2100
2101                if Name_Buffer (Name_Len) = '.' then
2102                   Name_Len := Name_Len - 1;
2103                   VMS_Name := Name_Find;
2104                end if;
2105
2106                Info := Naming_Exceptions.Get (VMS_Name);
2107             end if;
2108
2109             if Info = No_Unit then
2110                return False;
2111             end if;
2112          end if;
2113
2114          Unit_Kind := Info.Kind;
2115          Unit_Name := Info.Unit;
2116          Needs_Pragma := True;
2117          return True;
2118       end Check_Exception;
2119
2120    --  Start of processing for Get_Unit
2121
2122    begin
2123       Needs_Pragma := False;
2124
2125       if Check_Exception (Canonical_File_Name) then
2126          return;
2127       end if;
2128
2129       Get_Name_String (Canonical_File_Name);
2130
2131       declare
2132          File          : String := Name_Buffer (1 .. Name_Len);
2133          First         : constant Positive := File'First;
2134          Last          : Natural           := File'Last;
2135          Standard_GNAT : Boolean;
2136
2137       begin
2138          Standard_GNAT :=
2139            Naming.Current_Spec_Suffix = Default_Ada_Spec_Suffix
2140              and then Naming.Current_Body_Suffix = Default_Ada_Body_Suffix;
2141
2142          --  Check if the end of the file name is Specification_Append
2143
2144          Get_Name_String (Naming.Current_Spec_Suffix);
2145
2146          if File'Length > Name_Len
2147            and then File (Last - Name_Len + 1 .. Last) =
2148                                                 Name_Buffer (1 .. Name_Len)
2149          then
2150             --  We have a spec
2151
2152             Unit_Kind := Specification;
2153             Last := Last - Name_Len;
2154
2155             if Current_Verbosity = High then
2156                Write_Str  ("   Specification: ");
2157                Write_Line (File (First .. Last));
2158             end if;
2159
2160          else
2161             Get_Name_String (Naming.Current_Body_Suffix);
2162
2163             --  Check if the end of the file name is Body_Append
2164
2165             if File'Length > Name_Len
2166               and then File (Last - Name_Len + 1 .. Last) =
2167                                                 Name_Buffer (1 .. Name_Len)
2168             then
2169                --  We have a body
2170
2171                Unit_Kind := Body_Part;
2172                Last := Last - Name_Len;
2173
2174                if Current_Verbosity = High then
2175                   Write_Str  ("   Body: ");
2176                   Write_Line (File (First .. Last));
2177                end if;
2178
2179             elsif Naming.Separate_Suffix /= Naming.Current_Spec_Suffix then
2180                Get_Name_String (Naming.Separate_Suffix);
2181
2182                --  Check if the end of the file name is Separate_Append
2183
2184                if File'Length > Name_Len
2185                  and then File (Last - Name_Len + 1 .. Last) =
2186                                                 Name_Buffer (1 .. Name_Len)
2187                then
2188                   --  We have a separate (a body)
2189
2190                   Unit_Kind := Body_Part;
2191                   Last := Last - Name_Len;
2192
2193                   if Current_Verbosity = High then
2194                      Write_Str  ("   Separate: ");
2195                      Write_Line (File (First .. Last));
2196                   end if;
2197
2198                else
2199                   Last := 0;
2200                end if;
2201
2202             else
2203                Last := 0;
2204             end if;
2205          end if;
2206
2207          if Last = 0 then
2208
2209             --  This is not a source file
2210
2211             Unit_Name := No_Name;
2212             Unit_Kind := Specification;
2213
2214             if Current_Verbosity = High then
2215                Write_Line ("   Not a valid file name.");
2216             end if;
2217
2218             return;
2219          end if;
2220
2221          Get_Name_String (Naming.Dot_Replacement);
2222          Standard_GNAT :=
2223            Standard_GNAT and then Name_Buffer (1 .. Name_Len) = "-";
2224
2225          if Name_Buffer (1 .. Name_Len) /= "." then
2226
2227             --  If Dot_Replacement is not a single dot,
2228             --  then there should not be any dot in the name.
2229
2230             for Index in First .. Last loop
2231                if File (Index) = '.' then
2232                   if Current_Verbosity = High then
2233                      Write_Line
2234                        ("   Not a valid file name (some dot not replaced).");
2235                   end if;
2236
2237                   Unit_Name := No_Name;
2238                   return;
2239
2240                end if;
2241             end loop;
2242
2243             --  Replace the substring Dot_Replacement with dots
2244
2245             declare
2246                Index : Positive := First;
2247
2248             begin
2249                while Index <= Last - Name_Len + 1 loop
2250
2251                   if File (Index .. Index + Name_Len - 1) =
2252                     Name_Buffer (1 .. Name_Len)
2253                   then
2254                      File (Index) := '.';
2255
2256                      if Name_Len > 1 and then Index < Last then
2257                         File (Index + 1 .. Last - Name_Len + 1) :=
2258                           File (Index + Name_Len .. Last);
2259                      end if;
2260
2261                      Last := Last - Name_Len + 1;
2262                   end if;
2263
2264                   Index := Index + 1;
2265                end loop;
2266             end;
2267          end if;
2268
2269          --  Check if the casing is right
2270
2271          declare
2272             Src : String := File (First .. Last);
2273
2274          begin
2275             case Naming.Casing is
2276                when All_Lower_Case =>
2277                   Fixed.Translate
2278                     (Source  => Src,
2279                      Mapping => Lower_Case_Map);
2280
2281                when All_Upper_Case =>
2282                   Fixed.Translate
2283                     (Source  => Src,
2284                      Mapping => Upper_Case_Map);
2285
2286                when Mixed_Case | Unknown =>
2287                   null;
2288             end case;
2289
2290             if Src /= File (First .. Last) then
2291                if Current_Verbosity = High then
2292                   Write_Line ("   Not a valid file name (casing).");
2293                end if;
2294
2295                Unit_Name := No_Name;
2296                return;
2297             end if;
2298
2299             --  We put the name in lower case
2300
2301             Fixed.Translate
2302               (Source  => Src,
2303                Mapping => Lower_Case_Map);
2304
2305             --  In the standard GNAT naming scheme, check for special cases:
2306             --  children or separates of A, G, I or S, and run time sources.
2307
2308             if Standard_GNAT and then Src'Length >= 3 then
2309                declare
2310                   S1 : constant Character := Src (Src'First);
2311                   S2 : constant Character := Src (Src'First + 1);
2312
2313                begin
2314                   if S1 = 'a' or else S1 = 'g'
2315                     or else S1 = 'i' or else S1 = 's'
2316                   then
2317                      --  Children or separates of packages A, G, I or S
2318
2319                      if (Hostparm.OpenVMS and then S2 = '$')
2320                        or else (not Hostparm.OpenVMS and then S2 = '~')
2321                      then
2322                         Src (Src'First + 1) := '.';
2323
2324                      --  If it is potentially a run time source, disable
2325                      --  filling of the mapping file to avoid warnings.
2326
2327                      elsif S2 = '.' then
2328                         Set_Mapping_File_Initial_State_To_Empty;
2329                      end if;
2330
2331                   end if;
2332                end;
2333             end if;
2334
2335             if Current_Verbosity = High then
2336                Write_Str  ("      ");
2337                Write_Line (Src);
2338             end if;
2339
2340             --  Now, we check if this name is a valid unit name
2341
2342             Check_Ada_Name (Name => Src, Unit => Unit_Name);
2343          end;
2344
2345       end;
2346    end Get_Unit;
2347
2348    -----------------------
2349    -- Is_Illegal_Suffix --
2350    -----------------------
2351
2352    function Is_Illegal_Suffix
2353      (Suffix                          : String;
2354       Dot_Replacement_Is_A_Single_Dot : Boolean)
2355       return                            Boolean
2356    is
2357    begin
2358       if Suffix'Length = 0 or else Index (Suffix, ".") = 0 then
2359          return True;
2360       end if;
2361
2362       --  If dot replacement is a single dot, and first character of
2363       --  suffix is also a dot
2364
2365       if Dot_Replacement_Is_A_Single_Dot
2366         and then Suffix (Suffix'First) = '.'
2367       then
2368          for Index in Suffix'First + 1 .. Suffix'Last loop
2369
2370             --  If there is another dot
2371
2372             if Suffix (Index) = '.' then
2373
2374                --  It is illegal to have a letter following the initial dot
2375
2376                return Is_Letter (Suffix (Suffix'First + 1));
2377             end if;
2378          end loop;
2379       end if;
2380
2381       --  Everything is OK
2382
2383       return False;
2384    end Is_Illegal_Suffix;
2385
2386    --------------------------------
2387    -- Language_Independent_Check --
2388    --------------------------------
2389
2390    procedure Language_Independent_Check
2391      (Project      : Project_Id;
2392       Report_Error : Put_Line_Access)
2393    is
2394       Last_Source_Dir : String_List_Id  := Nil_String;
2395       Data            : Project_Data    := Projects.Table (Project);
2396
2397       procedure Find_Source_Dirs (From : Name_Id; Location : Source_Ptr);
2398       --  Find one or several source directories, and add them
2399       --  to the list of source directories of the project.
2400
2401       ----------------------
2402       -- Find_Source_Dirs --
2403       ----------------------
2404
2405       procedure Find_Source_Dirs (From : Name_Id; Location : Source_Ptr) is
2406          Directory    : constant String := Get_Name_String (From);
2407          Canonical_Directory_Id : Name_Id;
2408          Element      : String_Element;
2409
2410          procedure Recursive_Find_Dirs (Path : Name_Id);
2411          --  Find all the subdirectories (recursively) of Path
2412          --  and add them to the list of source directories
2413          --  of the project.
2414
2415          -------------------------
2416          -- Recursive_Find_Dirs --
2417          -------------------------
2418
2419          procedure Recursive_Find_Dirs (Path : Name_Id) is
2420             Dir      : Dir_Type;
2421             Name     : String (1 .. 250);
2422             Last     : Natural;
2423             List     : String_List_Id := Data.Source_Dirs;
2424             Element  : String_Element;
2425             Found    : Boolean := False;
2426
2427             Canonical_Path : Name_Id := No_Name;
2428
2429          begin
2430             Get_Name_String (Path);
2431             Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2432
2433             declare
2434                The_Path : String :=
2435                             Normalize_Pathname
2436                               (Name => Name_Buffer (1 .. Name_Len)) &
2437                             Directory_Separator;
2438                The_Path_Last : constant Natural :=
2439                                  Compute_Directory_Last (The_Path);
2440             begin
2441                Name_Len := The_Path_Last - The_Path'First + 1;
2442                Name_Buffer (1 .. Name_Len) :=
2443                  The_Path (The_Path'First .. The_Path_Last);
2444                Canonical_Path := Name_Find;
2445
2446                --  To avoid processing the same directory several times, check
2447                --  if the directory is already in Recursive_Dirs. If it is,
2448                --  then there is nothing to do, just return. If it is not, put
2449                --  it there and continue recursive processing.
2450
2451                if Recursive_Dirs.Get (Canonical_Path) then
2452                   return;
2453
2454                else
2455                   Recursive_Dirs.Set (Canonical_Path, True);
2456                end if;
2457
2458                --  Check if directory is already in list
2459
2460                while List /= Nil_String loop
2461                   Element := String_Elements.Table (List);
2462
2463                   if Element.Value /= No_Name then
2464                      Get_Name_String (Element.Value);
2465                      Found :=
2466                        The_Path (The_Path'First .. The_Path_Last) =
2467                        Name_Buffer (1 .. Name_Len);
2468                      exit when Found;
2469                   end if;
2470
2471                   List := Element.Next;
2472                end loop;
2473
2474                --  If directory is not already in list, put it there
2475
2476                if not Found then
2477                   if Current_Verbosity = High then
2478                      Write_Str  ("   ");
2479                      Write_Line (The_Path (The_Path'First .. The_Path_Last));
2480                   end if;
2481
2482                   String_Elements.Increment_Last;
2483                   Element :=
2484                     (Value    => Canonical_Path,
2485                      Display_Value => No_Name,
2486                      Location => No_Location,
2487                      Flag     => False,
2488                      Next     => Nil_String);
2489
2490                   --  Case of first source directory
2491
2492                   if Last_Source_Dir = Nil_String then
2493                      Data.Source_Dirs := String_Elements.Last;
2494
2495                      --  Here we already have source directories.
2496
2497                   else
2498                      --  Link the previous last to the new one
2499
2500                      String_Elements.Table (Last_Source_Dir).Next :=
2501                        String_Elements.Last;
2502                   end if;
2503
2504                   --  And register this source directory as the new last
2505
2506                   Last_Source_Dir  := String_Elements.Last;
2507                   String_Elements.Table (Last_Source_Dir) := Element;
2508                end if;
2509
2510                --  Now look for subdirectories. We do that even when this
2511                --  directory is already in the list, because some of its
2512                --  subdirectories may not be in the list yet.
2513
2514                Open (Dir, The_Path (The_Path'First .. The_Path_Last));
2515
2516                loop
2517                   Read (Dir, Name, Last);
2518                   exit when Last = 0;
2519
2520                   if Name (1 .. Last) /= "."
2521                     and then Name (1 .. Last) /= ".."
2522                   then
2523                      --  Avoid . and ..
2524
2525                      if Current_Verbosity = High then
2526                         Write_Str  ("   Checking ");
2527                         Write_Line (Name (1 .. Last));
2528                      end if;
2529
2530                      declare
2531                         Path_Name : String :=
2532                                       Normalize_Pathname
2533                                         (Name      => Name (1 .. Last),
2534                                          Directory =>
2535                                            The_Path
2536                                             (The_Path'First .. The_Path_Last));
2537
2538                      begin
2539                         Canonical_Case_File_Name (Path_Name);
2540
2541                         if Is_Directory (Path_Name) then
2542
2543                            --  We have found a new subdirectory, call self
2544
2545                            Name_Len := Path_Name'Length;
2546                            Name_Buffer (1 .. Name_Len) := Path_Name;
2547                            Recursive_Find_Dirs (Name_Find);
2548                         end if;
2549                      end;
2550                   end if;
2551                end loop;
2552
2553                Close (Dir);
2554             end;
2555
2556          exception
2557             when Directory_Error =>
2558                null;
2559          end Recursive_Find_Dirs;
2560
2561       --  Start of processing for Find_Source_Dirs
2562
2563       begin
2564          if Current_Verbosity = High then
2565             Write_Str ("Find_Source_Dirs (""");
2566          end if;
2567
2568          Get_Name_String (From);
2569          Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2570          --  Directory    := Name_Buffer (1 .. Name_Len);
2571          Canonical_Directory_Id := Name_Find;
2572
2573          if Current_Verbosity = High then
2574             Write_Str (Directory);
2575             Write_Line (""")");
2576          end if;
2577
2578          --  First, check if we are looking for a directory tree,
2579          --  indicated by "/**" at the end.
2580
2581          if Directory'Length >= 3
2582            and then Directory (Directory'Last - 1 .. Directory'Last) = "**"
2583            and then (Directory (Directory'Last - 2) = '/'
2584                        or else
2585                      Directory (Directory'Last - 2) = Directory_Separator)
2586          then
2587             Data.Known_Order_Of_Source_Dirs := False;
2588
2589             Name_Len := Directory'Length - 3;
2590
2591             if Name_Len = 0 then
2592
2593                --  This is the case of "/**": all directories
2594                --  in the file system.
2595
2596                Name_Len := 1;
2597                Name_Buffer (1) := Directory (Directory'First);
2598
2599             else
2600                Name_Buffer (1 .. Name_Len) :=
2601                  Directory (Directory'First .. Directory'Last - 3);
2602             end if;
2603
2604             if Current_Verbosity = High then
2605                Write_Str ("Looking for all subdirectories of """);
2606                Write_Str (Name_Buffer (1 .. Name_Len));
2607                Write_Line ("""");
2608             end if;
2609
2610             declare
2611                Base_Dir : constant Name_Id := Name_Find;
2612                Root_Dir : constant String :=
2613                             Normalize_Pathname
2614                               (Name      => Get_Name_String (Base_Dir),
2615                                Directory =>
2616                                  Get_Name_String (Data.Display_Directory));
2617
2618             begin
2619                if Root_Dir'Length = 0 then
2620                   Err_Vars.Error_Msg_Name_1 := Base_Dir;
2621
2622                   if Location = No_Location then
2623                      Error_Msg
2624                        (Project,
2625                         "{ is not a valid directory.",
2626                         Data.Location);
2627                   else
2628                      Error_Msg
2629                        (Project,
2630                         "{ is not a valid directory.",
2631                         Location);
2632                   end if;
2633
2634                else
2635                   --  We have an existing directory,
2636                   --  we register it and all of its subdirectories.
2637
2638                   if Current_Verbosity = High then
2639                      Write_Line ("Looking for source directories:");
2640                   end if;
2641
2642                   Name_Len := Root_Dir'Length;
2643                   Name_Buffer (1 .. Name_Len) := Root_Dir;
2644                   Recursive_Find_Dirs (Name_Find);
2645
2646                   if Current_Verbosity = High then
2647                      Write_Line ("End of looking for source directories.");
2648                   end if;
2649                end if;
2650             end;
2651
2652          --  We have a single directory
2653
2654          else
2655             declare
2656                Path_Name : Name_Id;
2657                Display_Path_Name : Name_Id;
2658             begin
2659                Locate_Directory
2660                  (From, Data.Display_Directory, Path_Name, Display_Path_Name);
2661                if Path_Name = No_Name then
2662                   Err_Vars.Error_Msg_Name_1 := From;
2663
2664                   if Location = No_Location then
2665                      Error_Msg
2666                        (Project,
2667                         "{ is not a valid directory",
2668                         Data.Location);
2669                   else
2670                      Error_Msg
2671                        (Project,
2672                         "{ is not a valid directory",
2673                         Location);
2674                   end if;
2675                else
2676
2677                   --  As it is an existing directory, we add it to
2678                   --  the list of directories.
2679
2680                   String_Elements.Increment_Last;
2681                   Element.Value := Path_Name;
2682                   Element.Display_Value := Display_Path_Name;
2683
2684                   if Last_Source_Dir = Nil_String then
2685
2686                      --  This is the first source directory
2687
2688                      Data.Source_Dirs := String_Elements.Last;
2689
2690                   else
2691                      --  We already have source directories,
2692                      --  link the previous last to the new one.
2693
2694                      String_Elements.Table (Last_Source_Dir).Next :=
2695                        String_Elements.Last;
2696                   end if;
2697
2698                   --  And register this source directory as the new last
2699
2700                   Last_Source_Dir := String_Elements.Last;
2701                   String_Elements.Table (Last_Source_Dir) := Element;
2702                end if;
2703             end;
2704          end if;
2705       end Find_Source_Dirs;
2706
2707    --  Start of processing for Language_Independent_Check
2708
2709    begin
2710       if Data.Language_Independent_Checked then
2711          return;
2712       end if;
2713
2714       Data.Language_Independent_Checked := True;
2715
2716       Error_Report := Report_Error;
2717
2718       Recursive_Dirs.Reset;
2719
2720       if Current_Verbosity = High then
2721          Write_Line ("Starting to look for directories");
2722       end if;
2723
2724       --  Check the object directory
2725
2726       declare
2727          Object_Dir : constant Variable_Value :=
2728                         Util.Value_Of (Name_Object_Dir, Data.Decl.Attributes);
2729
2730       begin
2731          pragma Assert (Object_Dir.Kind = Single,
2732                         "Object_Dir is not a single string");
2733
2734          --  We set the object directory to its default
2735
2736          Data.Object_Directory   := Data.Directory;
2737          Data.Display_Object_Dir := Data.Display_Directory;
2738
2739          if Object_Dir.Value /= Empty_String then
2740
2741             Get_Name_String (Object_Dir.Value);
2742
2743             if Name_Len = 0 then
2744                Error_Msg
2745                  (Project,
2746                   "Object_Dir cannot be empty",
2747                   Object_Dir.Location);
2748
2749             else
2750                --  We check that the specified object directory
2751                --  does exist.
2752
2753                Locate_Directory
2754                  (Object_Dir.Value, Data.Display_Directory,
2755                   Data.Object_Directory, Data.Display_Object_Dir);
2756
2757                if Data.Object_Directory = No_Name then
2758                   --  The object directory does not exist, report an error
2759                   Err_Vars.Error_Msg_Name_1 := Object_Dir.Value;
2760                   Error_Msg
2761                     (Project,
2762                      "the object directory { cannot be found",
2763                      Data.Location);
2764
2765                   --  Do not keep a nil Object_Directory. Set it to the
2766                   --  specified (relative or absolute) path.
2767                   --  This is for the benefit of tools that recover from
2768                   --  errors; for example, these tools could create the
2769                   --  non existent directory.
2770
2771                   Data.Display_Object_Dir := Object_Dir.Value;
2772                   Get_Name_String (Object_Dir.Value);
2773                   Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2774                   Data.Object_Directory := Name_Find;
2775                end if;
2776             end if;
2777          end if;
2778       end;
2779
2780       if Current_Verbosity = High then
2781          if Data.Object_Directory = No_Name then
2782             Write_Line ("No object directory");
2783          else
2784             Write_Str ("Object directory: """);
2785             Write_Str (Get_Name_String (Data.Display_Object_Dir));
2786             Write_Line ("""");
2787          end if;
2788       end if;
2789
2790       --  Check the exec directory
2791
2792       declare
2793          Exec_Dir : constant Variable_Value :=
2794                       Util.Value_Of (Name_Exec_Dir, Data.Decl.Attributes);
2795
2796       begin
2797          pragma Assert (Exec_Dir.Kind = Single,
2798                         "Exec_Dir is not a single string");
2799
2800          --  We set the object directory to its default
2801
2802          Data.Exec_Directory   := Data.Object_Directory;
2803          Data.Display_Exec_Dir := Data.Display_Object_Dir;
2804
2805          if Exec_Dir.Value /= Empty_String then
2806
2807             Get_Name_String (Exec_Dir.Value);
2808
2809             if Name_Len = 0 then
2810                Error_Msg
2811                  (Project,
2812                   "Exec_Dir cannot be empty",
2813                   Exec_Dir.Location);
2814
2815             else
2816                --  We check that the specified object directory
2817                --  does exist.
2818
2819                Locate_Directory
2820                  (Exec_Dir.Value, Data.Directory,
2821                   Data.Exec_Directory, Data.Display_Exec_Dir);
2822
2823                if Data.Exec_Directory = No_Name then
2824                   Err_Vars.Error_Msg_Name_1 := Exec_Dir.Value;
2825                   Error_Msg
2826                     (Project,
2827                      "the exec directory { cannot be found",
2828                      Data.Location);
2829                end if;
2830             end if;
2831          end if;
2832       end;
2833
2834       if Current_Verbosity = High then
2835          if Data.Exec_Directory = No_Name then
2836             Write_Line ("No exec directory");
2837          else
2838             Write_Str ("Exec directory: """);
2839             Write_Str (Get_Name_String (Data.Display_Exec_Dir));
2840             Write_Line ("""");
2841          end if;
2842       end if;
2843
2844       --  Look for the source directories
2845
2846       declare
2847          Source_Dirs : constant Variable_Value :=
2848                          Util.Value_Of
2849                            (Name_Source_Dirs, Data.Decl.Attributes);
2850
2851       begin
2852          if Current_Verbosity = High then
2853             Write_Line ("Starting to look for source directories");
2854          end if;
2855
2856          pragma Assert (Source_Dirs.Kind = List,
2857                           "Source_Dirs is not a list");
2858
2859          if Source_Dirs.Default then
2860
2861             --  No Source_Dirs specified: the single source directory
2862             --  is the one containing the project file
2863
2864             String_Elements.Increment_Last;
2865             Data.Source_Dirs := String_Elements.Last;
2866             String_Elements.Table (Data.Source_Dirs) :=
2867               (Value    => Data.Directory,
2868                Display_Value => Data.Display_Directory,
2869                Location => No_Location,
2870                Flag     => False,
2871                Next     => Nil_String);
2872
2873             if Current_Verbosity = High then
2874                Write_Line ("Single source directory:");
2875                Write_Str ("    """);
2876                Write_Str (Get_Name_String (Data.Display_Directory));
2877                Write_Line ("""");
2878             end if;
2879
2880          elsif Source_Dirs.Values = Nil_String then
2881
2882             --  If Source_Dirs is an empty string list, this means
2883             --  that this project contains no source. For projects that
2884             --  don't extend other projects, this also means that there is no
2885             --  need for an object directory, if not specified.
2886
2887             if Data.Extends = No_Project
2888               and then  Data.Object_Directory = Data.Directory
2889             then
2890                Data.Object_Directory := No_Name;
2891             end if;
2892
2893             Data.Source_Dirs     := Nil_String;
2894             Data.Sources_Present := False;
2895
2896          else
2897             declare
2898                Source_Dir : String_List_Id := Source_Dirs.Values;
2899                Element    : String_Element;
2900
2901             begin
2902                --  We will find the source directories for each
2903                --  element of the list
2904
2905                while Source_Dir /= Nil_String loop
2906                   Element := String_Elements.Table (Source_Dir);
2907                   Find_Source_Dirs (Element.Value, Element.Location);
2908                   Source_Dir := Element.Next;
2909                end loop;
2910             end;
2911          end if;
2912
2913          if Current_Verbosity = High then
2914             Write_Line ("Putting source directories in canonical cases");
2915          end if;
2916
2917          declare
2918             Current : String_List_Id := Data.Source_Dirs;
2919             Element : String_Element;
2920
2921          begin
2922             while Current /= Nil_String loop
2923                Element := String_Elements.Table (Current);
2924                if Element.Value /= No_Name then
2925                   Element.Display_Value := Element.Value;
2926                   Get_Name_String (Element.Value);
2927                   Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2928                   Element.Value := Name_Find;
2929                   String_Elements.Table (Current) := Element;
2930                end if;
2931
2932                Current := Element.Next;
2933             end loop;
2934          end;
2935       end;
2936
2937       --  Library attributes
2938
2939       declare
2940          Attributes : constant Prj.Variable_Id := Data.Decl.Attributes;
2941
2942          Lib_Dir : constant Prj.Variable_Value :=
2943                      Prj.Util.Value_Of (Snames.Name_Library_Dir, Attributes);
2944
2945          Lib_Name : constant Prj.Variable_Value :=
2946                       Prj.Util.Value_Of (Snames.Name_Library_Name, Attributes);
2947
2948          Lib_Version : constant Prj.Variable_Value :=
2949                          Prj.Util.Value_Of
2950                            (Snames.Name_Library_Version, Attributes);
2951
2952          The_Lib_Kind : constant Prj.Variable_Value :=
2953                           Prj.Util.Value_Of
2954                             (Snames.Name_Library_Kind, Attributes);
2955
2956       begin
2957          --  Special case of extending project
2958
2959          if Data.Extends /= No_Project then
2960             declare
2961                Extended_Data : constant Project_Data :=
2962                  Projects.Table (Data.Extends);
2963
2964             begin
2965                --  If the project extended is a library project, we inherit
2966                --  the library name, if it is not redefined; we check that
2967                --  the library directory is specified; and we reset the
2968                --  library flag for the extended project.
2969
2970                if Extended_Data.Library then
2971                   if Lib_Name.Default then
2972                      Data.Library_Name := Extended_Data.Library_Name;
2973                   end if;
2974
2975                   if Lib_Dir.Default then
2976                      Error_Msg
2977                        (Project,
2978                         "a project extending a library project must specify " &
2979                           "an attribute Library_Dir",
2980                         Data.Location);
2981                   end if;
2982
2983                   Projects.Table (Data.Extends).Library := False;
2984                end if;
2985             end;
2986          end if;
2987
2988          pragma Assert (Lib_Dir.Kind = Single);
2989
2990          if Lib_Dir.Value = Empty_String then
2991
2992             if Current_Verbosity = High then
2993                Write_Line ("No library directory");
2994             end if;
2995
2996          else
2997             --  Find path name, check that it is a directory
2998
2999             Locate_Directory
3000               (Lib_Dir.Value, Data.Display_Directory,
3001                Data.Library_Dir, Data.Display_Library_Dir);
3002
3003             if Data.Library_Dir = No_Name then
3004                --  Get the absolute name of the library directory that
3005                --  does not exist, to report an error.
3006
3007                declare
3008                   Dir_Name : constant String :=
3009                     Get_Name_String (Lib_Dir.Value);
3010                begin
3011                   if Is_Absolute_Path (Dir_Name) then
3012                      Err_Vars.Error_Msg_Name_1 := Lib_Dir.Value;
3013
3014                   else
3015                      Get_Name_String (Data.Display_Directory);
3016
3017                      if Name_Buffer (Name_Len) /= Directory_Separator then
3018                         Name_Len := Name_Len + 1;
3019                         Name_Buffer (Name_Len) := Directory_Separator;
3020                      end if;
3021
3022                      Name_Buffer
3023                        (Name_Len + 1 .. Name_Len + Dir_Name'Length) :=
3024                        Dir_Name;
3025                      Name_Len := Name_Len + Dir_Name'Length;
3026                      Err_Vars.Error_Msg_Name_1 := Name_Find;
3027                   end if;
3028
3029                   --  Report the error
3030
3031                   Error_Msg
3032                     (Project,
3033                      "library directory { does not exist",
3034                      Lib_Dir.Location);
3035                end;
3036
3037             elsif Data.Library_Dir = Data.Object_Directory then
3038                Error_Msg
3039                  (Project,
3040                   "library directory cannot be the same " &
3041                   "as object directory",
3042                   Lib_Dir.Location);
3043                Data.Library_Dir := No_Name;
3044                Data.Display_Library_Dir := No_Name;
3045
3046             else
3047                if Current_Verbosity = High then
3048                   Write_Str ("Library directory =""");
3049                   Write_Str (Get_Name_String (Data.Display_Library_Dir));
3050                   Write_Line ("""");
3051                end if;
3052             end if;
3053          end if;
3054
3055          pragma Assert (Lib_Name.Kind = Single);
3056
3057          if Lib_Name.Value = Empty_String then
3058             if Current_Verbosity = High
3059               and then Data.Library_Name = No_Name
3060             then
3061                Write_Line ("No library name");
3062             end if;
3063
3064          else
3065             --  There is no restriction on the syntax of library names
3066
3067             Data.Library_Name := Lib_Name.Value;
3068          end if;
3069
3070          if Data.Library_Name /= No_Name
3071            and then Current_Verbosity = High
3072          then
3073             Write_Str ("Library name = """);
3074             Write_Str (Get_Name_String (Data.Library_Name));
3075             Write_Line ("""");
3076          end if;
3077
3078          Data.Library :=
3079            Data.Library_Dir /= No_Name
3080              and then
3081            Data.Library_Name /= No_Name;
3082
3083          if Data.Library then
3084             if MLib.Tgt.Support_For_Libraries = MLib.Tgt.None then
3085                Error_Msg
3086                  (Project,
3087                   "?libraries are not supported on this platform",
3088                   Lib_Name.Location);
3089                Data.Library := False;
3090
3091             else
3092                pragma Assert (Lib_Version.Kind = Single);
3093
3094                if Lib_Version.Value = Empty_String then
3095                   if Current_Verbosity = High then
3096                      Write_Line ("No library version specified");
3097                   end if;
3098
3099                else
3100                   Data.Lib_Internal_Name := Lib_Version.Value;
3101                end if;
3102
3103                pragma Assert (The_Lib_Kind.Kind = Single);
3104
3105                if The_Lib_Kind.Value = Empty_String then
3106                   if Current_Verbosity = High then
3107                      Write_Line ("No library kind specified");
3108                   end if;
3109
3110                else
3111                   Get_Name_String (The_Lib_Kind.Value);
3112
3113                   declare
3114                      Kind_Name : constant String :=
3115                                    To_Lower (Name_Buffer (1 .. Name_Len));
3116
3117                      OK : Boolean := True;
3118
3119                   begin
3120                      if Kind_Name = "static" then
3121                         Data.Library_Kind := Static;
3122
3123                      elsif Kind_Name = "dynamic" then
3124                         Data.Library_Kind := Dynamic;
3125
3126                      elsif Kind_Name = "relocatable" then
3127                         Data.Library_Kind := Relocatable;
3128
3129                      else
3130                         Error_Msg
3131                           (Project,
3132                            "illegal value for Library_Kind",
3133                            The_Lib_Kind.Location);
3134                         OK := False;
3135                      end if;
3136
3137                      if Current_Verbosity = High and then OK then
3138                         Write_Str ("Library kind = ");
3139                         Write_Line (Kind_Name);
3140                      end if;
3141
3142                      if Data.Library_Kind /= Static and then
3143                        MLib.Tgt.Support_For_Libraries = MLib.Tgt.Static_Only
3144                      then
3145                         Error_Msg
3146                           (Project,
3147                            "only static libraries are supported " &
3148                            "on this platform",
3149                           The_Lib_Kind.Location);
3150                         Data.Library := False;
3151                      end if;
3152                   end;
3153                end if;
3154
3155                if Data.Library and then Current_Verbosity = High then
3156                   Write_Line ("This is a library project file");
3157                end if;
3158
3159             end if;
3160          end if;
3161       end;
3162
3163       if Current_Verbosity = High then
3164          Show_Source_Dirs (Project);
3165       end if;
3166
3167       declare
3168          Naming_Id : constant Package_Id :=
3169                        Util.Value_Of (Name_Naming, Data.Decl.Packages);
3170
3171          Naming    : Package_Element;
3172
3173       begin
3174          --  If there is a package Naming, we will put in Data.Naming
3175          --  what is in this package Naming.
3176
3177          if Naming_Id /= No_Package then
3178             Naming := Packages.Table (Naming_Id);
3179
3180             if Current_Verbosity = High then
3181                Write_Line ("Checking ""Naming"".");
3182             end if;
3183
3184             --  Check Spec_Suffix
3185
3186             declare
3187                Spec_Suffixs : Array_Element_Id :=
3188                                 Util.Value_Of
3189                                   (Name_Spec_Suffix,
3190                                    Naming.Decl.Arrays);
3191                Suffix  : Array_Element_Id;
3192                Element : Array_Element;
3193                Suffix2 : Array_Element_Id;
3194
3195             begin
3196                --  If some suffixs have been specified, we make sure that
3197                --  for each language for which a default suffix has been
3198                --  specified, there is a suffix specified, either the one
3199                --  in the project file or if there were none, the default.
3200
3201                if Spec_Suffixs /= No_Array_Element then
3202                   Suffix := Data.Naming.Spec_Suffix;
3203
3204                   while Suffix /= No_Array_Element loop
3205                      Element := Array_Elements.Table (Suffix);
3206                      Suffix2 := Spec_Suffixs;
3207
3208                      while Suffix2 /= No_Array_Element loop
3209                         exit when Array_Elements.Table (Suffix2).Index =
3210                           Element.Index;
3211                         Suffix2 := Array_Elements.Table (Suffix2).Next;
3212                      end loop;
3213
3214                      --  There is a registered default suffix, but no
3215                      --  suffix specified in the project file.
3216                      --  Add the default to the array.
3217
3218                      if Suffix2 = No_Array_Element then
3219                         Array_Elements.Increment_Last;
3220                         Array_Elements.Table (Array_Elements.Last) :=
3221                           (Index => Element.Index,
3222                            Index_Case_Sensitive => False,
3223                            Value => Element.Value,
3224                            Next  => Spec_Suffixs);
3225                         Spec_Suffixs := Array_Elements.Last;
3226                      end if;
3227
3228                      Suffix := Element.Next;
3229                   end loop;
3230
3231                   --  Put the resulting array as the specification suffixs
3232
3233                   Data.Naming.Spec_Suffix := Spec_Suffixs;
3234                end if;
3235             end;
3236
3237             declare
3238                Current : Array_Element_Id := Data.Naming.Spec_Suffix;
3239                Element : Array_Element;
3240
3241             begin
3242                while Current /= No_Array_Element loop
3243                   Element := Array_Elements.Table (Current);
3244                   Get_Name_String (Element.Value.Value);
3245
3246                   if Name_Len = 0 then
3247                      Error_Msg
3248                        (Project,
3249                         "Spec_Suffix cannot be empty",
3250                         Element.Value.Location);
3251                   end if;
3252
3253                   Array_Elements.Table (Current) := Element;
3254                   Current := Element.Next;
3255                end loop;
3256             end;
3257
3258             --  Check Body_Suffix
3259
3260             declare
3261                Impl_Suffixs : Array_Element_Id :=
3262                                 Util.Value_Of
3263                                   (Name_Body_Suffix,
3264                                    Naming.Decl.Arrays);
3265
3266                Suffix  : Array_Element_Id;
3267                Element : Array_Element;
3268                Suffix2 : Array_Element_Id;
3269
3270             begin
3271                --  If some suffixs have been specified, we make sure that
3272                --  for each language for which a default suffix has been
3273                --  specified, there is a suffix specified, either the one
3274                --  in the project file or if there were noe, the default.
3275
3276                if Impl_Suffixs /= No_Array_Element then
3277                   Suffix := Data.Naming.Body_Suffix;
3278
3279                   while Suffix /= No_Array_Element loop
3280                      Element := Array_Elements.Table (Suffix);
3281                      Suffix2 := Impl_Suffixs;
3282
3283                      while Suffix2 /= No_Array_Element loop
3284                         exit when Array_Elements.Table (Suffix2).Index =
3285                           Element.Index;
3286                         Suffix2 := Array_Elements.Table (Suffix2).Next;
3287                      end loop;
3288
3289                      --  There is a registered default suffix, but no
3290                      --  suffix specified in the project file.
3291                      --  Add the default to the array.
3292
3293                      if Suffix2 = No_Array_Element then
3294                         Array_Elements.Increment_Last;
3295                         Array_Elements.Table (Array_Elements.Last) :=
3296                           (Index => Element.Index,
3297                            Index_Case_Sensitive => False,
3298                            Value => Element.Value,
3299                            Next  => Impl_Suffixs);
3300                         Impl_Suffixs := Array_Elements.Last;
3301                      end if;
3302
3303                      Suffix := Element.Next;
3304                   end loop;
3305
3306                   --  Put the resulting array as the implementation suffixs
3307
3308                   Data.Naming.Body_Suffix := Impl_Suffixs;
3309                end if;
3310             end;
3311
3312             declare
3313                Current : Array_Element_Id := Data.Naming.Body_Suffix;
3314                Element : Array_Element;
3315
3316             begin
3317                while Current /= No_Array_Element loop
3318                   Element := Array_Elements.Table (Current);
3319                   Get_Name_String (Element.Value.Value);
3320
3321                   if Name_Len = 0 then
3322                      Error_Msg
3323                        (Project,
3324                         "Body_Suffix cannot be empty",
3325                         Element.Value.Location);
3326                   end if;
3327
3328                   Array_Elements.Table (Current) := Element;
3329                   Current := Element.Next;
3330                end loop;
3331             end;
3332
3333             --  Get the exceptions, if any
3334
3335             Data.Naming.Specification_Exceptions :=
3336               Util.Value_Of
3337                 (Name_Specification_Exceptions,
3338                  In_Arrays => Naming.Decl.Arrays);
3339
3340             Data.Naming.Implementation_Exceptions :=
3341               Util.Value_Of
3342                 (Name_Implementation_Exceptions,
3343                  In_Arrays => Naming.Decl.Arrays);
3344          end if;
3345       end;
3346
3347       Projects.Table (Project) := Data;
3348    end Language_Independent_Check;
3349
3350    ----------------------
3351    -- Locate_Directory --
3352    ----------------------
3353
3354    procedure Locate_Directory
3355      (Name    : Name_Id;
3356       Parent  : Name_Id;
3357       Dir     : out Name_Id;
3358       Display : out Name_Id)
3359    is
3360       The_Name   : constant String := Get_Name_String (Name);
3361       The_Parent : constant String :=
3362                      Get_Name_String (Parent) & Directory_Separator;
3363       The_Parent_Last : constant Natural :=
3364                      Compute_Directory_Last (The_Parent);
3365
3366    begin
3367       if Current_Verbosity = High then
3368          Write_Str ("Locate_Directory (""");
3369          Write_Str (The_Name);
3370          Write_Str (""", """);
3371          Write_Str (The_Parent);
3372          Write_Line (""")");
3373       end if;
3374
3375       Dir     := No_Name;
3376       Display := No_Name;
3377
3378       if Is_Absolute_Path (The_Name) then
3379          if Is_Directory (The_Name) then
3380             declare
3381                Normed : constant String :=
3382                  Normalize_Pathname (The_Name);
3383
3384             begin
3385                Name_Len := Normed'Length;
3386                Name_Buffer (1 .. Name_Len) := Normed;
3387                Display := Name_Find;
3388                Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3389                Dir := Name_Find;
3390             end;
3391          end if;
3392
3393       else
3394          declare
3395             Full_Path : constant String :=
3396                           The_Parent (The_Parent'First .. The_Parent_Last) &
3397                           The_Name;
3398
3399          begin
3400             if Is_Directory (Full_Path) then
3401                declare
3402                   Normed : constant String :=
3403                              Normalize_Pathname (Full_Path);
3404
3405                begin
3406                   Name_Len := Normed'Length;
3407                   Name_Buffer (1 .. Name_Len) := Normed;
3408                   Display := Name_Find;
3409                   Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3410                   Dir := Name_Find;
3411                end;
3412             end if;
3413          end;
3414       end if;
3415    end Locate_Directory;
3416
3417    ------------------
3418    -- Path_Name_Of --
3419    ------------------
3420
3421    function Path_Name_Of
3422      (File_Name : Name_Id;
3423       Directory : Name_Id)
3424       return      String
3425    is
3426       Result : String_Access;
3427       The_Directory : constant String := Get_Name_String (Directory);
3428
3429    begin
3430       Get_Name_String (File_Name);
3431       Result := Locate_Regular_File
3432         (File_Name => Name_Buffer (1 .. Name_Len),
3433          Path      => The_Directory);
3434
3435       if Result = null then
3436          return "";
3437       else
3438          Canonical_Case_File_Name (Result.all);
3439          return Result.all;
3440       end if;
3441    end Path_Name_Of;
3442
3443    ---------------------
3444    -- Project_Extends --
3445    ---------------------
3446
3447    function Project_Extends
3448      (Extending : Project_Id;
3449       Extended  : Project_Id)
3450       return      Boolean
3451    is
3452       Current : Project_Id := Extending;
3453    begin
3454       loop
3455          if Current = No_Project then
3456             return False;
3457
3458          elsif Current = Extended then
3459             return True;
3460          end if;
3461
3462          Current := Projects.Table (Current).Extends;
3463       end loop;
3464    end Project_Extends;
3465
3466    -------------------
3467    -- Record_Source --
3468    -------------------
3469
3470    procedure Record_Source
3471      (File_Name       : Name_Id;
3472       Path_Name       : Name_Id;
3473       Project         : Project_Id;
3474       Data            : in out Project_Data;
3475       Location        : Source_Ptr;
3476       Current_Source  : in out String_List_Id;
3477       Source_Recorded : in out Boolean)
3478    is
3479       Canonical_File_Name : Name_Id;
3480       Canonical_Path_Name : Name_Id;
3481       Unit_Name    : Name_Id;
3482       Unit_Kind    : Spec_Or_Body;
3483       Needs_Pragma : Boolean;
3484
3485       The_Location    : Source_Ptr     := Location;
3486       Previous_Source : constant String_List_Id := Current_Source;
3487       Except_Name     : Name_Id        := No_Name;
3488
3489    begin
3490       Get_Name_String (File_Name);
3491       Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3492       Canonical_File_Name := Name_Find;
3493       Get_Name_String (Path_Name);
3494       Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3495       Canonical_Path_Name := Name_Find;
3496
3497       --  Find out the unit name, the unit kind and if it needs
3498       --  a specific SFN pragma.
3499
3500       Get_Unit
3501         (Canonical_File_Name => Canonical_File_Name,
3502          Naming              => Data.Naming,
3503          Unit_Name           => Unit_Name,
3504          Unit_Kind           => Unit_Kind,
3505          Needs_Pragma        => Needs_Pragma);
3506
3507       if Unit_Name = No_Name then
3508          if Current_Verbosity = High then
3509             Write_Str  ("   """);
3510             Write_Str  (Get_Name_String (Canonical_File_Name));
3511             Write_Line (""" is not a valid source file name (ignored).");
3512          end if;
3513
3514       else
3515          --  Check to see if the source has been hidden by an exception,
3516          --  but only if it is not an exception.
3517
3518          if not Needs_Pragma then
3519             Except_Name :=
3520               Reverse_Naming_Exceptions.Get ((Unit_Kind, Unit_Name));
3521
3522             if Except_Name /= No_Name then
3523                if Current_Verbosity = High then
3524                   Write_Str  ("   """);
3525                   Write_Str  (Get_Name_String (Canonical_File_Name));
3526                   Write_Str  (""" contains a unit that is found in """);
3527                   Write_Str  (Get_Name_String (Except_Name));
3528                   Write_Line (""" (ignored).");
3529                end if;
3530
3531                --  The file is not included in the source of the project,
3532                --  because it is hidden by the exception.
3533                --  So, there is nothing else to do.
3534
3535                return;
3536             end if;
3537          end if;
3538
3539          --  Put the file name in the list of sources of the project
3540
3541          String_Elements.Increment_Last;
3542          String_Elements.Table (String_Elements.Last) :=
3543            (Value         => Canonical_File_Name,
3544             Display_Value => File_Name,
3545             Location      => No_Location,
3546             Flag          => False,
3547             Next          => Nil_String);
3548
3549          if Current_Source = Nil_String then
3550             Data.Sources := String_Elements.Last;
3551
3552          else
3553             String_Elements.Table (Current_Source).Next :=
3554               String_Elements.Last;
3555          end if;
3556
3557          Current_Source := String_Elements.Last;
3558
3559          --  Put the unit in unit list
3560
3561          declare
3562             The_Unit      : Unit_Id := Units_Htable.Get (Unit_Name);
3563             The_Unit_Data : Unit_Data;
3564
3565          begin
3566             if Current_Verbosity = High then
3567                Write_Str  ("Putting ");
3568                Write_Str  (Get_Name_String (Unit_Name));
3569                Write_Line (" in the unit list.");
3570             end if;
3571
3572             --  The unit is already in the list, but may be it is
3573             --  only the other unit kind (spec or body), or what is
3574             --  in the unit list is a unit of a project we are extending.
3575
3576             if The_Unit /= Prj.Com.No_Unit then
3577                The_Unit_Data := Units.Table (The_Unit);
3578
3579                if The_Unit_Data.File_Names (Unit_Kind).Name = No_Name
3580                  or else Project_Extends
3581                            (Data.Extends,
3582                             The_Unit_Data.File_Names (Unit_Kind).Project)
3583                then
3584                   if The_Unit_Data.File_Names (Unit_Kind).Path = Slash then
3585                      Remove_Forbidden_File_Name
3586                        (The_Unit_Data.File_Names (Unit_Kind).Name);
3587                   end if;
3588
3589                   The_Unit_Data.File_Names (Unit_Kind) :=
3590                     (Name         => Canonical_File_Name,
3591                      Display_Name => File_Name,
3592                      Path         => Canonical_Path_Name,
3593                      Display_Path => Path_Name,
3594                      Project      => Project,
3595                      Needs_Pragma => Needs_Pragma);
3596                   Units.Table (The_Unit) := The_Unit_Data;
3597                   Source_Recorded := True;
3598
3599                elsif The_Unit_Data.File_Names (Unit_Kind).Project = Project
3600                  and then (Data.Known_Order_Of_Source_Dirs or else
3601                            The_Unit_Data.File_Names (Unit_Kind).Path =
3602                                                           Canonical_Path_Name)
3603                then
3604                   if Previous_Source = Nil_String then
3605                      Data.Sources := Nil_String;
3606                   else
3607                      String_Elements.Table (Previous_Source).Next :=
3608                        Nil_String;
3609                      String_Elements.Decrement_Last;
3610                   end if;
3611
3612                   Current_Source := Previous_Source;
3613
3614                else
3615                   --  It is an error to have two units with the same name
3616                   --  and the same kind (spec or body).
3617
3618                   if The_Location = No_Location then
3619                      The_Location := Projects.Table (Project).Location;
3620                   end if;
3621
3622                   Err_Vars.Error_Msg_Name_1 := Unit_Name;
3623                   Error_Msg (Project, "duplicate source {", The_Location);
3624
3625                   Err_Vars.Error_Msg_Name_1 :=
3626                     Projects.Table
3627                       (The_Unit_Data.File_Names (Unit_Kind).Project).Name;
3628                   Err_Vars.Error_Msg_Name_2 :=
3629                     The_Unit_Data.File_Names (Unit_Kind).Path;
3630                   Error_Msg (Project, "\   project file {, {", The_Location);
3631
3632                   Err_Vars.Error_Msg_Name_1 := Projects.Table (Project).Name;
3633                   Err_Vars.Error_Msg_Name_2 := Canonical_Path_Name;
3634                   Error_Msg (Project, "\   project file {, {", The_Location);
3635
3636                end if;
3637
3638             --  It is a new unit, create a new record
3639
3640             else
3641                Units.Increment_Last;
3642                The_Unit := Units.Last;
3643                Units_Htable.Set (Unit_Name, The_Unit);
3644                The_Unit_Data.Name := Unit_Name;
3645                The_Unit_Data.File_Names (Unit_Kind) :=
3646                  (Name         => Canonical_File_Name,
3647                   Display_Name => File_Name,
3648                   Path         => Canonical_Path_Name,
3649                   Display_Path => Path_Name,
3650                   Project      => Project,
3651                   Needs_Pragma => Needs_Pragma);
3652                Units.Table (The_Unit) := The_Unit_Data;
3653                Source_Recorded := True;
3654             end if;
3655          end;
3656       end if;
3657    end Record_Source;
3658
3659    ----------------------
3660    -- Show_Source_Dirs --
3661    ----------------------
3662
3663    procedure Show_Source_Dirs (Project : Project_Id) is
3664       Current : String_List_Id := Projects.Table (Project).Source_Dirs;
3665       Element : String_Element;
3666
3667    begin
3668       Write_Line ("Source_Dirs:");
3669
3670       while Current /= Nil_String loop
3671          Element := String_Elements.Table (Current);
3672          Write_Str  ("   ");
3673          Write_Line (Get_Name_String (Element.Value));
3674          Current := Element.Next;
3675       end loop;
3676
3677       Write_Line ("end Source_Dirs.");
3678    end Show_Source_Dirs;
3679
3680 end Prj.Nmsc;