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