gcc/ada/prj-env.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              P R J . E N V                               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                            $Revision: 1.5 $
  10 --                                                                          --
  11 --             Copyright (C) 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 GNAT.OS_Lib; use GNAT.OS_Lib;
  30 with Namet;       use Namet;
  31 with Opt;
  32 with Osint;       use Osint;
  33 with Output;      use Output;
  34 with Prj.Com;     use Prj.Com;
  35 with Prj.Util;
  36 with Snames;      use Snames;
  37 with Stringt;     use Stringt;
  38 with Table;
  39
  40 package body Prj.Env is
  41
  42    type Naming_Id is new Nat;
  43    No_Naming : constant Naming_Id := 0;
  44
  45    Ada_Path_Buffer : String_Access := new String (1 .. 1_000);
  46    --  A buffer where values for ADA_INCLUDE_PATH
  47    --  and ADA_OBJECTS_PATH are stored.
  48
  49    Ada_Path_Length : Natural := 0;
  50    --  Index of the last valid character in Ada_Path_Buffer.
  51
  52    package Namings is new Table.Table (
  53      Table_Component_Type => Naming_Data,
  54      Table_Index_Type     => Naming_Id,
  55      Table_Low_Bound      => 1,
  56      Table_Initial        => 5,
  57      Table_Increment      => 100,
  58      Table_Name           => "Prj.Env.Namings");
  59
  60    Default_Naming : constant Naming_Id := Namings.First;
  61
  62    Global_Configuration_Pragmas : Name_Id;
  63    Local_Configuration_Pragmas  : Name_Id;
  64
  65    -----------------------
  66    -- Local Subprograms --
  67    -----------------------
  68
  69    function Body_Path_Name_Of (Unit : Unit_Id) return String;
  70    --  Returns the path name of the body of a unit.
  71    --  Compute it first, if necessary.
  72
  73    function Spec_Path_Name_Of (Unit : Unit_Id) return String;
  74    --  Returns the path name of the spec of a unit.
  75    --  Compute it first, if necessary.
  76
  77    procedure Add_To_Path (Path : String);
  78    --  Add Path to global variable Ada_Path_Buffer
  79    --  Increment Ada_Path_Length
  80
  81    ----------------------
  82    -- Ada_Include_Path --
  83    ----------------------
  84
  85    function Ada_Include_Path (Project : Project_Id) return String_Access is
  86
  87       procedure Add (Project : Project_Id);
  88       --  Add all the source directories of a project to the path,
  89       --  only if this project has not been visited.
  90       --  Call itself recursively for projects being modified,
  91       --  and imported projects.
  92       --  Add the project to the list Seen if this is the first time
  93       --  we call Add for this project.
  94
  95       ---------
  96       -- Add --
  97       ---------
  98
  99       procedure Add (Project : Project_Id) is
 100       begin
 101          --  If Seen is empty, then the project cannot have been
 102          --  visited.
 103
 104          if not Projects.Table (Project).Seen then
 105             Projects.Table (Project).Seen := True;
 106
 107             declare
 108                Data : Project_Data := Projects.Table (Project);
 109                List : Project_List := Data.Imported_Projects;
 110
 111                Current : String_List_Id := Data.Source_Dirs;
 112                Source_Dir : String_Element;
 113
 114             begin
 115                --  Add to path all source directories of this project
 116
 117                while Current /= Nil_String loop
 118                   if Ada_Path_Length > 0 then
 119                      Add_To_Path (Path => (1 => Path_Separator));
 120                   end if;
 121
 122                   Source_Dir := String_Elements.Table (Current);
 123                   String_To_Name_Buffer (Source_Dir.Value);
 124
 125                   declare
 126                      New_Path : constant String :=
 127                        Name_Buffer (1 .. Name_Len);
 128                   begin
 129                      Add_To_Path (New_Path);
 130                   end;
 131
 132                   Current := Source_Dir.Next;
 133                end loop;
 134
 135                --  Call Add to the project being modified, if any
 136
 137                if Data.Modifies /= No_Project then
 138                   Add (Data.Modifies);
 139                end if;
 140
 141                --  Call Add for each imported project, if any
 142
 143                while List /= Empty_Project_List loop
 144                   Add (Project_Lists.Table (List).Project);
 145                   List := Project_Lists.Table (List).Next;
 146                end loop;
 147             end;
 148          end if;
 149
 150       end Add;
 151
 152    --  Start of processing for Ada_Include_Path
 153
 154    begin
 155       --  If it is the first time we call this function for
 156       --  this project, compute the source path
 157
 158       if Projects.Table (Project).Include_Path = null then
 159          Ada_Path_Length := 0;
 160
 161          for Index in 1 .. Projects.Last loop
 162             Projects.Table (Index).Seen := False;
 163          end loop;
 164
 165          Add (Project);
 166          Projects.Table (Project).Include_Path :=
 167            new String'(Ada_Path_Buffer (1 .. Ada_Path_Length));
 168       end if;
 169
 170       return Projects.Table (Project).Include_Path;
 171    end Ada_Include_Path;
 172
 173    ----------------------
 174    -- Ada_Objects_Path --
 175    ----------------------
 176
 177    function Ada_Objects_Path
 178      (Project             : Project_Id;
 179       Including_Libraries : Boolean := True)
 180      return String_Access is
 181
 182       procedure Add (Project : Project_Id);
 183       --  Add all the object directory of a project to the path,
 184       --  only if this project has not been visited.
 185       --  Call itself recursively for projects being modified,
 186       --  and imported projects.
 187       --  Add the project to the list Seen if this is the first time
 188       --  we call Add for this project.
 189
 190       ---------
 191       -- Add --
 192       ---------
 193
 194       procedure Add (Project : Project_Id) is
 195       begin
 196
 197          --  If this project has not been seen yet
 198
 199          if not Projects.Table (Project).Seen then
 200             Projects.Table (Project).Seen := True;
 201
 202             declare
 203                Data : Project_Data := Projects.Table (Project);
 204                List : Project_List := Data.Imported_Projects;
 205
 206             begin
 207                --  Add to path the object directory of this project
 208                --  except if we don't include library project and
 209                --  this is a library project.
 210
 211                if (Data.Library and then Including_Libraries)
 212                  or else
 213                  (Data.Object_Directory /= No_Name
 214                    and then
 215                    (not Including_Libraries or else not Data.Library))
 216                then
 217                   if Ada_Path_Length > 0 then
 218                      Add_To_Path (Path => (1 => Path_Separator));
 219                   end if;
 220
 221                   --  For a library project, att the library directory
 222
 223                   if Data.Library then
 224                      declare
 225                         New_Path : constant String :=
 226                           Get_Name_String (Data.Library_Dir);
 227                      begin
 228                         Add_To_Path (New_Path);
 229                      end;
 230                   else
 231
 232                      --  For a non library project, add the object directory
 233                      declare
 234                         New_Path : constant String :=
 235                           Get_Name_String (Data.Object_Directory);
 236                      begin
 237                         Add_To_Path (New_Path);
 238                      end;
 239                   end if;
 240                end if;
 241
 242                --  Call Add to the project being modified, if any
 243
 244                if Data.Modifies /= No_Project then
 245                   Add (Data.Modifies);
 246                end if;
 247
 248                --  Call Add for each imported project, if any
 249
 250                while List /= Empty_Project_List loop
 251                   Add (Project_Lists.Table (List).Project);
 252                   List := Project_Lists.Table (List).Next;
 253                end loop;
 254             end;
 255
 256          end if;
 257       end Add;
 258
 259    --  Start of processing for Ada_Objects_Path
 260
 261    begin
 262       --  If it is the first time we call this function for
 263       --  this project, compute the objects path
 264
 265       if Projects.Table (Project).Objects_Path = null then
 266          Ada_Path_Length := 0;
 267
 268          for Index in 1 .. Projects.Last loop
 269             Projects.Table (Index).Seen := False;
 270          end loop;
 271
 272          Add (Project);
 273          Projects.Table (Project).Objects_Path :=
 274            new String'(Ada_Path_Buffer (1 .. Ada_Path_Length));
 275       end if;
 276
 277       return Projects.Table (Project).Objects_Path;
 278    end Ada_Objects_Path;
 279
 280    -----------------
 281    -- Add_To_Path --
 282    -----------------
 283
 284    procedure Add_To_Path (Path : String) is
 285    begin
 286       --  If Ada_Path_Buffer is too small, double it
 287
 288       if Ada_Path_Length + Path'Length > Ada_Path_Buffer'Last then
 289          declare
 290             New_Ada_Path_Buffer : constant String_Access :=
 291                                     new String
 292                                       (1 .. Ada_Path_Buffer'Last +
 293                                                  Ada_Path_Buffer'Last);
 294
 295          begin
 296             New_Ada_Path_Buffer (1 .. Ada_Path_Length) :=
 297               Ada_Path_Buffer (1 .. Ada_Path_Length);
 298             Ada_Path_Buffer := New_Ada_Path_Buffer;
 299          end;
 300       end if;
 301
 302       Ada_Path_Buffer
 303         (Ada_Path_Length + 1 .. Ada_Path_Length + Path'Length) := Path;
 304       Ada_Path_Length := Ada_Path_Length + Path'Length;
 305    end Add_To_Path;
 306
 307    -----------------------
 308    -- Body_Path_Name_Of --
 309    -----------------------
 310
 311    function Body_Path_Name_Of (Unit : Unit_Id) return String is
 312       Data : Unit_Data := Units.Table (Unit);
 313
 314    begin
 315       --  If we don't know the path name of the body of this unit,
 316       --  we compute it, and we store it.
 317
 318       if Data.File_Names (Body_Part).Path = No_Name then
 319          declare
 320             Current_Source : String_List_Id :=
 321               Projects.Table (Data.File_Names (Body_Part).Project).Sources;
 322             Path : GNAT.OS_Lib.String_Access;
 323
 324          begin
 325             --  By default, put the file name
 326
 327             Data.File_Names (Body_Part).Path :=
 328               Data.File_Names (Body_Part).Name;
 329
 330             --  For each source directory
 331
 332             while Current_Source /= Nil_String loop
 333                String_To_Name_Buffer
 334                  (String_Elements.Table (Current_Source).Value);
 335                Path :=
 336                  Locate_Regular_File
 337                  (Namet.Get_Name_String
 338                   (Data.File_Names (Body_Part).Name),
 339                   Name_Buffer (1 .. Name_Len));
 340
 341                --  If the file is in this directory,
 342                --  then we store the path, and we are done.
 343
 344                if Path /= null then
 345                   Name_Len := Path'Length;
 346                   Name_Buffer (1 .. Name_Len) := Path.all;
 347                   Data.File_Names (Body_Part).Path := Name_Enter;
 348                   exit;
 349
 350                else
 351                   Current_Source :=
 352                     String_Elements.Table (Current_Source).Next;
 353                end if;
 354             end loop;
 355
 356             Units.Table (Unit) := Data;
 357          end;
 358       end if;
 359
 360       --  Returned the value stored
 361
 362       return Namet.Get_Name_String (Data.File_Names (Body_Part).Path);
 363    end Body_Path_Name_Of;
 364
 365    --------------------------------
 366    -- Create_Config_Pragmas_File --
 367    --------------------------------
 368
 369    procedure Create_Config_Pragmas_File
 370      (For_Project  : Project_Id;
 371       Main_Project : Project_Id)
 372    is
 373       File_Name : Temp_File_Name;
 374       File      : File_Descriptor := Invalid_FD;
 375
 376       The_Packages : Package_Id;
 377       Gnatmake     : Prj.Package_Id;
 378       Compiler     : Prj.Package_Id;
 379
 380       Current_Unit : Unit_Id := Units.First;
 381
 382       First_Project : Project_List := Empty_Project_List;
 383
 384       Current_Project : Project_List;
 385       Current_Naming  : Naming_Id;
 386
 387       Global_Attribute : Variable_Value := Nil_Variable_Value;
 388       Local_Attribute  : Variable_Value := Nil_Variable_Value;
 389
 390       Global_Attribute_Present : Boolean := False;
 391       Local_Attribute_Present  : Boolean := False;
 392
 393       procedure Check (Project : Project_Id);
 394
 395       procedure Check_Temp_File;
 396       --  Check that a temporary file has been opened.
 397       --  If not, create one, and put its name in the project data,
 398       --  with the indication that it is a temporary file.
 399
 400       procedure Copy_File (Name : String_Id);
 401       --  Copy a configuration pragmas file into the temp file.
 402
 403       procedure Put
 404         (Unit_Name : Name_Id;
 405          File_Name : Name_Id;
 406          Unit_Kind : Spec_Or_Body);
 407       --  Put an SFN pragma in the temporary file.
 408
 409       procedure Put (File : File_Descriptor; S : String);
 410
 411       procedure Put_Line (File : File_Descriptor; S : String);
 412
 413       -----------
 414       -- Check --
 415       -----------
 416
 417       procedure Check (Project : Project_Id) is
 418          Data : constant Project_Data := Projects.Table (Project);
 419
 420       begin
 421          if Current_Verbosity = High then
 422             Write_Str ("Checking project file """);
 423             Write_Str (Namet.Get_Name_String (Data.Name));
 424             Write_Str (""".");
 425             Write_Eol;
 426          end if;
 427
 428          --  Is this project in the list of the visited project?
 429
 430          Current_Project := First_Project;
 431          while Current_Project /= Empty_Project_List
 432            and then Project_Lists.Table (Current_Project).Project /= Project
 433          loop
 434             Current_Project := Project_Lists.Table (Current_Project).Next;
 435          end loop;
 436
 437          --  If it is not, put it in the list, and visit it
 438
 439          if Current_Project = Empty_Project_List then
 440             Project_Lists.Increment_Last;
 441             Project_Lists.Table (Project_Lists.Last) :=
 442               (Project => Project, Next => First_Project);
 443             First_Project := Project_Lists.Last;
 444
 445             --  Is the naming scheme of this project one that we know?
 446
 447             Current_Naming := Default_Naming;
 448             while Current_Naming <= Namings.Last and then
 449               not Same_Naming_Scheme
 450               (Left => Namings.Table (Current_Naming),
 451                Right => Data.Naming) loop
 452                Current_Naming := Current_Naming + 1;
 453             end loop;
 454
 455             --  If we don't know it, add it
 456
 457             if Current_Naming > Namings.Last then
 458                Namings.Increment_Last;
 459                Namings.Table (Namings.Last) := Data.Naming;
 460
 461                --  We need a temporary file to be created
 462
 463                Check_Temp_File;
 464
 465                --  Put the SFN pragmas for the naming scheme
 466
 467                --  Spec
 468
 469                Put_Line
 470                  (File, "pragma Source_File_Name");
 471                Put_Line
 472                  (File, "  (Spec_File_Name  => ""*" &
 473                   Namet.Get_Name_String (Data.Naming.Current_Spec_Suffix) &
 474                   """,");
 475                Put_Line
 476                  (File, "   Casing          => " &
 477                   Image (Data.Naming.Casing) & ",");
 478                Put_Line
 479                  (File, "   Dot_Replacement => """ &
 480                  Namet.Get_Name_String (Data.Naming.Dot_Replacement) &
 481                   """);");
 482
 483                --  and body
 484
 485                Put_Line
 486                  (File, "pragma Source_File_Name");
 487                Put_Line
 488                  (File, "  (Body_File_Name  => ""*" &
 489                   Namet.Get_Name_String (Data.Naming.Current_Impl_Suffix) &
 490                   """,");
 491                Put_Line
 492                  (File, "   Casing          => " &
 493                   Image (Data.Naming.Casing) & ",");
 494                Put_Line
 495                  (File, "   Dot_Replacement => """ &
 496                   Namet.Get_Name_String (Data.Naming.Dot_Replacement) &
 497                   """);");
 498
 499                --  and maybe separate
 500
 501                if
 502                  Data.Naming.Current_Impl_Suffix /= Data.Naming.Separate_Suffix
 503                then
 504                   Put_Line
 505                     (File, "pragma Source_File_Name");
 506                   Put_Line
 507                     (File, "  (Subunit_File_Name  => ""*" &
 508                      Namet.Get_Name_String (Data.Naming.Separate_Suffix) &
 509                      """,");
 510                   Put_Line
 511                     (File, "   Casing          => " &
 512                      Image (Data.Naming.Casing) &
 513                      ",");
 514                   Put_Line
 515                     (File, "   Dot_Replacement => """ &
 516                      Namet.Get_Name_String (Data.Naming.Dot_Replacement) &
 517                      """);");
 518                end if;
 519             end if;
 520
 521             if Data.Modifies /= No_Project then
 522                Check (Data.Modifies);
 523             end if;
 524
 525             declare
 526                Current : Project_List := Data.Imported_Projects;
 527
 528             begin
 529                while Current /= Empty_Project_List loop
 530                   Check (Project_Lists.Table (Current).Project);
 531                   Current := Project_Lists.Table (Current).Next;
 532                end loop;
 533             end;
 534          end if;
 535       end Check;
 536
 537       ---------------------
 538       -- Check_Temp_File --
 539       ---------------------
 540
 541       procedure Check_Temp_File is
 542       begin
 543          if File = Invalid_FD then
 544             GNAT.OS_Lib.Create_Temp_File (File, Name => File_Name);
 545             if File = Invalid_FD then
 546                Osint.Fail
 547                  ("unable to create temporary configuration pragmas file");
 548             elsif Opt.Verbose_Mode then
 549                Write_Str ("Creating temp file """);
 550                Write_Str (File_Name);
 551                Write_Line ("""");
 552             end if;
 553          end if;
 554       end Check_Temp_File;
 555
 556       ---------------
 557       -- Copy_File --
 558       ---------------
 559
 560       procedure Copy_File (Name : in String_Id) is
 561          Input         : File_Descriptor;
 562          Buffer        : String (1 .. 1_000);
 563          Input_Length  : Integer;
 564          Output_Length : Integer;
 565
 566       begin
 567          Check_Temp_File;
 568          String_To_Name_Buffer (Name);
 569
 570          if Opt.Verbose_Mode then
 571             Write_Str ("Copying config pragmas file """);
 572             Write_Str (Name_Buffer (1 .. Name_Len));
 573             Write_Line (""" into temp file");
 574          end if;
 575
 576          declare
 577             Name : constant String :=
 578               Name_Buffer (1 .. Name_Len)  & ASCII.NUL;
 579          begin
 580             Input := Open_Read (Name'Address, Binary);
 581          end;
 582
 583          if Input = Invalid_FD then
 584             Osint.Fail
 585               ("cannot open configuration pragmas file " &
 586                Name_Buffer (1 .. Name_Len));
 587          end if;
 588
 589          loop
 590             Input_Length := Read (Input, Buffer'Address, Buffer'Length);
 591             Output_Length := Write (File, Buffer'Address, Input_Length);
 592
 593             if Output_Length /= Input_Length then
 594                Osint.Fail ("disk full");
 595             end if;
 596
 597             exit when Input_Length < Buffer'Length;
 598          end loop;
 599
 600          Close (Input);
 601
 602       end Copy_File;
 603
 604       ---------
 605       -- Put --
 606       ---------
 607
 608       procedure Put
 609         (Unit_Name : Name_Id;
 610          File_Name : Name_Id;
 611          Unit_Kind : Spec_Or_Body)
 612       is
 613       begin
 614          --  A temporary file needs to be open
 615
 616          Check_Temp_File;
 617
 618          --  Put the pragma SFN for the unit kind (spec or body)
 619
 620          Put (File, "pragma Source_File_Name (");
 621          Put (File, Namet.Get_Name_String (Unit_Name));
 622
 623          if Unit_Kind = Specification then
 624             Put (File, ", Spec_File_Name => """);
 625          else
 626             Put (File, ", Body_File_Name => """);
 627          end if;
 628
 629          Put (File, Namet.Get_Name_String (File_Name));
 630          Put_Line (File, """);");
 631       end Put;
 632
 633       procedure Put (File : File_Descriptor; S : String) is
 634          Last : Natural;
 635
 636       begin
 637          Last := Write (File, S (S'First)'Address, S'Length);
 638
 639          if Last /= S'Length then
 640             Osint.Fail ("Disk full");
 641          end if;
 642
 643          if Current_Verbosity = High then
 644             Write_Str (S);
 645          end if;
 646       end Put;
 647
 648       --------------
 649       -- Put_Line --
 650       --------------
 651
 652       procedure Put_Line (File : File_Descriptor; S : String) is
 653          S0   : String (1 .. S'Length + 1);
 654          Last : Natural;
 655
 656       begin
 657          --  Add an ASCII.LF to the string. As this gnat.adc
 658          --  is supposed to be used only by the compiler, we don't
 659          --  care about the characters for the end of line.
 660          --  The truth is we could have put a space, but it is
 661          --  more convenient to be able to read gnat.adc during
 662          --  development. And the development was done under UNIX.
 663          --  Hence the ASCII.LF.
 664
 665          S0 (1 .. S'Length) := S;
 666          S0 (S0'Last) := ASCII.LF;
 667          Last := Write (File, S0'Address, S0'Length);
 668
 669          if Last /= S'Length + 1 then
 670             Osint.Fail ("Disk full");
 671          end if;
 672
 673          if Current_Verbosity = High then
 674             Write_Line (S);
 675          end if;
 676       end Put_Line;
 677
 678    --  Start of processing for Create_Config_Pragmas_File
 679
 680    begin
 681
 682       if not Projects.Table (For_Project).Config_Checked then
 683
 684          --  Remove any memory of processed naming schemes, if any
 685
 686          Namings.Set_Last (Default_Naming);
 687
 688          --  Check the naming schemes
 689
 690          Check (For_Project);
 691
 692          --  Visit all the units and process those that need an SFN pragma
 693
 694          while Current_Unit <= Units.Last loop
 695             declare
 696                Unit : constant Unit_Data :=
 697                  Units.Table (Current_Unit);
 698
 699             begin
 700                if Unit.File_Names (Specification).Needs_Pragma then
 701                   Put (Unit.Name,
 702                        Unit.File_Names (Specification).Name,
 703                        Specification);
 704                end if;
 705
 706                if Unit.File_Names (Body_Part).Needs_Pragma then
 707                   Put (Unit.Name,
 708                        Unit.File_Names (Body_Part).Name,
 709                        Body_Part);
 710                end if;
 711
 712                Current_Unit := Current_Unit + 1;
 713             end;
 714          end loop;
 715
 716          The_Packages := Projects.Table (Main_Project).Decl.Packages;
 717          Gnatmake :=
 718            Prj.Util.Value_Of
 719            (Name        => Name_Builder,
 720             In_Packages => The_Packages);
 721
 722          if Gnatmake /= No_Package then
 723             Global_Attribute := Prj.Util.Value_Of
 724               (Variable_Name => Global_Configuration_Pragmas,
 725                In_Variables => Packages.Table (Gnatmake).Decl.Attributes);
 726             Global_Attribute_Present :=
 727               Global_Attribute /= Nil_Variable_Value
 728               and then String_Length (Global_Attribute.Value) > 0;
 729          end if;
 730
 731          The_Packages := Projects.Table (For_Project).Decl.Packages;
 732          Compiler :=
 733            Prj.Util.Value_Of
 734            (Name        => Name_Compiler,
 735             In_Packages => The_Packages);
 736
 737          if Compiler /= No_Package then
 738             Local_Attribute := Prj.Util.Value_Of
 739               (Variable_Name => Local_Configuration_Pragmas,
 740                In_Variables => Packages.Table (Compiler).Decl.Attributes);
 741             Local_Attribute_Present :=
 742               Local_Attribute /= Nil_Variable_Value
 743               and then String_Length (Local_Attribute.Value) > 0;
 744          end if;
 745
 746          if Global_Attribute_Present then
 747
 748             if File /= Invalid_FD
 749               or else Local_Attribute_Present
 750             then
 751                Copy_File (Global_Attribute.Value);
 752             else
 753                String_To_Name_Buffer (Global_Attribute.Value);
 754                Projects.Table (For_Project).Config_File_Name := Name_Find;
 755             end if;
 756          end if;
 757
 758          if Local_Attribute_Present then
 759
 760             if File /= Invalid_FD then
 761                Copy_File (Local_Attribute.Value);
 762
 763             else
 764                String_To_Name_Buffer (Local_Attribute.Value);
 765                Projects.Table (For_Project).Config_File_Name := Name_Find;
 766             end if;
 767
 768          end if;
 769
 770          if File /= Invalid_FD then
 771             GNAT.OS_Lib.Close (File);
 772
 773             if Opt.Verbose_Mode then
 774                Write_Str ("Closing configuration file """);
 775                Write_Str (File_Name);
 776                Write_Line ("""");
 777             end if;
 778
 779             Name_Len := File_Name'Length;
 780             Name_Buffer (1 .. Name_Len) := File_Name;
 781             Projects.Table (For_Project).Config_File_Name := Name_Find;
 782             Projects.Table (For_Project).Config_File_Temp := True;
 783          end if;
 784
 785          Projects.Table (For_Project).Config_Checked := True;
 786
 787       end if;
 788
 789    end Create_Config_Pragmas_File;
 790
 791    -------------------------
 792    -- Create_Mapping_File --
 793    -------------------------
 794
 795    procedure Create_Mapping_File (Name : in out Temp_File_Name) is
 796       File          : File_Descriptor := Invalid_FD;
 797       The_Unit_Data : Unit_Data;
 798       Data          : File_Name_Data;
 799
 800       procedure Put (S : String);
 801       --  Put a line in the mapping file
 802
 803       procedure Put_Data (Spec : Boolean);
 804       --  Put the mapping of the spec or body contained in Data in the file
 805       --  (3 lines).
 806
 807       ---------
 808       -- Put --
 809       ---------
 810
 811       procedure Put (S : String) is
 812          Last : Natural;
 813
 814       begin
 815          Last := Write (File, S'Address, S'Length);
 816
 817          if Last /= S'Length then
 818             Osint.Fail ("Disk full");
 819          end if;
 820       end Put;
 821
 822       --------------
 823       -- Put_Data --
 824       --------------
 825
 826       procedure Put_Data (Spec : Boolean) is
 827       begin
 828          Put (Get_Name_String (The_Unit_Data.Name));
 829
 830          if Spec then
 831             Put ("%s");
 832          else
 833             Put ("%b");
 834          end if;
 835
 836          Put (S => (1 => ASCII.LF));
 837          Put (Get_Name_String (Data.Name));
 838          Put (S => (1 => ASCII.LF));
 839          Put (Get_Name_String (Data.Path));
 840          Put (S => (1 => ASCII.LF));
 841       end Put_Data;
 842
 843    --  Start of processing for Create_Mapping_File
 844
 845    begin
 846       GNAT.OS_Lib.Create_Temp_File (File, Name => Name);
 847
 848       if File = Invalid_FD then
 849          Osint.Fail
 850            ("unable to create temporary mapping file");
 851
 852       elsif Opt.Verbose_Mode then
 853          Write_Str ("Creating temp mapping file """);
 854          Write_Str (Name);
 855          Write_Line ("""");
 856       end if;
 857
 858       --  For all units in table Units
 859
 860       for Unit in 1 .. Units.Last loop
 861          The_Unit_Data := Units.Table (Unit);
 862
 863          --  If the unit has a valid name
 864
 865          if The_Unit_Data.Name /= No_Name then
 866             Data := The_Unit_Data.File_Names (Specification);
 867
 868             --  If there is a spec, put it mapping in the file
 869
 870             if Data.Name /= No_Name then
 871                Put_Data (Spec => True);
 872             end if;
 873
 874             Data := The_Unit_Data.File_Names (Body_Part);
 875
 876             --  If there is a body (or subunit) put its mapping in the file
 877
 878             if Data.Name /= No_Name then
 879                Put_Data (Spec => False);
 880             end if;
 881
 882          end if;
 883       end loop;
 884
 885       GNAT.OS_Lib.Close (File);
 886
 887    end Create_Mapping_File;
 888
 889    ------------------------------------
 890    -- File_Name_Of_Library_Unit_Body --
 891    ------------------------------------
 892
 893    function File_Name_Of_Library_Unit_Body
 894      (Name    : String;
 895       Project : Project_Id)
 896       return    String
 897    is
 898       Data          : constant Project_Data := Projects.Table (Project);
 899       Original_Name : String := Name;
 900
 901       Extended_Spec_Name : String :=
 902                              Name & Namet.Get_Name_String
 903                                       (Data.Naming.Current_Spec_Suffix);
 904       Extended_Body_Name : String :=
 905                              Name & Namet.Get_Name_String
 906                                       (Data.Naming.Current_Impl_Suffix);
 907
 908       Unit : Unit_Data;
 909
 910       The_Original_Name : Name_Id;
 911       The_Spec_Name     : Name_Id;
 912       The_Body_Name     : Name_Id;
 913
 914    begin
 915       Canonical_Case_File_Name (Original_Name);
 916       Name_Len := Original_Name'Length;
 917       Name_Buffer (1 .. Name_Len) := Original_Name;
 918       The_Original_Name := Name_Find;
 919
 920       Canonical_Case_File_Name (Extended_Spec_Name);
 921       Name_Len := Extended_Spec_Name'Length;
 922       Name_Buffer (1 .. Name_Len) := Extended_Spec_Name;
 923       The_Spec_Name := Name_Find;
 924
 925       Canonical_Case_File_Name (Extended_Body_Name);
 926       Name_Len := Extended_Body_Name'Length;
 927       Name_Buffer (1 .. Name_Len) := Extended_Body_Name;
 928       The_Body_Name := Name_Find;
 929
 930       if Current_Verbosity = High then
 931          Write_Str  ("Looking for file name of """);
 932          Write_Str  (Name);
 933          Write_Char ('"');
 934          Write_Eol;
 935          Write_Str  ("   Extended Spec Name = """);
 936          Write_Str  (Extended_Spec_Name);
 937          Write_Char ('"');
 938          Write_Eol;
 939          Write_Str  ("   Extended Body Name = """);
 940          Write_Str  (Extended_Body_Name);
 941          Write_Char ('"');
 942          Write_Eol;
 943       end if;
 944
 945       --  For every unit
 946
 947       for Current in reverse Units.First .. Units.Last loop
 948          Unit := Units.Table (Current);
 949
 950          --  Case of unit of the same project
 951
 952          if Unit.File_Names (Body_Part).Project = Project then
 953             declare
 954                Current_Name : constant Name_Id :=
 955                                 Unit.File_Names (Body_Part).Name;
 956
 957             begin
 958                --  Case of a body present
 959
 960                if Current_Name /= No_Name then
 961                   if Current_Verbosity = High then
 962                      Write_Str  ("   Comparing with """);
 963                      Write_Str  (Get_Name_String (Current_Name));
 964                      Write_Char ('"');
 965                      Write_Eol;
 966                   end if;
 967
 968                   --  If it has the name of the original name,
 969                   --  return the original name
 970
 971                   if Unit.Name = The_Original_Name
 972                     or else Current_Name = The_Original_Name
 973                   then
 974                      if Current_Verbosity = High then
 975                         Write_Line ("   OK");
 976                      end if;
 977
 978                      return Get_Name_String (Current_Name);
 979
 980                   --  If it has the name of the extended body name,
 981                   --  return the extended body name
 982
 983                   elsif Current_Name = The_Body_Name then
 984                      if Current_Verbosity = High then
 985                         Write_Line ("   OK");
 986                      end if;
 987
 988                      return Extended_Body_Name;
 989
 990                   else
 991                      if Current_Verbosity = High then
 992                         Write_Line ("   not good");
 993                      end if;
 994                   end if;
 995                end if;
 996             end;
 997          end if;
 998
 999          --  Case of a unit of the same project
1000
1001          if Units.Table (Current).File_Names (Specification).Project =
1002                                                                  Project
1003          then
1004             declare
1005                Current_Name : constant Name_Id :=
1006                                 Unit.File_Names (Specification).Name;
1007
1008             begin
1009                --  Case of spec present
1010
1011                if Current_Name /= No_Name then
1012                   if Current_Verbosity = High then
1013                      Write_Str  ("   Comparing with """);
1014                      Write_Str  (Get_Name_String (Current_Name));
1015                      Write_Char ('"');
1016                      Write_Eol;
1017                   end if;
1018
1019                   --  If name same as the original name, return original name
1020
1021                   if Unit.Name = The_Original_Name
1022                     or else Current_Name = The_Original_Name
1023                   then
1024                      if Current_Verbosity = High then
1025                         Write_Line ("   OK");
1026                      end if;
1027
1028                      return Get_Name_String (Current_Name);
1029
1030                   --  If it has the same name as the extended spec name,
1031                   --  return the extended spec name.
1032
1033                   elsif Current_Name = The_Spec_Name then
1034                      if Current_Verbosity = High then
1035                         Write_Line ("   OK");
1036                      end if;
1037
1038                      return Extended_Spec_Name;
1039
1040                   else
1041                      if Current_Verbosity = High then
1042                         Write_Line ("   not good");
1043                      end if;
1044                   end if;
1045                end if;
1046             end;
1047          end if;
1048
1049       end loop;
1050
1051       --  We don't know this file name, return an empty string
1052
1053       return "";
1054    end File_Name_Of_Library_Unit_Body;
1055
1056    -------------------------
1057    -- For_All_Object_Dirs --
1058    -------------------------
1059
1060    procedure For_All_Object_Dirs (Project : Project_Id) is
1061       Seen : Project_List := Empty_Project_List;
1062
1063       procedure Add (Project : Project_Id);
1064       --  Process a project. Remember the processes visited to avoid
1065       --  processing a project twice. Recursively process an eventual
1066       --  modified project, and all imported projects.
1067
1068       ---------
1069       -- Add --
1070       ---------
1071
1072       procedure Add (Project : Project_Id) is
1073          Data : constant Project_Data := Projects.Table (Project);
1074          List : Project_List := Data.Imported_Projects;
1075
1076       begin
1077          --  If the list of visited project is empty, then
1078          --  for sure we never visited this project.
1079
1080          if Seen = Empty_Project_List then
1081             Project_Lists.Increment_Last;
1082             Seen := Project_Lists.Last;
1083             Project_Lists.Table (Seen) :=
1084               (Project => Project, Next => Empty_Project_List);
1085
1086          else
1087             --  Check if the project is in the list
1088
1089             declare
1090                Current : Project_List := Seen;
1091
1092             begin
1093                loop
1094                   --  If it is, then there is nothing else to do
1095
1096                   if Project_Lists.Table (Current).Project = Project then
1097                      return;
1098                   end if;
1099
1100                   exit when Project_Lists.Table (Current).Next =
1101                     Empty_Project_List;
1102                   Current := Project_Lists.Table (Current).Next;
1103                end loop;
1104
1105                --  This project has never been visited, add it
1106                --  to the list.
1107
1108                Project_Lists.Increment_Last;
1109                Project_Lists.Table (Current).Next := Project_Lists.Last;
1110                Project_Lists.Table (Project_Lists.Last) :=
1111                  (Project => Project, Next => Empty_Project_List);
1112             end;
1113          end if;
1114
1115          --  If there is an object directory, call Action
1116          --  with its name
1117
1118          if Data.Object_Directory /= No_Name then
1119             Get_Name_String (Data.Object_Directory);
1120             Action (Name_Buffer (1 .. Name_Len));
1121          end if;
1122
1123          --  If we are extending a project, visit it
1124
1125          if Data.Modifies /= No_Project then
1126             Add (Data.Modifies);
1127          end if;
1128
1129          --  And visit all imported projects
1130
1131          while List /= Empty_Project_List loop
1132             Add (Project_Lists.Table (List).Project);
1133             List := Project_Lists.Table (List).Next;
1134          end loop;
1135       end Add;
1136
1137    --  Start of processing for For_All_Object_Dirs
1138
1139    begin
1140       --  Visit this project, and its imported projects,
1141       --  recursively
1142
1143       Add (Project);
1144    end For_All_Object_Dirs;
1145
1146    -------------------------
1147    -- For_All_Source_Dirs --
1148    -------------------------
1149
1150    procedure For_All_Source_Dirs (Project : Project_Id) is
1151       Seen : Project_List := Empty_Project_List;
1152
1153       procedure Add (Project : Project_Id);
1154       --  Process a project. Remember the processes visited to avoid
1155       --  processing a project twice. Recursively process an eventual
1156       --  modified project, and all imported projects.
1157
1158       ---------
1159       -- Add --
1160       ---------
1161
1162       procedure Add (Project : Project_Id) is
1163          Data : constant Project_Data := Projects.Table (Project);
1164          List : Project_List := Data.Imported_Projects;
1165
1166       begin
1167          --  If the list of visited project is empty, then
1168          --  for sure we never visited this project.
1169
1170          if Seen = Empty_Project_List then
1171             Project_Lists.Increment_Last;
1172             Seen := Project_Lists.Last;
1173             Project_Lists.Table (Seen) :=
1174               (Project => Project, Next => Empty_Project_List);
1175
1176          else
1177             --  Check if the project is in the list
1178
1179             declare
1180                Current : Project_List := Seen;
1181
1182             begin
1183                loop
1184                   --  If it is, then there is nothing else to do
1185
1186                   if Project_Lists.Table (Current).Project = Project then
1187                      return;
1188                   end if;
1189
1190                   exit when Project_Lists.Table (Current).Next =
1191                     Empty_Project_List;
1192                   Current := Project_Lists.Table (Current).Next;
1193                end loop;
1194
1195                --  This project has never been visited, add it
1196                --  to the list.
1197
1198                Project_Lists.Increment_Last;
1199                Project_Lists.Table (Current).Next := Project_Lists.Last;
1200                Project_Lists.Table (Project_Lists.Last) :=
1201                  (Project => Project, Next => Empty_Project_List);
1202             end;
1203          end if;
1204
1205          declare
1206             Current    : String_List_Id := Data.Source_Dirs;
1207             The_String : String_Element;
1208
1209          begin
1210             --  Call action with the name of every source directorie
1211
1212             while Current /= Nil_String loop
1213                The_String := String_Elements.Table (Current);
1214                String_To_Name_Buffer (The_String.Value);
1215                Action (Name_Buffer (1 .. Name_Len));
1216                Current := The_String.Next;
1217             end loop;
1218          end;
1219
1220          --  If we are extending a project, visit it
1221
1222          if Data.Modifies /= No_Project then
1223             Add (Data.Modifies);
1224          end if;
1225
1226          --  And visit all imported projects
1227
1228          while List /= Empty_Project_List loop
1229             Add (Project_Lists.Table (List).Project);
1230             List := Project_Lists.Table (List).Next;
1231          end loop;
1232       end Add;
1233
1234    --  Start of processing for For_All_Source_Dirs
1235
1236    begin
1237       --  Visit this project, and its imported projects recursively
1238
1239       Add (Project);
1240    end For_All_Source_Dirs;
1241
1242    -------------------
1243    -- Get_Reference --
1244    -------------------
1245
1246    procedure Get_Reference
1247      (Source_File_Name : String;
1248       Project          : out Project_Id;
1249       Path             : out Name_Id)
1250    is
1251    begin
1252       if Current_Verbosity > Default then
1253          Write_Str ("Getting Reference_Of (""");
1254          Write_Str (Source_File_Name);
1255          Write_Str (""") ... ");
1256       end if;
1257
1258       declare
1259          Original_Name : String := Source_File_Name;
1260          Unit          : Unit_Data;
1261
1262       begin
1263          Canonical_Case_File_Name (Original_Name);
1264
1265          for Id in Units.First .. Units.Last loop
1266             Unit := Units.Table (Id);
1267
1268             if (Unit.File_Names (Specification).Name /= No_Name
1269                  and then
1270                    Namet.Get_Name_String
1271                      (Unit.File_Names (Specification).Name) = Original_Name)
1272               or else (Unit.File_Names (Specification).Path /= No_Name
1273                          and then
1274                            Namet.Get_Name_String
1275                            (Unit.File_Names (Specification).Path) =
1276                                                               Original_Name)
1277             then
1278                Project := Unit.File_Names (Specification).Project;
1279                Path := Unit.File_Names (Specification).Path;
1280
1281                if Current_Verbosity > Default then
1282                   Write_Str ("Done: Specification.");
1283                   Write_Eol;
1284                end if;
1285
1286                return;
1287
1288             elsif (Unit.File_Names (Body_Part).Name /= No_Name
1289                     and then
1290                       Namet.Get_Name_String
1291                         (Unit.File_Names (Body_Part).Name) = Original_Name)
1292               or else (Unit.File_Names (Body_Part).Path /= No_Name
1293                          and then Namet.Get_Name_String
1294                                     (Unit.File_Names (Body_Part).Path) =
1295                                                              Original_Name)
1296             then
1297                Project := Unit.File_Names (Body_Part).Project;
1298                Path := Unit.File_Names (Body_Part).Path;
1299
1300                if Current_Verbosity > Default then
1301                   Write_Str ("Done: Body.");
1302                   Write_Eol;
1303                end if;
1304
1305                return;
1306             end if;
1307
1308          end loop;
1309       end;
1310
1311       Project := No_Project;
1312       Path    := No_Name;
1313
1314       if Current_Verbosity > Default then
1315          Write_Str ("Cannot be found.");
1316          Write_Eol;
1317       end if;
1318    end Get_Reference;
1319
1320    ----------------
1321    -- Initialize --
1322    ----------------
1323
1324    procedure Initialize is
1325       Global : constant String := "global_configuration_pragmas";
1326       Local  : constant String :=  "local_configuration_pragmas";
1327    begin
1328       --  Put the standard GNAT naming scheme in the Namings table
1329
1330       Namings.Increment_Last;
1331       Namings.Table (Namings.Last) := Standard_Naming_Data;
1332       Name_Len := Global'Length;
1333       Name_Buffer (1 .. Name_Len) := Global;
1334       Global_Configuration_Pragmas := Name_Find;
1335       Name_Len := Local'Length;
1336       Name_Buffer (1 .. Name_Len) := Local;
1337       Local_Configuration_Pragmas := Name_Find;
1338    end Initialize;
1339
1340    ------------------------------------
1341    -- Path_Name_Of_Library_Unit_Body --
1342    ------------------------------------
1343
1344    function Path_Name_Of_Library_Unit_Body
1345      (Name    : String;
1346       Project : Project_Id)
1347       return String
1348    is
1349       Data : constant Project_Data := Projects.Table (Project);
1350       Original_Name : String := Name;
1351
1352       Extended_Spec_Name : String :=
1353                              Name & Namet.Get_Name_String
1354                                      (Data.Naming.Current_Spec_Suffix);
1355       Extended_Body_Name : String :=
1356                              Name & Namet.Get_Name_String
1357                                      (Data.Naming.Current_Impl_Suffix);
1358
1359       First   : Unit_Id := Units.First;
1360       Current : Unit_Id;
1361       Unit    : Unit_Data;
1362
1363    begin
1364       Canonical_Case_File_Name (Original_Name);
1365       Canonical_Case_File_Name (Extended_Spec_Name);
1366       Canonical_Case_File_Name (Extended_Spec_Name);
1367
1368       if Current_Verbosity = High then
1369          Write_Str  ("Looking for path name of """);
1370          Write_Str  (Name);
1371          Write_Char ('"');
1372          Write_Eol;
1373          Write_Str  ("   Extended Spec Name = """);
1374          Write_Str  (Extended_Spec_Name);
1375          Write_Char ('"');
1376          Write_Eol;
1377          Write_Str  ("   Extended Body Name = """);
1378          Write_Str  (Extended_Body_Name);
1379          Write_Char ('"');
1380          Write_Eol;
1381       end if;
1382
1383       while First <= Units.Last
1384         and then Units.Table (First).File_Names (Body_Part).Project /= Project
1385       loop
1386          First := First + 1;
1387       end loop;
1388
1389       Current := First;
1390       while Current <= Units.Last loop
1391          Unit := Units.Table (Current);
1392
1393          if Unit.File_Names (Body_Part).Project = Project
1394            and then Unit.File_Names (Body_Part).Name /= No_Name
1395          then
1396             declare
1397                Current_Name : constant String :=
1398                  Namet.Get_Name_String (Unit.File_Names (Body_Part).Name);
1399             begin
1400                if Current_Verbosity = High then
1401                   Write_Str  ("   Comparing with """);
1402                   Write_Str  (Current_Name);
1403                   Write_Char ('"');
1404                   Write_Eol;
1405                end if;
1406
1407                if Current_Name = Original_Name then
1408                   if Current_Verbosity = High then
1409                      Write_Line ("   OK");
1410                   end if;
1411
1412                   return Body_Path_Name_Of (Current);
1413
1414                elsif Current_Name = Extended_Body_Name then
1415                   if Current_Verbosity = High then
1416                      Write_Line ("   OK");
1417                   end if;
1418
1419                   return Body_Path_Name_Of (Current);
1420
1421                else
1422                   if Current_Verbosity = High then
1423                      Write_Line ("   not good");
1424                   end if;
1425                end if;
1426             end;
1427
1428          elsif Unit.File_Names (Specification).Name /= No_Name then
1429             declare
1430                Current_Name : constant String :=
1431                                 Namet.Get_Name_String
1432                                   (Unit.File_Names (Specification).Name);
1433
1434             begin
1435                if Current_Verbosity = High then
1436                   Write_Str  ("   Comparing with """);
1437                   Write_Str  (Current_Name);
1438                   Write_Char ('"');
1439                   Write_Eol;
1440                end if;
1441
1442                if Current_Name = Original_Name then
1443                   if Current_Verbosity = High then
1444                      Write_Line ("   OK");
1445                   end if;
1446
1447                   return Spec_Path_Name_Of (Current);
1448
1449                elsif Current_Name = Extended_Spec_Name then
1450
1451                   if Current_Verbosity = High then
1452                      Write_Line ("   OK");
1453                   end if;
1454
1455                   return Spec_Path_Name_Of (Current);
1456
1457                else
1458                   if Current_Verbosity = High then
1459                      Write_Line ("   not good");
1460                   end if;
1461                end if;
1462             end;
1463          end if;
1464          Current := Current + 1;
1465       end loop;
1466
1467       return "";
1468    end Path_Name_Of_Library_Unit_Body;
1469
1470    -------------------
1471    -- Print_Sources --
1472    -------------------
1473
1474    procedure Print_Sources is
1475       Unit : Unit_Data;
1476
1477    begin
1478       Write_Line ("List of Sources:");
1479
1480       for Id in Units.First .. Units.Last loop
1481          Unit := Units.Table (Id);
1482          Write_Str  ("   ");
1483          Write_Line (Namet.Get_Name_String (Unit.Name));
1484
1485          if Unit.File_Names (Specification).Name /= No_Name then
1486             if Unit.File_Names (Specification).Project = No_Project then
1487                Write_Line ("   No project");
1488
1489             else
1490                Write_Str  ("   Project: ");
1491                Get_Name_String
1492                  (Projects.Table
1493                    (Unit.File_Names (Specification).Project).Path_Name);
1494                Write_Line (Name_Buffer (1 .. Name_Len));
1495             end if;
1496
1497             Write_Str  ("      spec: ");
1498             Write_Line
1499               (Namet.Get_Name_String
1500                (Unit.File_Names (Specification).Name));
1501          end if;
1502
1503          if Unit.File_Names (Body_Part).Name /= No_Name then
1504             if Unit.File_Names (Body_Part).Project = No_Project then
1505                Write_Line ("   No project");
1506
1507             else
1508                Write_Str  ("   Project: ");
1509                Get_Name_String
1510                  (Projects.Table
1511                    (Unit.File_Names (Body_Part).Project).Path_Name);
1512                Write_Line (Name_Buffer (1 .. Name_Len));
1513             end if;
1514
1515             Write_Str  ("      body: ");
1516             Write_Line
1517               (Namet.Get_Name_String
1518                (Unit.File_Names (Body_Part).Name));
1519          end if;
1520
1521       end loop;
1522
1523       Write_Line ("end of List of Sources.");
1524    end Print_Sources;
1525
1526    -----------------------
1527    -- Spec_Path_Name_Of --
1528    -----------------------
1529
1530    function Spec_Path_Name_Of (Unit : Unit_Id) return String is
1531       Data : Unit_Data := Units.Table (Unit);
1532
1533    begin
1534       if Data.File_Names (Specification).Path = No_Name then
1535          declare
1536             Current_Source : String_List_Id :=
1537               Projects.Table (Data.File_Names (Specification).Project).Sources;
1538             Path : GNAT.OS_Lib.String_Access;
1539
1540          begin
1541             Data.File_Names (Specification).Path :=
1542               Data.File_Names (Specification).Name;
1543
1544             while Current_Source /= Nil_String loop
1545                String_To_Name_Buffer
1546                  (String_Elements.Table (Current_Source).Value);
1547                Path := Locate_Regular_File
1548                  (Namet.Get_Name_String
1549                   (Data.File_Names (Specification).Name),
1550                   Name_Buffer (1 .. Name_Len));
1551
1552                if Path /= null then
1553                   Name_Len := Path'Length;
1554                   Name_Buffer (1 .. Name_Len) := Path.all;
1555                   Data.File_Names (Specification).Path := Name_Enter;
1556                   exit;
1557                else
1558                   Current_Source :=
1559                     String_Elements.Table (Current_Source).Next;
1560                end if;
1561             end loop;
1562
1563             Units.Table (Unit) := Data;
1564          end;
1565       end if;
1566
1567       return Namet.Get_Name_String (Data.File_Names (Specification).Path);
1568    end Spec_Path_Name_Of;
1569
1570 end Prj.Env;