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-2002 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 Errout;
  28 with Hostparm;
  29 with MLib.Tgt;
  30 with Namet;    use Namet;
  31 with Osint;    use Osint;
  32 with Output;   use Output;
  33 with Prj.Com;  use Prj.Com;
  34 with Prj.Env;  use Prj.Env;
  35 with Prj.Util; use Prj.Util;
  36 with Snames;   use Snames;
  37 with Stringt;  use Stringt;
  38 with Types;    use Types;
  39
  40 with Ada.Characters.Handling;    use Ada.Characters.Handling;
  41 with Ada.Strings;                use Ada.Strings;
  42 with Ada.Strings.Fixed;          use Ada.Strings.Fixed;
  43 with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
  44
  45 with GNAT.Case_Util;             use GNAT.Case_Util;
  46 with GNAT.Directory_Operations;  use GNAT.Directory_Operations;
  47 with GNAT.OS_Lib;                use GNAT.OS_Lib;
  48
  49 package body Prj.Nmsc is
  50
  51    Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator;
  52
  53    Error_Report    : Put_Line_Access := null;
  54    Current_Project : Project_Id := No_Project;
  55
  56    procedure Check_Ada_Naming_Scheme (Naming : Naming_Data);
  57    --  Check that the package Naming is correct.
  58
  59    procedure Check_Ada_Name
  60      (Name : Name_Id;
  61       Unit : out Name_Id);
  62    --  Check that a name is a valid Ada unit name.
  63
  64    procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr);
  65    --  Output an error message. If Error_Report is null, simply call
  66    --  Errout.Error_Msg. Otherwise, disregard Flag_Location and use
  67    --  Error_Report.
  68
  69    function Get_Name_String (S : String_Id) return String;
  70    --  Get the string from a String_Id
  71
  72    procedure Get_Unit
  73      (File_Name    : Name_Id;
  74       Naming       : Naming_Data;
  75       Unit_Name    : out Name_Id;
  76       Unit_Kind    : out Spec_Or_Body;
  77       Needs_Pragma : out Boolean);
  78    --  Find out, from a file name, the unit name, the unit kind and if a
  79    --  specific SFN pragma is needed. If the file name corresponds to no
  80    --  unit, then Unit_Name will be No_Name.
  81
  82    function Is_Illegal_Suffix
  83      (Suffix                          : String;
  84       Dot_Replacement_Is_A_Single_Dot : Boolean)
  85       return                            Boolean;
  86    --  Returns True if the string Suffix cannot be used as
  87    --  a spec suffix, a body suffix or a separate suffix.
  88
  89    procedure Record_Source
  90      (File_Name          : Name_Id;
  91       Path_Name          : Name_Id;
  92       Project            : Project_Id;
  93       Data               : in out Project_Data;
  94       Location           : Source_Ptr;
  95       Current_Source     : in out String_List_Id);
  96    --  Put a unit in the list of units of a project, if the file name
  97    --  corresponds to a valid unit name.
  98
  99    procedure Show_Source_Dirs (Project : Project_Id);
 100    --  List all the source directories of a project.
 101
 102    function Locate_Directory
 103      (Name   : Name_Id;
 104       Parent : Name_Id)
 105       return   Name_Id;
 106    --  Locate a directory.
 107    --  Returns No_Name if directory does not exist.
 108
 109    function Path_Name_Of
 110      (File_Name : String_Id;
 111       Directory : Name_Id)
 112       return      String;
 113    --  Returns the path name of a (non project) file.
 114    --  Returns an empty string if file cannot be found.
 115
 116    ---------------
 117    -- Ada_Check --
 118    ---------------
 119
 120    procedure Ada_Check
 121      (Project      : Project_Id;
 122       Report_Error : Put_Line_Access)
 123    is
 124       Data         : Project_Data;
 125       Languages    : Variable_Value := Nil_Variable_Value;
 126
 127       procedure Check_Unit_Names (List : Array_Element_Id);
 128       --  Check that a list of unit names contains only valid names.
 129
 130       procedure Find_Sources;
 131       --  Find all the sources in all of the source directories
 132       --  of a project.
 133
 134       procedure Get_Path_Name_And_Record_Source
 135         (File_Name        : String;
 136          Location         : Source_Ptr;
 137          Current_Source   : in out String_List_Id);
 138       --  Find the path name of a source in the source directories and
 139       --  record the source, if found.
 140
 141       procedure Get_Sources_From_File
 142         (Path     : String;
 143          Location : Source_Ptr);
 144       --  Get the sources of a project from a text file
 145
 146       ----------------------
 147       -- Check_Unit_Names --
 148       ----------------------
 149
 150       procedure Check_Unit_Names (List : Array_Element_Id) is
 151          Current   : Array_Element_Id := List;
 152          Element   : Array_Element;
 153          Unit_Name : Name_Id;
 154
 155       begin
 156          --  Loop through elements of the string list
 157
 158          while Current /= No_Array_Element loop
 159             Element := Array_Elements.Table (Current);
 160
 161             --  Check that it contains a valid unit name
 162
 163             Check_Ada_Name (Element.Index, Unit_Name);
 164
 165             if Unit_Name = No_Name then
 166                Errout.Error_Msg_Name_1 := Element.Index;
 167                Error_Msg
 168                  ("{ is not a valid unit name.",
 169                   Element.Value.Location);
 170
 171             else
 172                if Current_Verbosity = High then
 173                   Write_Str ("   Body_Part (""");
 174                   Write_Str (Get_Name_String (Unit_Name));
 175                   Write_Line (""")");
 176                end if;
 177
 178                Element.Index := Unit_Name;
 179                Array_Elements.Table (Current) := Element;
 180             end if;
 181
 182             Current := Element.Next;
 183          end loop;
 184       end Check_Unit_Names;
 185
 186       ------------------
 187       -- Find_Sources --
 188       ------------------
 189
 190       procedure Find_Sources is
 191          Source_Dir     : String_List_Id := Data.Source_Dirs;
 192          Element        : String_Element;
 193          Dir            : Dir_Type;
 194          Current_Source : String_List_Id := Nil_String;
 195
 196       begin
 197          if Current_Verbosity = High then
 198             Write_Line ("Looking for sources:");
 199          end if;
 200
 201          --  For each subdirectory
 202
 203          while Source_Dir /= Nil_String loop
 204             begin
 205                Element := String_Elements.Table (Source_Dir);
 206                if Element.Value /= No_String then
 207                   declare
 208                      Source_Directory : String
 209                        (1 .. Integer (String_Length (Element.Value)));
 210                   begin
 211                      String_To_Name_Buffer (Element.Value);
 212                      Source_Directory := Name_Buffer (1 .. Name_Len);
 213                      if Current_Verbosity = High then
 214                         Write_Str ("Source_Dir = ");
 215                         Write_Line (Source_Directory);
 216                      end if;
 217
 218                      --  We look to every entry in the source directory
 219
 220                      Open (Dir, Source_Directory);
 221
 222                      loop
 223                         Read (Dir, Name_Buffer, Name_Len);
 224
 225                         if Current_Verbosity = High then
 226                            Write_Str  ("   Checking ");
 227                            Write_Line (Name_Buffer (1 .. Name_Len));
 228                         end if;
 229
 230                         exit when Name_Len = 0;
 231
 232                         declare
 233                            Path_Access : constant GNAT.OS_Lib.String_Access :=
 234                                            Locate_Regular_File
 235                                              (Name_Buffer (1 .. Name_Len),
 236                                               Source_Directory);
 237
 238                            File_Name : Name_Id;
 239                            Path_Name : Name_Id;
 240
 241                         begin
 242                            --  If it is a regular file
 243
 244                            if Path_Access /= null then
 245                               File_Name := Name_Find;
 246                               Name_Len := Path_Access'Length;
 247                               Name_Buffer (1 .. Name_Len) := Path_Access.all;
 248                               Path_Name := Name_Find;
 249
 250                               --  We attempt to register it as a source.
 251                               --  However, there is no error if the file
 252                               --  does not contain a valid source.
 253                               --  But there is an error if we have a
 254                               --  duplicate unit name.
 255
 256                               Record_Source
 257                                 (File_Name          => File_Name,
 258                                  Path_Name          => Path_Name,
 259                                  Project            => Project,
 260                                  Data               => Data,
 261                                  Location           => No_Location,
 262                                  Current_Source     => Current_Source);
 263
 264                            else
 265                               if Current_Verbosity = High then
 266                                  Write_Line
 267                                    ("      Not a regular file.");
 268                               end if;
 269                            end if;
 270                         end;
 271                      end loop;
 272
 273                      Close (Dir);
 274                   end;
 275                end if;
 276
 277             exception
 278                when Directory_Error =>
 279                   null;
 280             end;
 281
 282             Source_Dir := Element.Next;
 283          end loop;
 284
 285          if Current_Verbosity = High then
 286             Write_Line ("end Looking for sources.");
 287          end if;
 288
 289          --  If we have looked for sources and found none, then
 290          --  it is an error. If a project is not supposed to contain
 291          --  any source, then we never call Find_Sources.
 292
 293          if Current_Source = Nil_String then
 294             Error_Msg ("there are no sources in this project",
 295                        Data.Location);
 296          end if;
 297       end Find_Sources;
 298
 299       -------------------------------------
 300       -- Get_Path_Name_And_Record_Source --
 301       -------------------------------------
 302
 303       procedure Get_Path_Name_And_Record_Source
 304         (File_Name        : String;
 305          Location         : Source_Ptr;
 306          Current_Source   : in out String_List_Id)
 307       is
 308          Source_Dir : String_List_Id := Data.Source_Dirs;
 309          Element    : String_Element;
 310          Path_Name  : GNAT.OS_Lib.String_Access;
 311          File       : Name_Id;
 312          Path       : Name_Id;
 313
 314          Found      : Boolean := False;
 315          Fname      : String  := File_Name;
 316
 317       begin
 318          Canonical_Case_File_Name (Fname);
 319          Name_Len := Fname'Length;
 320          Name_Buffer (1 .. Name_Len) := Fname;
 321          File := Name_Find;
 322
 323          if Current_Verbosity = High then
 324             Write_Str  ("   Checking """);
 325             Write_Str  (Fname);
 326             Write_Line (""".");
 327          end if;
 328
 329          --  We look in all source directories for this file name
 330
 331          while Source_Dir /= Nil_String loop
 332             Element := String_Elements.Table (Source_Dir);
 333
 334             if Current_Verbosity = High then
 335                Write_Str ("      """);
 336                Write_Str (Get_Name_String (Element.Value));
 337                Write_Str (""": ");
 338             end if;
 339
 340             Path_Name :=
 341               Locate_Regular_File
 342               (Fname,
 343                Get_Name_String (Element.Value));
 344
 345             if Path_Name /= null then
 346                if Current_Verbosity = High then
 347                   Write_Line ("OK");
 348                end if;
 349
 350                Name_Len := Path_Name'Length;
 351                Name_Buffer (1 .. Name_Len) := Path_Name.all;
 352                Path := Name_Find;
 353
 354                --  Register the source if it is an Ada compilation unit..
 355
 356                Record_Source
 357                  (File_Name          => File,
 358                   Path_Name          => Path,
 359                   Project            => Project,
 360                   Data               => Data,
 361                   Location           => Location,
 362                   Current_Source     => Current_Source);
 363                Found := True;
 364                exit;
 365
 366             else
 367                if Current_Verbosity = High then
 368                   Write_Line ("No");
 369                end if;
 370
 371                Source_Dir := Element.Next;
 372             end if;
 373          end loop;
 374
 375          --  It is an error if a source file names in a source list or
 376          --  in a source list file is not found.
 377
 378          if not Found then
 379             Errout.Error_Msg_Name_1 := File;
 380             Error_Msg ("source file { cannot be found", Location);
 381          end if;
 382
 383       end Get_Path_Name_And_Record_Source;
 384
 385       ---------------------------
 386       -- Get_Sources_From_File --
 387       ---------------------------
 388
 389       procedure Get_Sources_From_File
 390         (Path     : String;
 391          Location : Source_Ptr)
 392       is
 393          File           : Prj.Util.Text_File;
 394          Line           : String (1 .. 250);
 395          Last           : Natural;
 396          Current_Source : String_List_Id := Nil_String;
 397
 398       begin
 399          if Current_Verbosity = High then
 400             Write_Str  ("Opening """);
 401             Write_Str  (Path);
 402             Write_Line (""".");
 403          end if;
 404
 405          --  We open the file
 406
 407          Prj.Util.Open (File, Path);
 408
 409          if not Prj.Util.Is_Valid (File) then
 410             Error_Msg ("file does not exist", Location);
 411          else
 412             while not Prj.Util.End_Of_File (File) loop
 413                Prj.Util.Get_Line (File, Line, Last);
 414
 415                --  If the line is not empty and does not start with "--",
 416                --  then it should contain a file name. However, if the
 417                --  file name does not exist, it may be for another language
 418                --  and we don't fail.
 419
 420                if Last /= 0
 421                  and then (Last = 1 or else Line (1 .. 2) /= "--")
 422                then
 423                   Get_Path_Name_And_Record_Source
 424                     (File_Name => Line (1 .. Last),
 425                      Location => Location,
 426                      Current_Source => Current_Source);
 427                end if;
 428             end loop;
 429
 430             Prj.Util.Close (File);
 431
 432          end if;
 433
 434          --  We should have found at least one source.
 435          --  If not, report an error.
 436
 437          if Current_Source = Nil_String then
 438             Error_Msg ("this project has no source", Location);
 439          end if;
 440       end Get_Sources_From_File;
 441
 442       --  Start of processing for Ada_Check
 443
 444    begin
 445       Language_Independent_Check (Project, Report_Error);
 446
 447       Error_Report    := Report_Error;
 448       Current_Project := Project;
 449
 450       Data      := Projects.Table (Project);
 451       Languages := Prj.Util.Value_Of (Name_Languages, Data.Decl.Attributes);
 452
 453       Data.Naming.Current_Language := Name_Ada;
 454       Data.Sources_Present         := Data.Source_Dirs /= Nil_String;
 455
 456       if not Languages.Default then
 457          declare
 458             Current   : String_List_Id := Languages.Values;
 459             Element   : String_Element;
 460             Ada_Found : Boolean := False;
 461
 462          begin
 463             Look_For_Ada : while Current /= Nil_String loop
 464                Element := String_Elements.Table (Current);
 465                String_To_Name_Buffer (Element.Value);
 466                To_Lower (Name_Buffer (1 .. Name_Len));
 467
 468                if Name_Buffer (1 .. Name_Len) = "ada" then
 469                   Ada_Found := True;
 470                   exit Look_For_Ada;
 471                end if;
 472
 473                Current := Element.Next;
 474             end loop Look_For_Ada;
 475
 476             if not Ada_Found then
 477
 478                --  Mark the project file as having no sources for Ada
 479
 480                Data.Sources_Present := False;
 481             end if;
 482          end;
 483       end if;
 484
 485       declare
 486          Naming_Id : constant Package_Id :=
 487                        Util.Value_Of (Name_Naming, Data.Decl.Packages);
 488
 489          Naming : Package_Element;
 490
 491       begin
 492          --  If there is a package Naming, we will put in Data.Naming
 493          --  what is in this package Naming.
 494
 495          if Naming_Id /= No_Package then
 496             Naming := Packages.Table (Naming_Id);
 497
 498             if Current_Verbosity = High then
 499                Write_Line ("Checking ""Naming"" for Ada.");
 500             end if;
 501
 502             declare
 503                Bodies : constant Array_Element_Id :=
 504                                   Util.Value_Of
 505                                     (Name_Implementation, Naming.Decl.Arrays);
 506
 507                Specifications : constant Array_Element_Id :=
 508                                   Util.Value_Of
 509                                     (Name_Specification, Naming.Decl.Arrays);
 510
 511             begin
 512                if Bodies /= No_Array_Element then
 513
 514                   --  We have elements in the array Body_Part
 515
 516                   if Current_Verbosity = High then
 517                      Write_Line ("Found Bodies.");
 518                   end if;
 519
 520                   Data.Naming.Bodies := Bodies;
 521                   Check_Unit_Names (Bodies);
 522
 523                else
 524                   if Current_Verbosity = High then
 525                      Write_Line ("No Bodies.");
 526                   end if;
 527                end if;
 528
 529                if Specifications /= No_Array_Element then
 530
 531                   --  We have elements in the array Specification
 532
 533                   if Current_Verbosity = High then
 534                      Write_Line ("Found Specifications.");
 535                   end if;
 536
 537                   Data.Naming.Specifications := Specifications;
 538                   Check_Unit_Names (Specifications);
 539
 540                else
 541                   if Current_Verbosity = High then
 542                      Write_Line ("No Specifications.");
 543                   end if;
 544                end if;
 545             end;
 546
 547             --  We are now checking if variables Dot_Replacement, Casing,
 548             --  Specification_Append, Body_Append and/or Separate_Append
 549             --  exist.
 550
 551             --  For each variable, if it does not exist, we do nothing,
 552             --  because we already have the default.
 553
 554             --  Check Dot_Replacement
 555
 556             declare
 557                Dot_Replacement : constant Variable_Value :=
 558                                    Util.Value_Of
 559                                      (Name_Dot_Replacement,
 560                                       Naming.Decl.Attributes);
 561
 562             begin
 563                pragma Assert (Dot_Replacement.Kind = Single,
 564                               "Dot_Replacement is not a single string");
 565
 566                if not Dot_Replacement.Default then
 567
 568                   String_To_Name_Buffer (Dot_Replacement.Value);
 569
 570                   if Name_Len = 0 then
 571                      Error_Msg ("Dot_Replacement cannot be empty",
 572                                 Dot_Replacement.Location);
 573
 574                   else
 575                      Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
 576                      Data.Naming.Dot_Replacement := Name_Find;
 577                      Data.Naming.Dot_Repl_Loc := Dot_Replacement.Location;
 578                   end if;
 579
 580                end if;
 581
 582             end;
 583
 584             if Current_Verbosity = High then
 585                Write_Str  ("  Dot_Replacement = """);
 586                Write_Str  (Get_Name_String (Data.Naming.Dot_Replacement));
 587                Write_Char ('"');
 588                Write_Eol;
 589             end if;
 590
 591             --  Check Casing
 592
 593             declare
 594                Casing_String : constant Variable_Value :=
 595                  Util.Value_Of (Name_Casing, Naming.Decl.Attributes);
 596
 597             begin
 598                pragma Assert (Casing_String.Kind = Single,
 599                               "Casing is not a single string");
 600
 601                if not Casing_String.Default then
 602                   declare
 603                      Casing_Image : constant String :=
 604                                       Get_Name_String (Casing_String.Value);
 605
 606                   begin
 607                      declare
 608                         Casing : constant Casing_Type :=
 609                           Value (Casing_Image);
 610
 611                      begin
 612                         Data.Naming.Casing := Casing;
 613                      end;
 614
 615                   exception
 616                      when Constraint_Error =>
 617                         if Casing_Image'Length = 0 then
 618                            Error_Msg ("Casing cannot be an empty string",
 619                                       Casing_String.Location);
 620
 621                         else
 622                            Name_Len := Casing_Image'Length;
 623                            Name_Buffer (1 .. Name_Len) := Casing_Image;
 624                            Errout.Error_Msg_Name_1 := Name_Find;
 625                            Error_Msg
 626                              ("{ is not a correct Casing",
 627                               Casing_String.Location);
 628                         end if;
 629                   end;
 630                end if;
 631             end;
 632
 633             if Current_Verbosity = High then
 634                Write_Str  ("  Casing = ");
 635                Write_Str  (Image (Data.Naming.Casing));
 636                Write_Char ('.');
 637                Write_Eol;
 638             end if;
 639
 640             --  Check Specification_Suffix
 641
 642             declare
 643                Ada_Spec_Suffix : constant Variable_Value :=
 644                  Prj.Util.Value_Of
 645                    (Index => Name_Ada,
 646                     In_Array => Data.Naming.Specification_Suffix);
 647
 648             begin
 649                if Ada_Spec_Suffix.Kind = Single
 650                  and then String_Length (Ada_Spec_Suffix.Value) /= 0
 651                then
 652                   String_To_Name_Buffer (Ada_Spec_Suffix.Value);
 653                   Data.Naming.Current_Spec_Suffix := Name_Find;
 654                   Data.Naming.Spec_Suffix_Loc := Ada_Spec_Suffix.Location;
 655
 656                else
 657                   Data.Naming.Current_Spec_Suffix := Default_Ada_Spec_Suffix;
 658                end if;
 659             end;
 660
 661             if Current_Verbosity = High then
 662                Write_Str  ("  Specification_Suffix = """);
 663                Write_Str  (Get_Name_String (Data.Naming.Current_Spec_Suffix));
 664                Write_Char ('"');
 665                Write_Eol;
 666             end if;
 667
 668             --  Check Implementation_Suffix
 669
 670             declare
 671                Ada_Impl_Suffix : constant Variable_Value :=
 672                  Prj.Util.Value_Of
 673                    (Index => Name_Ada,
 674                     In_Array => Data.Naming.Implementation_Suffix);
 675
 676             begin
 677                if Ada_Impl_Suffix.Kind = Single
 678                  and then String_Length (Ada_Impl_Suffix.Value) /= 0
 679                then
 680                   String_To_Name_Buffer (Ada_Impl_Suffix.Value);
 681                   Data.Naming.Current_Impl_Suffix := Name_Find;
 682                   Data.Naming.Impl_Suffix_Loc := Ada_Impl_Suffix.Location;
 683
 684                else
 685                   Data.Naming.Current_Impl_Suffix := Default_Ada_Impl_Suffix;
 686                end if;
 687             end;
 688
 689             if Current_Verbosity = High then
 690                Write_Str  ("  Implementation_Suffix = """);
 691                Write_Str  (Get_Name_String (Data.Naming.Current_Impl_Suffix));
 692                Write_Char ('"');
 693                Write_Eol;
 694             end if;
 695
 696             --  Check Separate_Suffix
 697
 698             declare
 699                Ada_Sep_Suffix : constant Variable_Value :=
 700                  Prj.Util.Value_Of
 701                  (Variable_Name => Name_Separate_Suffix,
 702                   In_Variables  => Naming.Decl.Attributes);
 703             begin
 704                if Ada_Sep_Suffix.Default then
 705                   Data.Naming.Separate_Suffix :=
 706                     Data.Naming.Current_Impl_Suffix;
 707
 708                else
 709                   String_To_Name_Buffer (Ada_Sep_Suffix.Value);
 710
 711                   if Name_Len = 0 then
 712                      Error_Msg ("Separate_Suffix cannot be empty",
 713                                 Ada_Sep_Suffix.Location);
 714
 715                   else
 716                      Data.Naming.Separate_Suffix := Name_Find;
 717                      Data.Naming.Sep_Suffix_Loc  := Ada_Sep_Suffix.Location;
 718                   end if;
 719
 720                end if;
 721
 722             end;
 723
 724             if Current_Verbosity = High then
 725                Write_Str  ("  Separate_Suffix = """);
 726                Write_Str  (Get_Name_String (Data.Naming.Separate_Suffix));
 727                Write_Char ('"');
 728                Write_Eol;
 729             end if;
 730
 731             --  Check if Data.Naming is valid
 732
 733             Check_Ada_Naming_Scheme (Data.Naming);
 734
 735          else
 736             Data.Naming.Current_Spec_Suffix := Default_Ada_Spec_Suffix;
 737             Data.Naming.Current_Impl_Suffix := Default_Ada_Impl_Suffix;
 738             Data.Naming.Separate_Suffix     := Default_Ada_Impl_Suffix;
 739          end if;
 740       end;
 741
 742       --  If we have source directories, then find the sources
 743
 744       if Data.Sources_Present then
 745          if Data.Source_Dirs = Nil_String then
 746             Data.Sources_Present := False;
 747
 748          else
 749             declare
 750                Sources : constant Variable_Value :=
 751                  Util.Value_Of
 752                  (Name_Source_Files,
 753                   Data.Decl.Attributes);
 754
 755                Source_List_File : constant Variable_Value :=
 756                  Util.Value_Of
 757                  (Name_Source_List_File,
 758                   Data.Decl.Attributes);
 759
 760             begin
 761                pragma Assert
 762                  (Sources.Kind = List,
 763                     "Source_Files is not a list");
 764                pragma Assert
 765                  (Source_List_File.Kind = Single,
 766                     "Source_List_File is not a single string");
 767
 768                if not Sources.Default then
 769                   if not Source_List_File.Default then
 770                      Error_Msg
 771                        ("?both variables source_files and " &
 772                         "source_list_file are present",
 773                         Source_List_File.Location);
 774                   end if;
 775
 776                   --  Sources is a list of file names
 777
 778                   declare
 779                      Current_Source : String_List_Id := Nil_String;
 780                      Current        : String_List_Id := Sources.Values;
 781                      Element        : String_Element;
 782
 783                   begin
 784                      Data.Sources_Present := Current /= Nil_String;
 785
 786                      while Current /= Nil_String loop
 787                         Element := String_Elements.Table (Current);
 788                         String_To_Name_Buffer (Element.Value);
 789
 790                         declare
 791                            File_Name : constant String :=
 792                              Name_Buffer (1 .. Name_Len);
 793
 794                         begin
 795                            Get_Path_Name_And_Record_Source
 796                              (File_Name        => File_Name,
 797                               Location         => Element.Location,
 798                               Current_Source   => Current_Source);
 799                            Current := Element.Next;
 800                         end;
 801                      end loop;
 802                   end;
 803
 804                   --  No source_files specified.
 805                   --  We check Source_List_File has been specified.
 806
 807                elsif not Source_List_File.Default then
 808
 809                   --  Source_List_File is the name of the file
 810                   --  that contains the source file names
 811
 812                   declare
 813                      Source_File_Path_Name : constant String :=
 814                        Path_Name_Of
 815                        (Source_List_File.Value,
 816                         Data.Directory);
 817
 818                   begin
 819                      if Source_File_Path_Name'Length = 0 then
 820                         String_To_Name_Buffer (Source_List_File.Value);
 821                         Errout.Error_Msg_Name_1 := Name_Find;
 822                         Error_Msg
 823                           ("file with sources { does not exist",
 824                            Source_List_File.Location);
 825
 826                      else
 827                         Get_Sources_From_File
 828                           (Source_File_Path_Name,
 829                            Source_List_File.Location);
 830                      end if;
 831                   end;
 832
 833                else
 834                   --  Neither Source_Files nor Source_List_File has been
 835                   --  specified.
 836                   --  Find all the files that satisfy
 837                   --  the naming scheme in all the source directories.
 838
 839                   Find_Sources;
 840                end if;
 841             end;
 842          end if;
 843       end if;
 844
 845       Projects.Table (Project) := Data;
 846    end Ada_Check;
 847
 848    --------------------
 849    -- Check_Ada_Name --
 850    --------------------
 851
 852    procedure Check_Ada_Name
 853      (Name : Name_Id;
 854       Unit : out Name_Id)
 855    is
 856       The_Name        : String := Get_Name_String (Name);
 857       Need_Letter     : Boolean := True;
 858       Last_Underscore : Boolean := False;
 859       OK              : Boolean := The_Name'Length > 0;
 860
 861    begin
 862       for Index in The_Name'Range loop
 863          if Need_Letter then
 864
 865             --  We need a letter (at the beginning, and following a dot),
 866             --  but we don't have one.
 867
 868             if Is_Letter (The_Name (Index)) then
 869                Need_Letter := False;
 870
 871             else
 872                OK := False;
 873
 874                if Current_Verbosity = High then
 875                   Write_Int  (Types.Int (Index));
 876                   Write_Str  (": '");
 877                   Write_Char (The_Name (Index));
 878                   Write_Line ("' is not a letter.");
 879                end if;
 880
 881                exit;
 882             end if;
 883
 884          elsif Last_Underscore
 885            and then (The_Name (Index) = '_' or else The_Name (Index) = '.')
 886          then
 887             --  Two underscores are illegal, and a dot cannot follow
 888             --  an underscore.
 889
 890             OK := False;
 891
 892             if Current_Verbosity = High then
 893                Write_Int  (Types.Int (Index));
 894                Write_Str  (": '");
 895                Write_Char (The_Name (Index));
 896                Write_Line ("' is illegal here.");
 897             end if;
 898
 899             exit;
 900
 901          elsif The_Name (Index) = '.' then
 902
 903             --  We need a letter after a dot
 904
 905             Need_Letter := True;
 906
 907          elsif The_Name (Index) = '_' then
 908             Last_Underscore := True;
 909
 910          else
 911             --  We need an letter or a digit
 912
 913             Last_Underscore := False;
 914
 915             if not Is_Alphanumeric (The_Name (Index)) then
 916                OK := False;
 917
 918                if Current_Verbosity = High then
 919                   Write_Int  (Types.Int (Index));
 920                   Write_Str  (": '");
 921                   Write_Char (The_Name (Index));
 922                   Write_Line ("' is not alphanumeric.");
 923                end if;
 924
 925                exit;
 926             end if;
 927          end if;
 928       end loop;
 929
 930       --  Cannot end with an underscore or a dot
 931
 932       OK := OK and then not Need_Letter and then not Last_Underscore;
 933
 934       if OK then
 935          Unit := Name;
 936       else
 937          --  Signal a problem with No_Name
 938
 939          Unit := No_Name;
 940       end if;
 941    end Check_Ada_Name;
 942
 943    -----------------------------
 944    -- Check_Ada_Naming_Scheme --
 945    -----------------------------
 946
 947    procedure Check_Ada_Naming_Scheme (Naming : Naming_Data) is
 948    begin
 949       --  Only check if we are not using the standard naming scheme
 950
 951       if Naming /= Standard_Naming_Data then
 952          declare
 953             Dot_Replacement       : constant String :=
 954                                      Get_Name_String
 955                                        (Naming.Dot_Replacement);
 956
 957             Specification_Suffix : constant String :=
 958                                      Get_Name_String
 959                                        (Naming.Current_Spec_Suffix);
 960
 961             Implementation_Suffix : constant String :=
 962                                      Get_Name_String
 963                                        (Naming.Current_Impl_Suffix);
 964
 965             Separate_Suffix       : constant String :=
 966                                      Get_Name_String
 967                                        (Naming.Separate_Suffix);
 968
 969          begin
 970             --  Dot_Replacement cannot
 971             --   - be empty
 972             --   - start or end with an alphanumeric
 973             --   - be a single '_'
 974             --   - start with an '_' followed by an alphanumeric
 975             --   - contain a '.' except if it is "."
 976
 977             if Dot_Replacement'Length = 0
 978               or else Is_Alphanumeric
 979                         (Dot_Replacement (Dot_Replacement'First))
 980               or else Is_Alphanumeric
 981                         (Dot_Replacement (Dot_Replacement'Last))
 982               or else (Dot_Replacement (Dot_Replacement'First) = '_'
 983                         and then
 984                         (Dot_Replacement'Length = 1
 985                           or else
 986                            Is_Alphanumeric
 987                              (Dot_Replacement (Dot_Replacement'First + 1))))
 988               or else (Dot_Replacement'Length > 1
 989                          and then
 990                            Index (Source => Dot_Replacement,
 991                                   Pattern => ".") /= 0)
 992             then
 993                Error_Msg
 994                  ('"' & Dot_Replacement &
 995                   """ is illegal for Dot_Replacement.",
 996                   Naming.Dot_Repl_Loc);
 997             end if;
 998
 999             --  Suffixes cannot
1000             --   - be empty
1001             --   - start with an alphanumeric
1002             --   - start with an '_' followed by an alphanumeric
1003
1004             if Is_Illegal_Suffix
1005                  (Specification_Suffix, Dot_Replacement = ".")
1006             then
1007                Errout.Error_Msg_Name_1 := Naming.Current_Spec_Suffix;
1008                Error_Msg
1009                  ("{ is illegal for Specification_Suffix",
1010                   Naming.Spec_Suffix_Loc);
1011             end if;
1012
1013             if Is_Illegal_Suffix
1014                  (Implementation_Suffix, Dot_Replacement = ".")
1015             then
1016                Errout.Error_Msg_Name_1 := Naming.Current_Impl_Suffix;
1017                Error_Msg
1018                  ("{ is illegal for Implementation_Suffix",
1019                   Naming.Impl_Suffix_Loc);
1020             end if;
1021
1022             if Implementation_Suffix /= Separate_Suffix then
1023                if Is_Illegal_Suffix
1024                     (Separate_Suffix, Dot_Replacement = ".")
1025                then
1026                   Errout.Error_Msg_Name_1 := Naming.Separate_Suffix;
1027                   Error_Msg
1028                     ("{ is illegal for Separate_Suffix",
1029                      Naming.Sep_Suffix_Loc);
1030                end if;
1031             end if;
1032
1033             --  Specification_Suffix cannot have the same termination as
1034             --  Implementation_Suffix or Separate_Suffix
1035
1036             if Specification_Suffix'Length <= Implementation_Suffix'Length
1037               and then
1038                 Implementation_Suffix (Implementation_Suffix'Last -
1039                              Specification_Suffix'Length + 1 ..
1040                              Implementation_Suffix'Last) = Specification_Suffix
1041             then
1042                Error_Msg
1043                  ("Implementation_Suffix (""" &
1044                   Implementation_Suffix &
1045                   """) cannot end with" &
1046                   "Specification_Suffix  (""" &
1047                    Specification_Suffix & """).",
1048                   Naming.Impl_Suffix_Loc);
1049             end if;
1050
1051             if Specification_Suffix'Length <= Separate_Suffix'Length
1052               and then
1053                 Separate_Suffix
1054                   (Separate_Suffix'Last - Specification_Suffix'Length + 1
1055                     ..
1056                    Separate_Suffix'Last) = Specification_Suffix
1057             then
1058                Error_Msg
1059                  ("Separate_Suffix (""" &
1060                   Separate_Suffix &
1061                   """) cannot end with" &
1062                   " Specification_Suffix (""" &
1063                   Specification_Suffix & """).",
1064                   Naming.Sep_Suffix_Loc);
1065             end if;
1066          end;
1067       end if;
1068
1069    end Check_Ada_Naming_Scheme;
1070
1071    ---------------
1072    -- Error_Msg --
1073    ---------------
1074
1075    procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr) is
1076
1077       Error_Buffer : String (1 .. 5_000);
1078       Error_Last   : Natural := 0;
1079       Msg_Name     : Natural := 0;
1080       First        : Positive := Msg'First;
1081
1082       procedure Add (C : Character);
1083       --  Add a character to the buffer
1084
1085       procedure Add (S : String);
1086       --  Add a string to the buffer
1087
1088       procedure Add (Id : Name_Id);
1089       --  Add a name to the buffer
1090
1091       ---------
1092       -- Add --
1093       ---------
1094
1095       procedure Add (C : Character) is
1096       begin
1097          Error_Last := Error_Last + 1;
1098          Error_Buffer (Error_Last) := C;
1099       end Add;
1100
1101       procedure Add (S : String) is
1102       begin
1103          Error_Buffer (Error_Last + 1 .. Error_Last + S'Length) := S;
1104          Error_Last := Error_Last + S'Length;
1105       end Add;
1106
1107       procedure Add (Id : Name_Id) is
1108       begin
1109          Get_Name_String (Id);
1110          Add (Name_Buffer (1 .. Name_Len));
1111       end Add;
1112
1113    --  Start of processing for Error_Msg
1114
1115    begin
1116       if Error_Report = null then
1117          Errout.Error_Msg (Msg, Flag_Location);
1118          return;
1119       end if;
1120
1121       if Msg (First) = '\' then
1122
1123          --  Continuation character, ignore.
1124
1125          First := First + 1;
1126
1127       elsif Msg (First) = '?' then
1128
1129          --  Warning character. It is always the first one,
1130          --  in this package.
1131
1132          First := First + 1;
1133          Add ("Warning: ");
1134       end if;
1135
1136       for Index in First .. Msg'Last loop
1137          if Msg (Index) = '{' or else Msg (Index) = '%' then
1138
1139             --  Include a name between double quotes.
1140
1141             Msg_Name := Msg_Name + 1;
1142             Add ('"');
1143
1144             case Msg_Name is
1145                when 1 => Add (Errout.Error_Msg_Name_1);
1146                when 2 => Add (Errout.Error_Msg_Name_2);
1147                when 3 => Add (Errout.Error_Msg_Name_3);
1148
1149                when others => null;
1150             end case;
1151
1152             Add ('"');
1153
1154          else
1155             Add (Msg (Index));
1156          end if;
1157
1158       end loop;
1159
1160       Error_Report (Error_Buffer (1 .. Error_Last), Current_Project);
1161    end Error_Msg;
1162
1163    ---------------------
1164    -- Get_Name_String --
1165    ---------------------
1166
1167    function Get_Name_String (S : String_Id) return String is
1168    begin
1169       if S = No_String then
1170          return "";
1171       else
1172          String_To_Name_Buffer (S);
1173          return Name_Buffer (1 .. Name_Len);
1174       end if;
1175    end Get_Name_String;
1176
1177    --------------
1178    -- Get_Unit --
1179    --------------
1180
1181    procedure Get_Unit
1182      (File_Name    : Name_Id;
1183       Naming       : Naming_Data;
1184       Unit_Name    : out Name_Id;
1185       Unit_Kind    : out Spec_Or_Body;
1186       Needs_Pragma : out Boolean)
1187    is
1188       Canonical_Case_Name : Name_Id;
1189
1190    begin
1191       Needs_Pragma := False;
1192       Get_Name_String (File_Name);
1193       Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1194       Canonical_Case_Name := Name_Find;
1195
1196       if Naming.Bodies /= No_Array_Element then
1197
1198          --  There are some specified file names for some bodies
1199          --  of this project. Find out if File_Name is one of these bodies.
1200
1201          declare
1202             Current : Array_Element_Id := Naming.Bodies;
1203             Element : Array_Element;
1204
1205          begin
1206             while Current /= No_Array_Element loop
1207                Element := Array_Elements.Table (Current);
1208
1209                if Element.Index /= No_Name then
1210                   String_To_Name_Buffer (Element.Value.Value);
1211                   Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1212
1213                   if Canonical_Case_Name = Name_Find then
1214
1215                      --  File_Name corresponds to one body.
1216                      --  So, we know it is a body, and we know the unit name.
1217
1218                      Unit_Kind := Body_Part;
1219                      Unit_Name := Element.Index;
1220                      Needs_Pragma := True;
1221                      return;
1222                   end if;
1223                end if;
1224
1225                Current := Element.Next;
1226             end loop;
1227          end;
1228       end if;
1229
1230       if Naming.Specifications /= No_Array_Element then
1231
1232          --  There are some specified file names for some bodiesspecifications
1233          --  of this project. Find out if File_Name is one of these
1234          --  specifications.
1235
1236          declare
1237             Current : Array_Element_Id := Naming.Specifications;
1238             Element : Array_Element;
1239
1240          begin
1241             while Current /= No_Array_Element loop
1242                Element := Array_Elements.Table (Current);
1243
1244                if Element.Index /= No_Name then
1245                   String_To_Name_Buffer (Element.Value.Value);
1246                   Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1247
1248                   if Canonical_Case_Name = Name_Find then
1249
1250                      --  File_Name corresponds to one specification.
1251                      --  So, we know it is a spec, and we know the unit name.
1252
1253                      Unit_Kind := Specification;
1254                      Unit_Name := Element.Index;
1255                      Needs_Pragma := True;
1256                      return;
1257                   end if;
1258
1259                end if;
1260
1261                Current := Element.Next;
1262             end loop;
1263          end;
1264       end if;
1265
1266       declare
1267          File  : String   := Get_Name_String (Canonical_Case_Name);
1268          First : Positive := File'First;
1269          Last  : Natural  := File'Last;
1270
1271          Standard_GNAT : Boolean :=
1272                            Naming.Current_Spec_Suffix =
1273                                          Default_Ada_Spec_Suffix
1274                              and then
1275                            Naming.Current_Impl_Suffix =
1276                                          Default_Ada_Impl_Suffix;
1277
1278       begin
1279          --  Check if the end of the file name is Specification_Append
1280
1281          Get_Name_String (Naming.Current_Spec_Suffix);
1282
1283          if File'Length > Name_Len
1284            and then File (Last - Name_Len + 1 .. Last) =
1285                                                 Name_Buffer (1 .. Name_Len)
1286          then
1287             --  We have a spec
1288
1289             Unit_Kind := Specification;
1290             Last := Last - Name_Len;
1291
1292             if Current_Verbosity = High then
1293                Write_Str  ("   Specification: ");
1294                Write_Line (File (First .. Last));
1295             end if;
1296
1297          else
1298             Get_Name_String (Naming.Current_Impl_Suffix);
1299
1300             --  Check if the end of the file name is Body_Append
1301
1302             if File'Length > Name_Len
1303               and then File (Last - Name_Len + 1 .. Last) =
1304                                                 Name_Buffer (1 .. Name_Len)
1305             then
1306                --  We have a body
1307
1308                Unit_Kind := Body_Part;
1309                Last := Last - Name_Len;
1310
1311                if Current_Verbosity = High then
1312                   Write_Str  ("   Body: ");
1313                   Write_Line (File (First .. Last));
1314                end if;
1315
1316             elsif Naming.Separate_Suffix /= Naming.Current_Spec_Suffix then
1317                Get_Name_String (Naming.Separate_Suffix);
1318
1319                --  Check if the end of the file name is Separate_Append
1320
1321                if File'Length > Name_Len
1322                  and then File (Last - Name_Len + 1 .. Last) =
1323                                                 Name_Buffer (1 .. Name_Len)
1324                then
1325                   --  We have a separate (a body)
1326
1327                   Unit_Kind := Body_Part;
1328                   Last := Last - Name_Len;
1329
1330                   if Current_Verbosity = High then
1331                      Write_Str  ("   Separate: ");
1332                      Write_Line (File (First .. Last));
1333                   end if;
1334
1335                else
1336                   Last := 0;
1337                end if;
1338
1339             else
1340                Last := 0;
1341             end if;
1342          end if;
1343
1344          if Last = 0 then
1345
1346             --  This is not a source file
1347
1348             Unit_Name := No_Name;
1349             Unit_Kind := Specification;
1350
1351             if Current_Verbosity = High then
1352                Write_Line ("   Not a valid file name.");
1353             end if;
1354
1355             return;
1356          end if;
1357
1358          Get_Name_String (Naming.Dot_Replacement);
1359          Standard_GNAT :=
1360            Standard_GNAT and then Name_Buffer (1 .. Name_Len) = "-";
1361
1362          if Name_Buffer (1 .. Name_Len) /= "." then
1363
1364             --  If Dot_Replacement is not a single dot,
1365             --  then there should not be any dot in the name.
1366
1367             for Index in First .. Last loop
1368                if File (Index) = '.' then
1369                   if Current_Verbosity = High then
1370                      Write_Line
1371                        ("   Not a valid file name (some dot not replaced).");
1372                   end if;
1373
1374                   Unit_Name := No_Name;
1375                   return;
1376
1377                end if;
1378             end loop;
1379
1380             --  Replace the substring Dot_Replacement with dots
1381
1382             declare
1383                Index : Positive := First;
1384
1385             begin
1386                while Index <= Last - Name_Len + 1 loop
1387
1388                   if File (Index .. Index + Name_Len - 1) =
1389                     Name_Buffer (1 .. Name_Len)
1390                   then
1391                      File (Index) := '.';
1392
1393                      if Name_Len > 1 and then Index < Last then
1394                         File (Index + 1 .. Last - Name_Len + 1) :=
1395                           File (Index + Name_Len .. Last);
1396                      end if;
1397
1398                      Last := Last - Name_Len + 1;
1399                   end if;
1400
1401                   Index := Index + 1;
1402                end loop;
1403             end;
1404          end if;
1405
1406          --  Check if the casing is right
1407
1408          declare
1409             Src : String := File (First .. Last);
1410
1411          begin
1412             case Naming.Casing is
1413                when All_Lower_Case =>
1414                   Fixed.Translate
1415                     (Source  => Src,
1416                      Mapping => Lower_Case_Map);
1417
1418                when All_Upper_Case =>
1419                   Fixed.Translate
1420                     (Source  => Src,
1421                      Mapping => Upper_Case_Map);
1422
1423                when Mixed_Case | Unknown =>
1424                   null;
1425             end case;
1426
1427             if Src /= File (First .. Last) then
1428                if Current_Verbosity = High then
1429                   Write_Line ("   Not a valid file name (casing).");
1430                end if;
1431
1432                Unit_Name := No_Name;
1433                return;
1434             end if;
1435
1436             --  We put the name in lower case
1437
1438             Fixed.Translate
1439               (Source  => Src,
1440                Mapping => Lower_Case_Map);
1441
1442             --  In the standard GNAT naming scheme, check for special cases:
1443             --  children or separates of A, G, I or S, and run time sources.
1444
1445             if Standard_GNAT and then Src'Length >= 3 then
1446                declare
1447                   S1 : constant Character := Src (Src'First);
1448                   S2 : constant Character := Src (Src'First + 1);
1449
1450                begin
1451                   if S1 = 'a' or else S1 = 'g'
1452                     or else S1 = 'i' or else S1 = 's'
1453                   then
1454                      --  Children or separates of packages A, G, I or S
1455
1456                      if (Hostparm.OpenVMS and then S2 = '$')
1457                        or else (not Hostparm.OpenVMS and then S2 = '~')
1458                      then
1459                         Src (Src'First + 1) := '.';
1460
1461                      --  If it is potentially a run time source, disable
1462                      --  filling of the mapping file to avoid warnings.
1463
1464                      elsif S2 = '.' then
1465                         Set_Mapping_File_Initial_State_To_Empty;
1466                      end if;
1467
1468                   end if;
1469                end;
1470             end if;
1471
1472             if Current_Verbosity = High then
1473                Write_Str  ("      ");
1474                Write_Line (Src);
1475             end if;
1476
1477             Name_Len := Src'Length;
1478             Name_Buffer (1 .. Name_Len) := Src;
1479
1480             --  Now, we check if this name is a valid unit name
1481
1482             Check_Ada_Name (Name => Name_Find, Unit => Unit_Name);
1483          end;
1484
1485       end;
1486
1487    end Get_Unit;
1488
1489    -----------------------
1490    -- Is_Illegal_Suffix --
1491    -----------------------
1492
1493    function Is_Illegal_Suffix
1494      (Suffix                          : String;
1495       Dot_Replacement_Is_A_Single_Dot : Boolean)
1496       return                            Boolean
1497    is
1498    begin
1499       if Suffix'Length = 0
1500         or else Is_Alphanumeric (Suffix (Suffix'First))
1501         or else Index (Suffix, ".") = 0
1502         or else (Suffix'Length >= 2
1503                  and then Suffix (Suffix'First) = '_'
1504                  and then Is_Alphanumeric (Suffix (Suffix'First + 1)))
1505       then
1506          return True;
1507       end if;
1508
1509       --  If dot replacement is a single dot, and first character of
1510       --  suffix is also a dot
1511
1512       if Dot_Replacement_Is_A_Single_Dot
1513         and then Suffix (Suffix'First) = '.'
1514       then
1515          for Index in Suffix'First + 1 .. Suffix'Last loop
1516
1517             --  If there is another dot
1518
1519             if Suffix (Index) = '.' then
1520
1521                --  It is illegal to have a letter following the initial dot
1522
1523                return Is_Letter (Suffix (Suffix'First + 1));
1524             end if;
1525          end loop;
1526       end if;
1527
1528       --  Everything is OK
1529
1530       return False;
1531    end Is_Illegal_Suffix;
1532
1533    --------------------------------
1534    -- Language_Independent_Check --
1535    --------------------------------
1536
1537    procedure Language_Independent_Check
1538      (Project      : Project_Id;
1539       Report_Error : Put_Line_Access)
1540    is
1541       Last_Source_Dir   : String_List_Id  := Nil_String;
1542       Data              : Project_Data    := Projects.Table (Project);
1543
1544       procedure Find_Source_Dirs (From : String_Id; Location : Source_Ptr);
1545       --  Find one or several source directories, and add them
1546       --  to the list of source directories of the project.
1547
1548       ----------------------
1549       -- Find_Source_Dirs --
1550       ----------------------
1551
1552       procedure Find_Source_Dirs (From : String_Id; Location : Source_Ptr) is
1553
1554          Directory    : String (1 .. Integer (String_Length (From)));
1555          Directory_Id : Name_Id;
1556          Element      : String_Element;
1557
1558          procedure Recursive_Find_Dirs (Path : String_Id);
1559          --  Find all the subdirectories (recursively) of Path
1560          --  and add them to the list of source directories
1561          --  of the project.
1562
1563          -------------------------
1564          -- Recursive_Find_Dirs --
1565          -------------------------
1566
1567          procedure Recursive_Find_Dirs (Path : String_Id) is
1568             Dir      : Dir_Type;
1569             Name     : String (1 .. 250);
1570             Last     : Natural;
1571             The_Path : String := Get_Name_String (Path) & Dir_Sep;
1572
1573             The_Path_Last : Positive := The_Path'Last;
1574
1575          begin
1576             if The_Path'Length > 1
1577               and then
1578                 (The_Path (The_Path_Last - 1) = Dir_Sep
1579                    or else The_Path (The_Path_Last - 1) = '/')
1580             then
1581                The_Path_Last := The_Path_Last - 1;
1582             end if;
1583
1584             Canonical_Case_File_Name (The_Path);
1585
1586             if Current_Verbosity = High then
1587                Write_Str  ("   ");
1588                Write_Line (The_Path (The_Path'First .. The_Path_Last));
1589             end if;
1590
1591             String_Elements.Increment_Last;
1592             Element :=
1593               (Value    => Path,
1594                Location => No_Location,
1595                Next     => Nil_String);
1596
1597             --  Case of first source directory
1598
1599             if Last_Source_Dir = Nil_String then
1600                Data.Source_Dirs := String_Elements.Last;
1601
1602             --  Here we already have source directories.
1603
1604             else
1605                --  Link the previous last to the new one
1606
1607                String_Elements.Table (Last_Source_Dir).Next :=
1608                  String_Elements.Last;
1609             end if;
1610
1611             --  And register this source directory as the new last
1612
1613             Last_Source_Dir  := String_Elements.Last;
1614             String_Elements.Table (Last_Source_Dir) := Element;
1615
1616             --  Now look for subdirectories
1617
1618             Open (Dir, The_Path (The_Path'First .. The_Path_Last));
1619
1620             loop
1621                Read (Dir, Name, Last);
1622                exit when Last = 0;
1623
1624                if Current_Verbosity = High then
1625                   Write_Str  ("   Checking ");
1626                   Write_Line (Name (1 .. Last));
1627                end if;
1628
1629                if Name (1 .. Last) /= "."
1630                  and then Name (1 .. Last) /= ".."
1631                then
1632                   --  Avoid . and ..
1633
1634                   declare
1635                      Path_Name : String :=
1636                                    The_Path (The_Path'First .. The_Path_Last) &
1637                                    Name (1 .. Last);
1638
1639                   begin
1640                      Canonical_Case_File_Name (Path_Name);
1641
1642                      if Is_Directory (Path_Name) then
1643
1644                         --  We have found a new subdirectory,
1645                         --  register it and find its own subdirectories.
1646
1647                         Start_String;
1648                         Store_String_Chars (Path_Name);
1649                         Recursive_Find_Dirs (End_String);
1650                      end if;
1651                   end;
1652                end if;
1653             end loop;
1654
1655             Close (Dir);
1656
1657          exception
1658             when Directory_Error =>
1659                null;
1660          end Recursive_Find_Dirs;
1661
1662          --  Start of processing for Find_Source_Dirs
1663
1664       begin
1665          if Current_Verbosity = High then
1666             Write_Str ("Find_Source_Dirs (""");
1667          end if;
1668
1669          String_To_Name_Buffer (From);
1670          Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1671          Directory    := Name_Buffer (1 .. Name_Len);
1672          Directory_Id := Name_Find;
1673
1674          if Current_Verbosity = High then
1675             Write_Str (Directory);
1676             Write_Line (""")");
1677          end if;
1678
1679          --  First, check if we are looking for a directory tree,
1680          --  indicated by "/**" at the end.
1681
1682          if Directory'Length >= 3
1683            and then Directory (Directory'Last - 1 .. Directory'Last) = "**"
1684            and then (Directory (Directory'Last - 2) = '/'
1685                        or else
1686                      Directory (Directory'Last - 2) = Dir_Sep)
1687          then
1688             Name_Len := Directory'Length - 3;
1689
1690             if Name_Len = 0 then
1691                --  This is the case of "/**": all directories
1692                --  in the file system.
1693
1694                Name_Len := 1;
1695                Name_Buffer (1) := Directory (Directory'First);
1696
1697             else
1698                Name_Buffer (1 .. Name_Len) :=
1699                  Directory (Directory'First .. Directory'Last - 3);
1700             end if;
1701
1702             if Current_Verbosity = High then
1703                Write_Str ("Looking for all subdirectories of """);
1704                Write_Str (Name_Buffer (1 .. Name_Len));
1705                Write_Line ("""");
1706             end if;
1707
1708             declare
1709                Base_Dir : constant Name_Id := Name_Find;
1710                Root     : constant Name_Id :=
1711                             Locate_Directory (Base_Dir, Data.Directory);
1712
1713             begin
1714                if Root = No_Name then
1715                   Errout.Error_Msg_Name_1 := Base_Dir;
1716                   if Location = No_Location then
1717                      Error_Msg ("{ is not a valid directory.", Data.Location);
1718                   else
1719                      Error_Msg ("{ is not a valid directory.", Location);
1720                   end if;
1721
1722                else
1723                   --  We have an existing directory,
1724                   --  we register it and all of its subdirectories.
1725
1726                   if Current_Verbosity = High then
1727                      Write_Line ("Looking for source directories:");
1728                   end if;
1729
1730                   Start_String;
1731                   Store_String_Chars (Get_Name_String (Root));
1732                   Recursive_Find_Dirs (End_String);
1733
1734                   if Current_Verbosity = High then
1735                      Write_Line ("End of looking for source directories.");
1736                   end if;
1737                end if;
1738             end;
1739
1740          --  We have a single directory
1741
1742          else
1743             declare
1744                Path_Name : constant Name_Id :=
1745                  Locate_Directory (Directory_Id, Data.Directory);
1746
1747             begin
1748                if Path_Name = No_Name then
1749                   Errout.Error_Msg_Name_1 := Directory_Id;
1750                   if Location = No_Location then
1751                      Error_Msg ("{ is not a valid directory", Data.Location);
1752                   else
1753                      Error_Msg ("{ is not a valid directory", Location);
1754                   end if;
1755                else
1756
1757                   --  As it is an existing directory, we add it to
1758                   --  the list of directories.
1759
1760                   String_Elements.Increment_Last;
1761                   Start_String;
1762                   Store_String_Chars (Get_Name_String (Path_Name));
1763                   Element.Value := End_String;
1764
1765                   if Last_Source_Dir = Nil_String then
1766
1767                      --  This is the first source directory
1768
1769                      Data.Source_Dirs := String_Elements.Last;
1770
1771                   else
1772                      --  We already have source directories,
1773                      --  link the previous last to the new one.
1774
1775                      String_Elements.Table (Last_Source_Dir).Next :=
1776                        String_Elements.Last;
1777                   end if;
1778
1779                   --  And register this source directory as the new last
1780
1781                   Last_Source_Dir := String_Elements.Last;
1782                   String_Elements.Table (Last_Source_Dir) := Element;
1783                end if;
1784             end;
1785          end if;
1786       end Find_Source_Dirs;
1787
1788       --  Start of processing for Language_Independent_Check
1789
1790    begin
1791
1792       if Data.Language_Independent_Checked then
1793          return;
1794       end if;
1795
1796       Data.Language_Independent_Checked := True;
1797
1798       Error_Report := Report_Error;
1799
1800       if Current_Verbosity = High then
1801          Write_Line ("Starting to look for directories");
1802       end if;
1803
1804       --  Check the object directory
1805
1806       declare
1807          Object_Dir : Variable_Value :=
1808                         Util.Value_Of (Name_Object_Dir, Data.Decl.Attributes);
1809
1810       begin
1811          pragma Assert (Object_Dir.Kind = Single,
1812                         "Object_Dir is not a single string");
1813
1814          --  We set the object directory to its default
1815
1816          Data.Object_Directory := Data.Directory;
1817
1818          if not String_Equal (Object_Dir.Value, Empty_String) then
1819
1820             String_To_Name_Buffer (Object_Dir.Value);
1821
1822             if Name_Len = 0 then
1823                Error_Msg ("Object_Dir cannot be empty",
1824                           Object_Dir.Location);
1825
1826             else
1827                --  We check that the specified object directory
1828                --  does exist.
1829
1830                Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1831
1832                declare
1833                   Dir_Id : constant Name_Id := Name_Find;
1834
1835                begin
1836                   Data.Object_Directory :=
1837                     Locate_Directory (Dir_Id, Data.Directory);
1838
1839                   if Data.Object_Directory = No_Name then
1840                      Errout.Error_Msg_Name_1 := Dir_Id;
1841                      Error_Msg
1842                        ("the object directory { cannot be found",
1843                         Data.Location);
1844                   end if;
1845                end;
1846             end if;
1847          end if;
1848       end;
1849
1850       if Current_Verbosity = High then
1851          if Data.Object_Directory = No_Name then
1852             Write_Line ("No object directory");
1853          else
1854             Write_Str ("Object directory: """);
1855             Write_Str (Get_Name_String (Data.Object_Directory));
1856             Write_Line ("""");
1857          end if;
1858       end if;
1859
1860       --  Check the exec directory
1861
1862       declare
1863          Exec_Dir : Variable_Value :=
1864                       Util.Value_Of (Name_Exec_Dir, Data.Decl.Attributes);
1865
1866       begin
1867          pragma Assert (Exec_Dir.Kind = Single,
1868                         "Exec_Dir is not a single string");
1869
1870          --  We set the object directory to its default
1871
1872          Data.Exec_Directory := Data.Object_Directory;
1873
1874          if not String_Equal (Exec_Dir.Value, Empty_String) then
1875
1876             String_To_Name_Buffer (Exec_Dir.Value);
1877
1878             if Name_Len = 0 then
1879                Error_Msg ("Exec_Dir cannot be empty",
1880                           Exec_Dir.Location);
1881
1882             else
1883                --  We check that the specified object directory
1884                --  does exist.
1885
1886                Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1887
1888                declare
1889                   Dir_Id : constant Name_Id := Name_Find;
1890
1891                begin
1892                   Data.Exec_Directory :=
1893                     Locate_Directory (Dir_Id, Data.Directory);
1894
1895                   if Data.Exec_Directory = No_Name then
1896                      Errout.Error_Msg_Name_1 := Dir_Id;
1897                      Error_Msg
1898                        ("the exec directory { cannot be found",
1899                         Data.Location);
1900                   end if;
1901                end;
1902             end if;
1903          end if;
1904       end;
1905
1906       if Current_Verbosity = High then
1907          if Data.Exec_Directory = No_Name then
1908             Write_Line ("No exec directory");
1909          else
1910             Write_Str ("Exec directory: """);
1911             Write_Str (Get_Name_String (Data.Exec_Directory));
1912             Write_Line ("""");
1913          end if;
1914       end if;
1915
1916       --  Look for the source directories
1917
1918       declare
1919          Source_Dirs : Variable_Value :=
1920            Util.Value_Of (Name_Source_Dirs, Data.Decl.Attributes);
1921
1922       begin
1923
1924          if Current_Verbosity = High then
1925             Write_Line ("Starting to look for source directories");
1926          end if;
1927
1928          pragma Assert (Source_Dirs.Kind = List,
1929                           "Source_Dirs is not a list");
1930
1931          if Source_Dirs.Default then
1932
1933             --  No Source_Dirs specified: the single source directory
1934             --  is the one containing the project file
1935
1936             String_Elements.Increment_Last;
1937             Data.Source_Dirs := String_Elements.Last;
1938             Start_String;
1939             Store_String_Chars (Get_Name_String (Data.Directory));
1940             String_Elements.Table (Data.Source_Dirs) :=
1941               (Value    => End_String,
1942                Location => No_Location,
1943                Next     => Nil_String);
1944
1945             if Current_Verbosity = High then
1946                Write_Line ("(Undefined) Single object directory:");
1947                Write_Str ("    """);
1948                Write_Str (Get_Name_String (Data.Directory));
1949                Write_Line ("""");
1950             end if;
1951
1952          elsif Source_Dirs.Values = Nil_String then
1953
1954             --  If Source_Dirs is an empty string list, this means
1955             --  that this project contains no source.
1956
1957             if Data.Object_Directory = Data.Directory then
1958                Data.Object_Directory := No_Name;
1959             end if;
1960
1961             Data.Source_Dirs     := Nil_String;
1962             Data.Sources_Present := False;
1963
1964          else
1965             declare
1966                Source_Dir : String_List_Id := Source_Dirs.Values;
1967                Element    : String_Element;
1968
1969             begin
1970                --  We will find the source directories for each
1971                --  element of the list
1972
1973                while Source_Dir /= Nil_String loop
1974                   Element := String_Elements.Table (Source_Dir);
1975                   Find_Source_Dirs (Element.Value, Element.Location);
1976                   Source_Dir := Element.Next;
1977                end loop;
1978             end;
1979          end if;
1980
1981          if Current_Verbosity = High then
1982             Write_Line ("Puting source directories in canonical cases");
1983          end if;
1984
1985          declare
1986             Current : String_List_Id := Data.Source_Dirs;
1987             Element : String_Element;
1988
1989          begin
1990             while Current /= Nil_String loop
1991                Element := String_Elements.Table (Current);
1992                if Element.Value /= No_String then
1993                   String_To_Name_Buffer (Element.Value);
1994                   Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1995                   Start_String;
1996                   Store_String_Chars (Name_Buffer (1 .. Name_Len));
1997                   Element.Value := End_String;
1998                   String_Elements.Table (Current) := Element;
1999                end if;
2000
2001                Current := Element.Next;
2002             end loop;
2003          end;
2004       end;
2005
2006       --  Library Dir, Name, Version and Kind
2007
2008       declare
2009          Attributes : constant Prj.Variable_Id := Data.Decl.Attributes;
2010
2011          Lib_Dir : Prj.Variable_Value :=
2012                      Prj.Util.Value_Of (Snames.Name_Library_Dir, Attributes);
2013
2014          Lib_Name : Prj.Variable_Value :=
2015                       Prj.Util.Value_Of (Snames.Name_Library_Name, Attributes);
2016
2017          Lib_Version : Prj.Variable_Value :=
2018                          Prj.Util.Value_Of
2019                            (Snames.Name_Library_Version, Attributes);
2020
2021          The_Lib_Kind : Prj.Variable_Value :=
2022                           Prj.Util.Value_Of
2023                             (Snames.Name_Library_Kind, Attributes);
2024
2025       begin
2026          pragma Assert (Lib_Dir.Kind = Single);
2027
2028          if Lib_Dir.Value = Empty_String then
2029
2030             if Current_Verbosity = High then
2031                Write_Line ("No library directory");
2032             end if;
2033
2034          else
2035             --  Find path name, check that it is a directory
2036
2037             Stringt.String_To_Name_Buffer (Lib_Dir.Value);
2038
2039             declare
2040                Dir_Id : constant Name_Id := Name_Find;
2041
2042             begin
2043                Data.Library_Dir :=
2044                  Locate_Directory (Dir_Id, Data.Directory);
2045
2046                if Data.Library_Dir = No_Name then
2047                   Error_Msg ("not an existing directory",
2048                              Lib_Dir.Location);
2049
2050                elsif Data.Library_Dir = Data.Object_Directory then
2051                   Error_Msg
2052                     ("library directory cannot be the same " &
2053                      "as object directory",
2054                      Lib_Dir.Location);
2055                   Data.Library_Dir := No_Name;
2056
2057                else
2058                   if Current_Verbosity = High then
2059                      Write_Str ("Library directory =""");
2060                      Write_Str (Get_Name_String (Data.Library_Dir));
2061                      Write_Line ("""");
2062                   end if;
2063                end if;
2064             end;
2065          end if;
2066
2067          pragma Assert (Lib_Name.Kind = Single);
2068
2069          if Lib_Name.Value = Empty_String then
2070             if Current_Verbosity = High then
2071                Write_Line ("No library name");
2072             end if;
2073
2074          else
2075             Stringt.String_To_Name_Buffer (Lib_Name.Value);
2076
2077             if not Is_Letter (Name_Buffer (1)) then
2078                Error_Msg ("must start with a letter",
2079                           Lib_Name.Location);
2080
2081             else
2082                Data.Library_Name := Name_Find;
2083
2084                for Index in 2 .. Name_Len loop
2085                   if not Is_Alphanumeric (Name_Buffer (Index)) then
2086                      Data.Library_Name := No_Name;
2087                      Error_Msg ("only letters and digits are allowed",
2088                                 Lib_Name.Location);
2089                      exit;
2090                   end if;
2091                end loop;
2092
2093                if Data.Library_Name /= No_Name
2094                  and then Current_Verbosity = High then
2095                   Write_Str ("Library name = """);
2096                   Write_Str (Get_Name_String (Data.Library_Name));
2097                   Write_Line ("""");
2098                end if;
2099             end if;
2100          end if;
2101
2102          Data.Library :=
2103            Data.Library_Dir /= No_Name
2104              and then
2105            Data.Library_Name /= No_Name;
2106
2107          if Data.Library then
2108
2109             if not MLib.Tgt.Libraries_Are_Supported then
2110                Error_Msg ("?libraries are not supported on this platform",
2111                           Lib_Name.Location);
2112                Data.Library := False;
2113
2114             else
2115                if Current_Verbosity = High then
2116                   Write_Line ("This is a library project file");
2117                end if;
2118
2119                pragma Assert (Lib_Version.Kind = Single);
2120
2121                if Lib_Version.Value = Empty_String then
2122                   if Current_Verbosity = High then
2123                      Write_Line ("No library version specified");
2124                   end if;
2125
2126                else
2127                   Stringt.String_To_Name_Buffer (Lib_Version.Value);
2128                   Data.Lib_Internal_Name := Name_Find;
2129                end if;
2130
2131                pragma Assert (The_Lib_Kind.Kind = Single);
2132
2133                if The_Lib_Kind.Value = Empty_String then
2134                   if Current_Verbosity = High then
2135                      Write_Line ("No library kind specified");
2136                   end if;
2137
2138                else
2139                   Stringt.String_To_Name_Buffer (The_Lib_Kind.Value);
2140
2141                   declare
2142                      Kind_Name : constant String :=
2143                                    To_Lower (Name_Buffer (1 .. Name_Len));
2144
2145                      OK : Boolean := True;
2146
2147                   begin
2148                      if Kind_Name = "static" then
2149                         Data.Library_Kind := Static;
2150
2151                      elsif Kind_Name = "dynamic" then
2152                         Data.Library_Kind := Dynamic;
2153
2154                      elsif Kind_Name = "relocatable" then
2155                         Data.Library_Kind := Relocatable;
2156
2157                      else
2158                         Error_Msg
2159                           ("illegal value for Library_Kind",
2160                            The_Lib_Kind.Location);
2161                         OK := False;
2162                      end if;
2163
2164                      if Current_Verbosity = High and then OK then
2165                         Write_Str ("Library kind = ");
2166                         Write_Line (Kind_Name);
2167                      end if;
2168                   end;
2169                end if;
2170             end if;
2171          end if;
2172       end;
2173
2174       if Current_Verbosity = High then
2175          Show_Source_Dirs (Project);
2176       end if;
2177
2178       declare
2179          Naming_Id : constant Package_Id :=
2180                        Util.Value_Of (Name_Naming, Data.Decl.Packages);
2181
2182          Naming    : Package_Element;
2183
2184       begin
2185          --  If there is a package Naming, we will put in Data.Naming
2186          --  what is in this package Naming.
2187
2188          if Naming_Id /= No_Package then
2189             Naming := Packages.Table (Naming_Id);
2190
2191             if Current_Verbosity = High then
2192                Write_Line ("Checking ""Naming"".");
2193             end if;
2194
2195             --  Check Specification_Suffix
2196
2197             declare
2198                Spec_Suffixs : Array_Element_Id :=
2199                                 Util.Value_Of
2200                                   (Name_Specification_Suffix,
2201                                    Naming.Decl.Arrays);
2202                Suffix  : Array_Element_Id;
2203                Element : Array_Element;
2204                Suffix2 : Array_Element_Id;
2205
2206             begin
2207                --  If some suffixs have been specified, we make sure that
2208                --  for each language for which a default suffix has been
2209                --  specified, there is a suffix specified, either the one
2210                --  in the project file or if there were noe, the default.
2211
2212                if Spec_Suffixs /= No_Array_Element then
2213                   Suffix := Data.Naming.Specification_Suffix;
2214
2215                   while Suffix /= No_Array_Element loop
2216                      Element := Array_Elements.Table (Suffix);
2217                      Suffix2 := Spec_Suffixs;
2218
2219                      while Suffix2 /= No_Array_Element loop
2220                         exit when Array_Elements.Table (Suffix2).Index =
2221                           Element.Index;
2222                         Suffix2 := Array_Elements.Table (Suffix2).Next;
2223                      end loop;
2224
2225                      --  There is a registered default suffix, but no
2226                      --  suffix specified in the project file.
2227                      --  Add the default to the array.
2228
2229                      if Suffix2 = No_Array_Element then
2230                         Array_Elements.Increment_Last;
2231                         Array_Elements.Table (Array_Elements.Last) :=
2232                           (Index => Element.Index,
2233                            Value => Element.Value,
2234                            Next  => Spec_Suffixs);
2235                         Spec_Suffixs := Array_Elements.Last;
2236                      end if;
2237
2238                      Suffix := Element.Next;
2239                   end loop;
2240
2241                   --  Put the resulting array as the specification suffixs
2242
2243                   Data.Naming.Specification_Suffix := Spec_Suffixs;
2244                end if;
2245             end;
2246
2247             declare
2248                Current : Array_Element_Id := Data.Naming.Specification_Suffix;
2249                Element : Array_Element;
2250
2251             begin
2252                while Current /= No_Array_Element loop
2253                   Element := Array_Elements.Table (Current);
2254                   String_To_Name_Buffer (Element.Value.Value);
2255
2256                   if Name_Len = 0 then
2257                      Error_Msg
2258                        ("Specification_Suffix cannot be empty",
2259                         Element.Value.Location);
2260                   end if;
2261
2262                   Array_Elements.Table (Current) := Element;
2263                   Current := Element.Next;
2264                end loop;
2265             end;
2266
2267             --  Check Implementation_Suffix
2268
2269             declare
2270                Impl_Suffixs : Array_Element_Id :=
2271                  Util.Value_Of
2272                    (Name_Implementation_Suffix,
2273                     Naming.Decl.Arrays);
2274                Suffix  : Array_Element_Id;
2275                Element : Array_Element;
2276                Suffix2 : Array_Element_Id;
2277             begin
2278                --  If some suffixs have been specified, we make sure that
2279                --  for each language for which a default suffix has been
2280                --  specified, there is a suffix specified, either the one
2281                --  in the project file or if there were noe, the default.
2282
2283                if Impl_Suffixs /= No_Array_Element then
2284                   Suffix := Data.Naming.Implementation_Suffix;
2285
2286                   while Suffix /= No_Array_Element loop
2287                      Element := Array_Elements.Table (Suffix);
2288                      Suffix2 := Impl_Suffixs;
2289
2290                      while Suffix2 /= No_Array_Element loop
2291                         exit when Array_Elements.Table (Suffix2).Index =
2292                           Element.Index;
2293                         Suffix2 := Array_Elements.Table (Suffix2).Next;
2294                      end loop;
2295
2296                      --  There is a registered default suffix, but no
2297                      --  suffix specified in the project file.
2298                      --  Add the default to the array.
2299
2300                      if Suffix2 = No_Array_Element then
2301                         Array_Elements.Increment_Last;
2302                         Array_Elements.Table (Array_Elements.Last) :=
2303                           (Index => Element.Index,
2304                            Value => Element.Value,
2305                            Next  => Impl_Suffixs);
2306                         Impl_Suffixs := Array_Elements.Last;
2307                      end if;
2308
2309                      Suffix := Element.Next;
2310                   end loop;
2311
2312                   --  Put the resulting array as the implementation suffixs
2313
2314                   Data.Naming.Implementation_Suffix := Impl_Suffixs;
2315                end if;
2316             end;
2317
2318             declare
2319                Current : Array_Element_Id := Data.Naming.Implementation_Suffix;
2320                Element : Array_Element;
2321
2322             begin
2323                while Current /= No_Array_Element loop
2324                   Element := Array_Elements.Table (Current);
2325                   String_To_Name_Buffer (Element.Value.Value);
2326
2327                   if Name_Len = 0 then
2328                      Error_Msg
2329                        ("Implementation_Suffix cannot be empty",
2330                         Element.Value.Location);
2331                   end if;
2332
2333                   Array_Elements.Table (Current) := Element;
2334                   Current := Element.Next;
2335                end loop;
2336             end;
2337
2338             --  Get the exceptions, if any
2339
2340             Data.Naming.Specification_Exceptions :=
2341               Util.Value_Of
2342                 (Name_Specification_Exceptions,
2343                  In_Arrays => Naming.Decl.Arrays);
2344
2345             Data.Naming.Implementation_Exceptions :=
2346               Util.Value_Of
2347                 (Name_Implementation_Exceptions,
2348                  In_Arrays => Naming.Decl.Arrays);
2349          end if;
2350       end;
2351
2352       Projects.Table (Project) := Data;
2353    end Language_Independent_Check;
2354
2355    ----------------------
2356    -- Locate_Directory --
2357    ----------------------
2358
2359    function Locate_Directory
2360      (Name   : Name_Id;
2361       Parent : Name_Id)
2362       return   Name_Id
2363    is
2364       The_Name   : constant String := Get_Name_String (Name);
2365       The_Parent : constant String :=
2366                      Get_Name_String (Parent) & Dir_Sep;
2367
2368       The_Parent_Last : Positive := The_Parent'Last;
2369
2370    begin
2371       if The_Parent'Length > 1
2372         and then (The_Parent (The_Parent_Last - 1) = Dir_Sep
2373                     or else The_Parent (The_Parent_Last - 1) = '/')
2374       then
2375          The_Parent_Last := The_Parent_Last - 1;
2376       end if;
2377
2378       if Current_Verbosity = High then
2379          Write_Str ("Locate_Directory (""");
2380          Write_Str (The_Name);
2381          Write_Str (""", """);
2382          Write_Str (The_Parent);
2383          Write_Line (""")");
2384       end if;
2385
2386       if Is_Absolute_Path (The_Name) then
2387          if Is_Directory (The_Name) then
2388             return Name;
2389          end if;
2390
2391       else
2392          declare
2393             Full_Path : constant String :=
2394                           The_Parent (The_Parent'First .. The_Parent_Last) &
2395                                                                      The_Name;
2396
2397          begin
2398             if Is_Directory (Full_Path) then
2399                Name_Len := Full_Path'Length;
2400                Name_Buffer (1 .. Name_Len) := Full_Path;
2401                return Name_Find;
2402             end if;
2403          end;
2404
2405       end if;
2406
2407       return No_Name;
2408    end Locate_Directory;
2409
2410    ------------------
2411    -- Path_Name_Of --
2412    ------------------
2413
2414    function Path_Name_Of
2415      (File_Name : String_Id;
2416       Directory : Name_Id)
2417       return      String
2418    is
2419       Result : String_Access;
2420       The_Directory : constant String := Get_Name_String (Directory);
2421
2422    begin
2423       String_To_Name_Buffer (File_Name);
2424       Result := Locate_Regular_File
2425         (File_Name => Name_Buffer (1 .. Name_Len),
2426          Path      => The_Directory);
2427
2428       if Result = null then
2429          return "";
2430       else
2431          Canonical_Case_File_Name (Result.all);
2432          return Result.all;
2433       end if;
2434    end Path_Name_Of;
2435
2436    -------------------
2437    -- Record_Source --
2438    -------------------
2439
2440    procedure Record_Source
2441      (File_Name          : Name_Id;
2442       Path_Name          : Name_Id;
2443       Project            : Project_Id;
2444       Data               : in out Project_Data;
2445       Location           : Source_Ptr;
2446       Current_Source     : in out String_List_Id)
2447    is
2448       Unit_Name    : Name_Id;
2449       Unit_Kind    : Spec_Or_Body;
2450       Needs_Pragma : Boolean;
2451       The_Location : Source_Ptr := Location;
2452
2453    begin
2454       --  Find out the unit name, the unit kind and if it needs
2455       --  a specific SFN pragma.
2456
2457       Get_Unit
2458         (File_Name    => File_Name,
2459          Naming       => Data.Naming,
2460          Unit_Name    => Unit_Name,
2461          Unit_Kind    => Unit_Kind,
2462          Needs_Pragma => Needs_Pragma);
2463
2464       if Unit_Name = No_Name then
2465          if Current_Verbosity = High then
2466             Write_Str  ("   """);
2467             Write_Str  (Get_Name_String (File_Name));
2468             Write_Line (""" is not a valid source file name (ignored).");
2469          end if;
2470
2471       else
2472          --  Put the file name in the list of sources of the project
2473
2474          String_Elements.Increment_Last;
2475          Get_Name_String (File_Name);
2476          Start_String;
2477          Store_String_Chars (Name_Buffer (1 .. Name_Len));
2478          String_Elements.Table (String_Elements.Last) :=
2479            (Value    => End_String,
2480             Location => No_Location,
2481             Next     => Nil_String);
2482
2483          if Current_Source = Nil_String then
2484             Data.Sources := String_Elements.Last;
2485
2486          else
2487             String_Elements.Table (Current_Source).Next :=
2488               String_Elements.Last;
2489          end if;
2490
2491          Current_Source := String_Elements.Last;
2492
2493          --  Put the unit in unit list
2494
2495          declare
2496             The_Unit      : Unit_Id := Units_Htable.Get (Unit_Name);
2497             The_Unit_Data : Unit_Data;
2498
2499          begin
2500             if Current_Verbosity = High then
2501                Write_Str  ("Putting ");
2502                Write_Str  (Get_Name_String (Unit_Name));
2503                Write_Line (" in the unit list.");
2504             end if;
2505
2506             --  The unit is already in the list, but may be it is
2507             --  only the other unit kind (spec or body), or what is
2508             --  in the unit list is a unit of a project we are extending.
2509
2510             if The_Unit /= Prj.Com.No_Unit then
2511                The_Unit_Data := Units.Table (The_Unit);
2512
2513                if The_Unit_Data.File_Names (Unit_Kind).Name = No_Name
2514                  or else (Data.Modifies /= No_Project
2515                             and then
2516                           The_Unit_Data.File_Names (Unit_Kind).Project =
2517                                                             Data.Modifies)
2518                then
2519                   The_Unit_Data.File_Names (Unit_Kind) :=
2520                     (Name         => File_Name,
2521                      Path         => Path_Name,
2522                      Project      => Project,
2523                      Needs_Pragma => Needs_Pragma);
2524                   Units.Table (The_Unit) := The_Unit_Data;
2525
2526                else
2527                   --  It is an error to have two units with the same name
2528                   --  and the same kind (spec or body).
2529
2530                   if The_Location = No_Location then
2531                      The_Location := Projects.Table (Project).Location;
2532                   end if;
2533
2534                   Errout.Error_Msg_Name_1 := Unit_Name;
2535                   Error_Msg ("duplicate source {", The_Location);
2536
2537                   Errout.Error_Msg_Name_1 :=
2538                     Projects.Table
2539                       (The_Unit_Data.File_Names (Unit_Kind).Project).Name;
2540                   Errout.Error_Msg_Name_2 :=
2541                     The_Unit_Data.File_Names (Unit_Kind).Path;
2542                   Error_Msg ("\   project file {, {", The_Location);
2543
2544                   Errout.Error_Msg_Name_1 := Projects.Table (Project).Name;
2545                   Errout.Error_Msg_Name_2 := Path_Name;
2546                   Error_Msg ("\   project file {, {", The_Location);
2547
2548                end if;
2549
2550             --  It is a new unit, create a new record
2551
2552             else
2553                Units.Increment_Last;
2554                The_Unit := Units.Last;
2555                Units_Htable.Set (Unit_Name, The_Unit);
2556                The_Unit_Data.Name := Unit_Name;
2557                The_Unit_Data.File_Names (Unit_Kind) :=
2558                  (Name         => File_Name,
2559                   Path         => Path_Name,
2560                   Project      => Project,
2561                   Needs_Pragma => Needs_Pragma);
2562                Units.Table (The_Unit) := The_Unit_Data;
2563             end if;
2564          end;
2565       end if;
2566    end Record_Source;
2567
2568    ----------------------
2569    -- Show_Source_Dirs --
2570    ----------------------
2571
2572    procedure Show_Source_Dirs (Project : Project_Id) is
2573       Current : String_List_Id := Projects.Table (Project).Source_Dirs;
2574       Element : String_Element;
2575
2576    begin
2577       Write_Line ("Source_Dirs:");
2578
2579       while Current /= Nil_String loop
2580          Element := String_Elements.Table (Current);
2581          Write_Str  ("   ");
2582          Write_Line (Get_Name_String (Element.Value));
2583          Current := Element.Next;
2584       end loop;
2585
2586       Write_Line ("end Source_Dirs.");
2587    end Show_Source_Dirs;
2588
2589 end Prj.Nmsc;