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