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 --          Copyright (C) 2001-2004 Free Software Foundation, Inc.          --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, USA.                                                      --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with Namet;    use Namet;
  28 with Opt;
  29 with Osint;    use Osint;
  30 with Output;   use Output;
  31 with Prj.Com;  use Prj.Com;
  32 with Table;
  33 with Tempdir;
  34
  35 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
  36 with GNAT.OS_Lib;               use GNAT.OS_Lib;
  37
  38 package body Prj.Env is
  39
  40    type Naming_Id is new Nat;
  41
  42    Current_Source_Path_File : Name_Id := No_Name;
  43    --  Current value of project source path file env var.
  44    --  Used to avoid setting the env var to the same value.
  45
  46    Current_Object_Path_File : Name_Id := No_Name;
  47    --  Current value of project object path file env var.
  48    --  Used to avoid setting the env var to the same value.
  49
  50    Ada_Path_Buffer : String_Access := new String (1 .. 1024);
  51    --  A buffer where values for ADA_INCLUDE_PATH
  52    --  and ADA_OBJECTS_PATH are stored.
  53
  54    Ada_Path_Length : Natural := 0;
  55    --  Index of the last valid character in Ada_Path_Buffer.
  56
  57    Ada_Prj_Include_File_Set : Boolean := False;
  58    Ada_Prj_Objects_File_Set : Boolean := False;
  59    --  These flags are set to True when the corresponding environment variables
  60    --  are set and are used to give these environment variables an empty string
  61    --  value at the end of the program. This has no practical effect on most
  62    --  platforms, except on VMS where the logical names are deassigned, thus
  63    --  avoiding the pollution of the environment of the caller.
  64
  65    package Namings is new Table.Table
  66      (Table_Component_Type => Naming_Data,
  67       Table_Index_Type     => Naming_Id,
  68       Table_Low_Bound      => 1,
  69       Table_Initial        => 5,
  70       Table_Increment      => 100,
  71       Table_Name           => "Prj.Env.Namings");
  72
  73    Default_Naming : constant Naming_Id := Namings.First;
  74
  75    Fill_Mapping_File : Boolean := True;
  76
  77    package Path_Files is new Table.Table
  78      (Table_Component_Type => Name_Id,
  79       Table_Index_Type     => Natural,
  80       Table_Low_Bound      => 1,
  81       Table_Initial        => 50,
  82       Table_Increment      => 50,
  83       Table_Name           => "Prj.Env.Path_Files");
  84    --  Table storing all the temp path file names.
  85    --  Used by Delete_All_Path_Files.
  86
  87    type Project_Flags is array (Project_Id range <>) of Boolean;
  88    --  A Boolean array type used in Create_Mapping_File to select the projects
  89    --  in the closure of a specific project.
  90
  91    package Source_Paths is new Table.Table
  92      (Table_Component_Type => Name_Id,
  93       Table_Index_Type     => Natural,
  94       Table_Low_Bound      => 1,
  95       Table_Initial        => 50,
  96       Table_Increment      => 50,
  97       Table_Name           => "Prj.Env.Source_Paths");
  98    --  A table to store the source dirs before creating the source path file
  99
 100    package Object_Paths is new Table.Table
 101      (Table_Component_Type => Name_Id,
 102       Table_Index_Type     => Natural,
 103       Table_Low_Bound      => 1,
 104       Table_Initial        => 50,
 105       Table_Increment      => 50,
 106       Table_Name           => "Prj.Env.Source_Paths");
 107    --  A table to store the object dirs, before creating the object path file
 108
 109    -----------------------
 110    -- Local Subprograms --
 111    -----------------------
 112
 113    function Body_Path_Name_Of (Unit : Unit_Id) return String;
 114    --  Returns the path name of the body of a unit.
 115    --  Compute it first, if necessary.
 116
 117    function Spec_Path_Name_Of (Unit : Unit_Id) return String;
 118    --  Returns the path name of the spec of a unit.
 119    --  Compute it first, if necessary.
 120
 121    procedure Add_To_Path (Source_Dirs : String_List_Id);
 122    --  Add to Ada_Path_Buffer all the source directories in string list
 123    --  Source_Dirs, if any. Increment Ada_Path_Length.
 124
 125    procedure Add_To_Path (Dir : String);
 126    --  If Dir is not already in the global variable Ada_Path_Buffer, add it.
 127    --  Increment Ada_Path_Length.
 128    --  If Ada_Path_Length /= 0, prepend a Path_Separator character to
 129    --  Path.
 130
 131    procedure Add_To_Source_Path (Source_Dirs : String_List_Id);
 132    --  Add to Ada_Path_B all the source directories in string list
 133    --  Source_Dirs, if any. Increment Ada_Path_Length.
 134
 135    procedure Add_To_Object_Path (Object_Dir : Name_Id);
 136    --  Add Object_Dir to object path table. Make sure it is not duplicate
 137    --  and it is the last one in the current table.
 138
 139    function Contains_ALI_Files (Dir : Name_Id) return Boolean;
 140    --  Return True if there is at least one ALI file in the directory Dir
 141
 142    procedure Create_New_Path_File
 143      (Path_FD   : out File_Descriptor;
 144       Path_Name : out Name_Id);
 145    --  Create a new temporary path file. Get the file name in Path_Name.
 146    --  The name is normally obtained by increasing the number in
 147    --  Temp_Path_File_Name by 1.
 148
 149    procedure Set_Path_File_Var (Name : String; Value : String);
 150    --  Call Setenv, after calling To_Host_File_Spec
 151
 152    function Ultimate_Extension_Of (Project : in Project_Id) return Project_Id;
 153    --  Return a project that is either Project or an extended ancestor of
 154    --  Project that itself is not extended.
 155
 156    ----------------------
 157    -- Ada_Include_Path --
 158    ----------------------
 159
 160    function Ada_Include_Path (Project : Project_Id) return String_Access is
 161
 162       procedure Add (Project : Project_Id);
 163       --  Add all the source directories of a project to the path only if
 164       --  this project has not been visited. Calls itself recursively for
 165       --  projects being extended, and imported projects. Adds the project
 166       --  to the list Seen if this is the call to Add for this project.
 167
 168       ---------
 169       -- Add --
 170       ---------
 171
 172       procedure Add (Project : Project_Id) is
 173       begin
 174          --  If Seen is empty, then the project cannot have been visited
 175
 176          if not Projects.Table (Project).Seen then
 177             Projects.Table (Project).Seen := True;
 178
 179             declare
 180                Data : constant Project_Data := Projects.Table (Project);
 181                List : Project_List := Data.Imported_Projects;
 182
 183             begin
 184                --  Add to path all source directories of this project
 185
 186                Add_To_Path (Data.Source_Dirs);
 187
 188                --  Call Add to the project being extended, if any
 189
 190                if Data.Extends /= No_Project then
 191                   Add (Data.Extends);
 192                end if;
 193
 194                --  Call Add for each imported project, if any
 195
 196                while List /= Empty_Project_List loop
 197                   Add (Project_Lists.Table (List).Project);
 198                   List := Project_Lists.Table (List).Next;
 199                end loop;
 200             end;
 201          end if;
 202       end Add;
 203
 204    --  Start of processing for Ada_Include_Path
 205
 206    begin
 207       --  If it is the first time we call this function for
 208       --  this project, compute the source path
 209
 210       if Projects.Table (Project).Ada_Include_Path = null then
 211          Ada_Path_Length := 0;
 212
 213          for Index in 1 .. Projects.Last loop
 214             Projects.Table (Index).Seen := False;
 215          end loop;
 216
 217          Add (Project);
 218          Projects.Table (Project).Ada_Include_Path :=
 219            new String'(Ada_Path_Buffer (1 .. Ada_Path_Length));
 220       end if;
 221
 222       return Projects.Table (Project).Ada_Include_Path;
 223    end Ada_Include_Path;
 224
 225    ----------------------
 226    -- Ada_Include_Path --
 227    ----------------------
 228
 229    function Ada_Include_Path
 230      (Project   : Project_Id;
 231       Recursive : Boolean) return String
 232    is
 233    begin
 234       if Recursive then
 235          return Ada_Include_Path (Project).all;
 236       else
 237          Ada_Path_Length := 0;
 238          Add_To_Path (Projects.Table (Project).Source_Dirs);
 239          return Ada_Path_Buffer (1 .. Ada_Path_Length);
 240       end if;
 241    end Ada_Include_Path;
 242
 243    ----------------------
 244    -- Ada_Objects_Path --
 245    ----------------------
 246
 247    function Ada_Objects_Path
 248      (Project             : Project_Id;
 249       Including_Libraries : Boolean := True) return String_Access
 250    is
 251       procedure Add (Project : Project_Id);
 252       --  Add all the object directories of a project to the path only if
 253       --  this project has not been visited. Calls itself recursively for
 254       --  projects being extended, and imported projects. Adds the project
 255       --  to the list Seen if this is the first call to Add for this project.
 256
 257       ---------
 258       -- Add --
 259       ---------
 260
 261       procedure Add (Project : Project_Id) is
 262       begin
 263          --  If this project has not been seen yet
 264
 265          if not Projects.Table (Project).Seen then
 266             Projects.Table (Project).Seen := True;
 267
 268             declare
 269                Data : constant Project_Data := Projects.Table (Project);
 270                List : Project_List := Data.Imported_Projects;
 271
 272             begin
 273                --  Add to path the object directory of this project
 274                --  except if we don't include library project and
 275                --  this is a library project.
 276
 277                if (Data.Library and then Including_Libraries)
 278                  or else
 279                  (Data.Object_Directory /= No_Name
 280                    and then
 281                    (not Including_Libraries or else not Data.Library))
 282                then
 283                   --  For a library project, add the library directory,
 284                   --  if there is no object directory or if it contains ALI
 285                   --  files; otherwise add the object directory.
 286
 287                   if Data.Library then
 288                      if Data.Object_Directory = No_Name
 289                        or else Contains_ALI_Files (Data.Library_Dir)
 290                      then
 291                         Add_To_Path (Get_Name_String (Data.Library_Dir));
 292                      else
 293                         Add_To_Path (Get_Name_String (Data.Object_Directory));
 294                      end if;
 295
 296                   else
 297                      --  For a non library project, add the object directory
 298
 299                      Add_To_Path (Get_Name_String (Data.Object_Directory));
 300                   end if;
 301                end if;
 302
 303                --  Call Add to the project being extended, if any
 304
 305                if Data.Extends /= No_Project then
 306                   Add (Data.Extends);
 307                end if;
 308
 309                --  Call Add for each imported project, if any
 310
 311                while List /= Empty_Project_List loop
 312                   Add (Project_Lists.Table (List).Project);
 313                   List := Project_Lists.Table (List).Next;
 314                end loop;
 315             end;
 316
 317          end if;
 318       end Add;
 319
 320    --  Start of processing for Ada_Objects_Path
 321
 322    begin
 323       --  If it is the first time we call this function for
 324       --  this project, compute the objects path
 325
 326       if Projects.Table (Project).Ada_Objects_Path = null then
 327          Ada_Path_Length := 0;
 328
 329          for Index in 1 .. Projects.Last loop
 330             Projects.Table (Index).Seen := False;
 331          end loop;
 332
 333          Add (Project);
 334          Projects.Table (Project).Ada_Objects_Path :=
 335            new String'(Ada_Path_Buffer (1 .. Ada_Path_Length));
 336       end if;
 337
 338       return Projects.Table (Project).Ada_Objects_Path;
 339    end Ada_Objects_Path;
 340
 341    ------------------------
 342    -- Add_To_Object_Path --
 343    ------------------------
 344
 345    procedure Add_To_Object_Path (Object_Dir : Name_Id) is
 346    begin
 347       --  Check if the directory is already in the table
 348
 349       for Index in 1 .. Object_Paths.Last loop
 350
 351          --  If it is, remove it, and add it as the last one
 352
 353          if Object_Paths.Table (Index) = Object_Dir then
 354             for Index2 in Index + 1 .. Object_Paths.Last loop
 355                Object_Paths.Table (Index2 - 1) :=
 356                  Object_Paths.Table (Index2);
 357             end loop;
 358
 359             Object_Paths.Table (Object_Paths.Last) := Object_Dir;
 360             return;
 361          end if;
 362       end loop;
 363
 364       --  The directory is not already in the table, add it
 365
 366       Object_Paths.Increment_Last;
 367       Object_Paths.Table (Object_Paths.Last) := Object_Dir;
 368    end Add_To_Object_Path;
 369
 370    -----------------
 371    -- Add_To_Path --
 372    -----------------
 373
 374    procedure Add_To_Path (Source_Dirs : String_List_Id) is
 375       Current    : String_List_Id := Source_Dirs;
 376       Source_Dir : String_Element;
 377    begin
 378       while Current /= Nil_String loop
 379          Source_Dir := String_Elements.Table (Current);
 380          Add_To_Path (Get_Name_String (Source_Dir.Display_Value));
 381          Current := Source_Dir.Next;
 382       end loop;
 383    end Add_To_Path;
 384
 385    procedure Add_To_Path (Dir : String) is
 386       Len        : Natural;
 387       New_Buffer : String_Access;
 388       Min_Len    : Natural;
 389
 390       function Is_Present (Path : String; Dir : String) return Boolean;
 391       --  Return True if Dir is part of Path
 392
 393       ----------------
 394       -- Is_Present --
 395       ----------------
 396
 397       function Is_Present (Path : String; Dir : String) return Boolean is
 398          Last : constant Integer := Path'Last - Dir'Length + 1;
 399
 400       begin
 401          for J in Path'First .. Last loop
 402
 403             --  Note: the order of the conditions below is important, since
 404             --  it ensures a minimal number of string comparisons.
 405
 406             if (J = Path'First
 407                 or else Path (J - 1) = Path_Separator)
 408               and then
 409                 (J + Dir'Length > Path'Last
 410                  or else Path (J + Dir'Length) = Path_Separator)
 411               and then Dir = Path (J .. J + Dir'Length - 1)
 412             then
 413                return True;
 414             end if;
 415          end loop;
 416
 417          return False;
 418       end Is_Present;
 419
 420    --  Start of processing for Add_To_Path
 421
 422    begin
 423       if Is_Present (Ada_Path_Buffer (1 .. Ada_Path_Length), Dir) then
 424
 425          --  Dir is already in the path, nothing to do
 426
 427          return;
 428       end if;
 429
 430       Min_Len := Ada_Path_Length + Dir'Length;
 431
 432       if Ada_Path_Length > 0 then
 433
 434          --  Add 1 for the Path_Separator character
 435
 436          Min_Len := Min_Len + 1;
 437       end if;
 438
 439       --  If Ada_Path_Buffer is too small, increase it
 440
 441       Len := Ada_Path_Buffer'Last;
 442
 443       if Len < Min_Len then
 444          loop
 445             Len := Len * 2;
 446             exit when Len >= Min_Len;
 447          end loop;
 448
 449          New_Buffer := new String (1 .. Len);
 450          New_Buffer (1 .. Ada_Path_Length) :=
 451            Ada_Path_Buffer (1 .. Ada_Path_Length);
 452          Free (Ada_Path_Buffer);
 453          Ada_Path_Buffer := New_Buffer;
 454       end if;
 455
 456       if Ada_Path_Length > 0 then
 457          Ada_Path_Length := Ada_Path_Length + 1;
 458          Ada_Path_Buffer (Ada_Path_Length) := Path_Separator;
 459       end if;
 460
 461       Ada_Path_Buffer
 462         (Ada_Path_Length + 1 .. Ada_Path_Length + Dir'Length) := Dir;
 463       Ada_Path_Length := Ada_Path_Length + Dir'Length;
 464    end Add_To_Path;
 465
 466    ------------------------
 467    -- Add_To_Source_Path --
 468    ------------------------
 469
 470    procedure Add_To_Source_Path (Source_Dirs : String_List_Id) is
 471       Current    : String_List_Id := Source_Dirs;
 472       Source_Dir : String_Element;
 473       Add_It     : Boolean;
 474
 475    begin
 476       --  Add each source directory
 477
 478       while Current /= Nil_String loop
 479          Source_Dir := String_Elements.Table (Current);
 480          Add_It := True;
 481
 482          --  Check if the source directory is already in the table
 483
 484          for Index in 1 .. Source_Paths.Last loop
 485             --  If it is already, no need to add it
 486
 487             if Source_Paths.Table (Index) = Source_Dir.Value then
 488                Add_It := False;
 489                exit;
 490             end if;
 491          end loop;
 492
 493          if Add_It then
 494             Source_Paths.Increment_Last;
 495             Source_Paths.Table (Source_Paths.Last) := Source_Dir.Value;
 496          end if;
 497
 498          --  Next source directory
 499
 500          Current := Source_Dir.Next;
 501       end loop;
 502    end Add_To_Source_Path;
 503
 504    -----------------------
 505    -- Body_Path_Name_Of --
 506    -----------------------
 507
 508    function Body_Path_Name_Of (Unit : Unit_Id) return String is
 509       Data : Unit_Data := Units.Table (Unit);
 510
 511    begin
 512       --  If we don't know the path name of the body of this unit,
 513       --  we compute it, and we store it.
 514
 515       if Data.File_Names (Body_Part).Path = No_Name then
 516          declare
 517             Current_Source : String_List_Id :=
 518               Projects.Table (Data.File_Names (Body_Part).Project).Sources;
 519             Path : GNAT.OS_Lib.String_Access;
 520
 521          begin
 522             --  By default, put the file name
 523
 524             Data.File_Names (Body_Part).Path :=
 525               Data.File_Names (Body_Part).Name;
 526
 527             --  For each source directory
 528
 529             while Current_Source /= Nil_String loop
 530                Path :=
 531                  Locate_Regular_File
 532                    (Namet.Get_Name_String
 533                       (Data.File_Names (Body_Part).Name),
 534                     Namet.Get_Name_String
 535                        (String_Elements.Table (Current_Source).Value));
 536
 537                --  If the file is in this directory,
 538                --  then we store the path, and we are done.
 539
 540                if Path /= null then
 541                   Name_Len := Path'Length;
 542                   Name_Buffer (1 .. Name_Len) := Path.all;
 543                   Data.File_Names (Body_Part).Path := Name_Enter;
 544                   exit;
 545
 546                else
 547                   Current_Source :=
 548                     String_Elements.Table (Current_Source).Next;
 549                end if;
 550             end loop;
 551
 552             Units.Table (Unit) := Data;
 553          end;
 554       end if;
 555
 556       --  Returned the stored value
 557
 558       return Namet.Get_Name_String (Data.File_Names (Body_Part).Path);
 559    end Body_Path_Name_Of;
 560
 561    ------------------------
 562    -- Contains_ALI_Files --
 563    ------------------------
 564
 565    function Contains_ALI_Files (Dir : Name_Id) return Boolean is
 566       Dir_Name : constant String := Get_Name_String (Dir);
 567       Direct : Dir_Type;
 568       Name   : String (1 .. 1_000);
 569       Last   : Natural;
 570       Result : Boolean := False;
 571
 572    begin
 573       Open (Direct, Dir_Name);
 574
 575       --  For each file in the directory, check if it is an ALI file
 576
 577       loop
 578          Read (Direct, Name, Last);
 579          exit when Last = 0;
 580          Canonical_Case_File_Name (Name (1 .. Last));
 581          Result := Last >= 5 and then Name (Last - 3 .. Last) = ".ali";
 582          exit when Result;
 583       end loop;
 584
 585       Close (Direct);
 586       return Result;
 587
 588    exception
 589       --  If there is any problem, close the directory if open and return
 590       --  True; the library directory will be added to the path.
 591
 592       when others =>
 593          if Is_Open (Direct) then
 594             Close (Direct);
 595          end if;
 596
 597          return True;
 598    end Contains_ALI_Files;
 599
 600    --------------------------------
 601    -- Create_Config_Pragmas_File --
 602    --------------------------------
 603
 604    procedure Create_Config_Pragmas_File
 605      (For_Project          : Project_Id;
 606       Main_Project         : Project_Id;
 607       Include_Config_Files : Boolean := True)
 608    is
 609       pragma Unreferenced (Main_Project);
 610       pragma Unreferenced (Include_Config_Files);
 611
 612       File_Name : Name_Id         := No_Name;
 613       File      : File_Descriptor := Invalid_FD;
 614
 615       Current_Unit : Unit_Id := Units.First;
 616
 617       First_Project : Project_List := Empty_Project_List;
 618
 619       Current_Project : Project_List;
 620       Current_Naming  : Naming_Id;
 621
 622       Status : Boolean;
 623       --  For call to Close
 624
 625       procedure Check (Project : Project_Id);
 626       --  Recursive procedure that put in the config pragmas file any non
 627       --  standard naming schemes, if it is not already in the file, then call
 628       --  itself for any imported project.
 629
 630       procedure Check_Temp_File;
 631       --  Check that a temporary file has been opened.
 632       --  If not, create one, and put its name in the project data,
 633       --  with the indication that it is a temporary file.
 634
 635       procedure Put
 636         (Unit_Name : Name_Id;
 637          File_Name : Name_Id;
 638          Unit_Kind : Spec_Or_Body;
 639          Index     : Int);
 640       --  Put an SFN pragma in the temporary file
 641
 642       procedure Put (File : File_Descriptor; S : String);
 643       procedure Put_Line (File : File_Descriptor; S : String);
 644       --  Output procedures, analogous to normal Text_IO procs of same name
 645
 646       -----------
 647       -- Check --
 648       -----------
 649
 650       procedure Check (Project : Project_Id) is
 651          Data : constant Project_Data := Projects.Table (Project);
 652
 653       begin
 654          if Current_Verbosity = High then
 655             Write_Str ("Checking project file """);
 656             Write_Str (Namet.Get_Name_String (Data.Name));
 657             Write_Str (""".");
 658             Write_Eol;
 659          end if;
 660
 661          --  Is this project in the list of the visited project?
 662
 663          Current_Project := First_Project;
 664          while Current_Project /= Empty_Project_List
 665            and then Project_Lists.Table (Current_Project).Project /= Project
 666          loop
 667             Current_Project := Project_Lists.Table (Current_Project).Next;
 668          end loop;
 669
 670          --  If it is not, put it in the list, and visit it
 671
 672          if Current_Project = Empty_Project_List then
 673             Project_Lists.Increment_Last;
 674             Project_Lists.Table (Project_Lists.Last) :=
 675               (Project => Project, Next => First_Project);
 676             First_Project := Project_Lists.Last;
 677
 678             --  Is the naming scheme of this project one that we know?
 679
 680             Current_Naming := Default_Naming;
 681             while Current_Naming <= Namings.Last and then
 682               not Same_Naming_Scheme
 683               (Left => Namings.Table (Current_Naming),
 684                Right => Data.Naming) loop
 685                Current_Naming := Current_Naming + 1;
 686             end loop;
 687
 688             --  If we don't know it, add it
 689
 690             if Current_Naming > Namings.Last then
 691                Namings.Increment_Last;
 692                Namings.Table (Namings.Last) := Data.Naming;
 693
 694                --  We need a temporary file to be created
 695
 696                Check_Temp_File;
 697
 698                --  Put the SFN pragmas for the naming scheme
 699
 700                --  Spec
 701
 702                Put_Line
 703                  (File, "pragma Source_File_Name_Project");
 704                Put_Line
 705                  (File, "  (Spec_File_Name  => ""*" &
 706                   Namet.Get_Name_String (Data.Naming.Ada_Spec_Suffix) &
 707                   """,");
 708                Put_Line
 709                  (File, "   Casing          => " &
 710                   Image (Data.Naming.Casing) & ",");
 711                Put_Line
 712                  (File, "   Dot_Replacement => """ &
 713                  Namet.Get_Name_String (Data.Naming.Dot_Replacement) &
 714                   """);");
 715
 716                --  and body
 717
 718                Put_Line
 719                  (File, "pragma Source_File_Name_Project");
 720                Put_Line
 721                  (File, "  (Body_File_Name  => ""*" &
 722                   Namet.Get_Name_String (Data.Naming.Ada_Body_Suffix) &
 723                   """,");
 724                Put_Line
 725                  (File, "   Casing          => " &
 726                   Image (Data.Naming.Casing) & ",");
 727                Put_Line
 728                  (File, "   Dot_Replacement => """ &
 729                   Namet.Get_Name_String (Data.Naming.Dot_Replacement) &
 730                   """);");
 731
 732                --  and maybe separate
 733
 734                if
 735                  Data.Naming.Ada_Body_Suffix /= Data.Naming.Separate_Suffix
 736                then
 737                   Put_Line
 738                     (File, "pragma Source_File_Name_Project");
 739                   Put_Line
 740                     (File, "  (Subunit_File_Name  => ""*" &
 741                      Namet.Get_Name_String (Data.Naming.Separate_Suffix) &
 742                      """,");
 743                   Put_Line
 744                     (File, "   Casing          => " &
 745                      Image (Data.Naming.Casing) &
 746                      ",");
 747                   Put_Line
 748                     (File, "   Dot_Replacement => """ &
 749                      Namet.Get_Name_String (Data.Naming.Dot_Replacement) &
 750                      """);");
 751                end if;
 752             end if;
 753
 754             if Data.Extends /= No_Project then
 755                Check (Data.Extends);
 756             end if;
 757
 758             declare
 759                Current : Project_List := Data.Imported_Projects;
 760
 761             begin
 762                while Current /= Empty_Project_List loop
 763                   Check (Project_Lists.Table (Current).Project);
 764                   Current := Project_Lists.Table (Current).Next;
 765                end loop;
 766             end;
 767          end if;
 768       end Check;
 769
 770       ---------------------
 771       -- Check_Temp_File --
 772       ---------------------
 773
 774       procedure Check_Temp_File is
 775       begin
 776          if File = Invalid_FD then
 777             Tempdir.Create_Temp_File (File, Name => File_Name);
 778
 779             if File = Invalid_FD then
 780                Prj.Com.Fail
 781                  ("unable to create temporary configuration pragmas file");
 782             elsif Opt.Verbose_Mode then
 783                Write_Str ("Creating temp file """);
 784                Write_Str (Get_Name_String (File_Name));
 785                Write_Line ("""");
 786             end if;
 787          end if;
 788       end Check_Temp_File;
 789
 790       ---------
 791       -- Put --
 792       ---------
 793
 794       procedure Put
 795         (Unit_Name : Name_Id;
 796          File_Name : Name_Id;
 797          Unit_Kind : Spec_Or_Body;
 798          Index     : Int)
 799       is
 800       begin
 801          --  A temporary file needs to be open
 802
 803          Check_Temp_File;
 804
 805          --  Put the pragma SFN for the unit kind (spec or body)
 806
 807          Put (File, "pragma Source_File_Name_Project (");
 808          Put (File, Namet.Get_Name_String (Unit_Name));
 809
 810          if Unit_Kind = Specification then
 811             Put (File, ", Spec_File_Name => """);
 812          else
 813             Put (File, ", Body_File_Name => """);
 814          end if;
 815
 816          Put (File, Namet.Get_Name_String (File_Name));
 817          Put (File, """");
 818
 819          if Index /= 0 then
 820             Put (File, ", Index =>");
 821             Put (File, Index'Img);
 822          end if;
 823
 824          Put_Line (File, ");");
 825       end Put;
 826
 827       procedure Put (File : File_Descriptor; S : String) is
 828          Last : Natural;
 829
 830       begin
 831          Last := Write (File, S (S'First)'Address, S'Length);
 832
 833          if Last /= S'Length then
 834             Prj.Com.Fail ("Disk full");
 835          end if;
 836
 837          if Current_Verbosity = High then
 838             Write_Str (S);
 839          end if;
 840       end Put;
 841
 842       --------------
 843       -- Put_Line --
 844       --------------
 845
 846       procedure Put_Line (File : File_Descriptor; S : String) is
 847          S0   : String (1 .. S'Length + 1);
 848          Last : Natural;
 849
 850       begin
 851          --  Add an ASCII.LF to the string. As this config file is supposed to
 852          --  be used only by the compiler, we don't care about the characters
 853          --  for the end of line. In fact we could have put a space, but
 854          --  it is more convenient to be able to read gnat.adc during
 855          --  development, for which the ASCII.LF is fine.
 856
 857          S0 (1 .. S'Length) := S;
 858          S0 (S0'Last) := ASCII.LF;
 859          Last := Write (File, S0'Address, S0'Length);
 860
 861          if Last /= S'Length + 1 then
 862             Prj.Com.Fail ("Disk full");
 863          end if;
 864
 865          if Current_Verbosity = High then
 866             Write_Line (S);
 867          end if;
 868       end Put_Line;
 869
 870    --  Start of processing for Create_Config_Pragmas_File
 871
 872    begin
 873       if not Projects.Table (For_Project).Config_Checked then
 874
 875          --  Remove any memory of processed naming schemes, if any
 876
 877          Namings.Set_Last (Default_Naming);
 878
 879          --  Check the naming schemes
 880
 881          Check (For_Project);
 882
 883          --  Visit all the units and process those that need an SFN pragma
 884
 885          while Current_Unit <= Units.Last loop
 886             declare
 887                Unit : constant Unit_Data :=
 888                  Units.Table (Current_Unit);
 889
 890             begin
 891                if Unit.File_Names (Specification).Needs_Pragma then
 892                   Put (Unit.Name,
 893                        Unit.File_Names (Specification).Name,
 894                        Specification,
 895                        Unit.File_Names (Specification).Index);
 896                end if;
 897
 898                if Unit.File_Names (Body_Part).Needs_Pragma then
 899                   Put (Unit.Name,
 900                        Unit.File_Names (Body_Part).Name,
 901                        Body_Part,
 902                        Unit.File_Names (Body_Part).Index);
 903                end if;
 904
 905                Current_Unit := Current_Unit + 1;
 906             end;
 907          end loop;
 908
 909          --  If there are no non standard naming scheme, issue the GNAT
 910          --  standard naming scheme. This will tell the compiler that
 911          --  a project file is used and will forbid any pragma SFN.
 912
 913          if File = Invalid_FD then
 914             Check_Temp_File;
 915
 916             Put_Line (File, "pragma Source_File_Name_Project");
 917             Put_Line (File, "   (Spec_File_Name  => ""*.ads"",");
 918             Put_Line (File, "    Dot_Replacement => ""-"",");
 919             Put_Line (File, "    Casing          => lowercase);");
 920
 921             Put_Line (File, "pragma Source_File_Name_Project");
 922             Put_Line (File, "   (Body_File_Name  => ""*.adb"",");
 923             Put_Line (File, "    Dot_Replacement => ""-"",");
 924             Put_Line (File, "    Casing          => lowercase);");
 925          end if;
 926
 927          --  Close the temporary file
 928
 929          GNAT.OS_Lib.Close (File, Status);
 930
 931          if not Status then
 932             Prj.Com.Fail ("disk full");
 933          end if;
 934
 935          if Opt.Verbose_Mode then
 936             Write_Str ("Closing configuration file """);
 937             Write_Str (Get_Name_String (File_Name));
 938             Write_Line ("""");
 939          end if;
 940
 941          Projects.Table (For_Project).Config_File_Name := File_Name;
 942          Projects.Table (For_Project).Config_File_Temp := True;
 943
 944          Projects.Table (For_Project).Config_Checked := True;
 945       end if;
 946    end Create_Config_Pragmas_File;
 947
 948    -------------------------
 949    -- Create_Mapping_File --
 950    -------------------------
 951
 952    procedure Create_Mapping_File
 953      (Project : Project_Id;
 954       Name    : out Name_Id)
 955    is
 956       File          : File_Descriptor := Invalid_FD;
 957       The_Unit_Data : Unit_Data;
 958       Data          : File_Name_Data;
 959
 960       Status : Boolean;
 961       --  For call to Close
 962
 963       Present : Project_Flags (No_Project .. Projects.Last) :=
 964         (others => False);
 965       --  For each project in the closure of Project, the corresponding flag
 966       --  will be set to True;
 967
 968       procedure Put_Name_Buffer;
 969       --  Put the line contained in the Name_Buffer in the mapping file
 970
 971       procedure Put_Data (Spec : Boolean);
 972       --  Put the mapping of the spec or body contained in Data in the file
 973       --  (3 lines).
 974
 975       procedure Recursive_Flag (Prj : Project_Id);
 976       --  Set the flags corresponding to Prj, the projects it imports
 977       --  (directly or indirectly) or extends to True. Call itself recursively.
 978
 979       ---------
 980       -- Put --
 981       ---------
 982
 983       procedure Put_Name_Buffer is
 984          Last : Natural;
 985
 986       begin
 987          Name_Len := Name_Len + 1;
 988          Name_Buffer (Name_Len) := ASCII.LF;
 989          Last := Write (File, Name_Buffer (1)'Address, Name_Len);
 990
 991          if Last /= Name_Len then
 992             Prj.Com.Fail ("Disk full");
 993          end if;
 994       end Put_Name_Buffer;
 995
 996       --------------
 997       -- Put_Data --
 998       --------------
 999
1000       procedure Put_Data (Spec : Boolean) is
1001       begin
1002          --  Line with the unit name
1003
1004          Get_Name_String (The_Unit_Data.Name);
1005          Name_Len := Name_Len + 1;
1006          Name_Buffer (Name_Len) := '%';
1007          Name_Len := Name_Len + 1;
1008
1009          if Spec then
1010             Name_Buffer (Name_Len) := 's';
1011          else
1012             Name_Buffer (Name_Len) := 'b';
1013          end if;
1014
1015          Put_Name_Buffer;
1016
1017          --  Line with the file name
1018
1019          Get_Name_String (Data.Name);
1020          Put_Name_Buffer;
1021
1022          --  Line with the path name
1023
1024          Get_Name_String (Data.Path);
1025          Put_Name_Buffer;
1026
1027       end Put_Data;
1028
1029       --------------------
1030       -- Recursive_Flag --
1031       --------------------
1032
1033       procedure Recursive_Flag (Prj : Project_Id) is
1034          Imported : Project_List;
1035          Proj     : Project_Id;
1036
1037       begin
1038          --  Nothing to do for non existent project or project that has
1039          --  already been flagged.
1040
1041          if Prj = No_Project or else Present (Prj) then
1042             return;
1043          end if;
1044
1045          --  Flag the current project
1046
1047          Present (Prj) := True;
1048          Imported := Projects.Table (Prj).Imported_Projects;
1049
1050          --  Call itself for each project directly imported
1051
1052          while Imported /= Empty_Project_List loop
1053             Proj := Project_Lists.Table (Imported).Project;
1054             Imported := Project_Lists.Table (Imported).Next;
1055             Recursive_Flag (Proj);
1056          end loop;
1057
1058          --  Call itself for an eventual project being extended
1059
1060          Recursive_Flag (Projects.Table (Prj).Extends);
1061       end Recursive_Flag;
1062
1063    --  Start of processing for Create_Mapping_File
1064
1065    begin
1066       --  Flag the necessary projects
1067
1068       Recursive_Flag (Project);
1069
1070       --  Create the temporary file
1071
1072       Tempdir.Create_Temp_File (File, Name => Name);
1073
1074       if File = Invalid_FD then
1075          Prj.Com.Fail ("unable to create temporary mapping file");
1076
1077       elsif Opt.Verbose_Mode then
1078          Write_Str ("Creating temp mapping file """);
1079          Write_Str (Get_Name_String (Name));
1080          Write_Line ("""");
1081       end if;
1082
1083       if Fill_Mapping_File then
1084          --  For all units in table Units
1085
1086          for Unit in 1 .. Units.Last loop
1087             The_Unit_Data := Units.Table (Unit);
1088
1089             --  If the unit has a valid name
1090
1091             if The_Unit_Data.Name /= No_Name then
1092                Data := The_Unit_Data.File_Names (Specification);
1093
1094                --  If there is a spec, put it mapping in the file if it is
1095                --  from a project in the closure of Project.
1096
1097                if Data.Name /= No_Name and then Present (Data.Project) then
1098                   Put_Data (Spec => True);
1099                end if;
1100
1101                Data := The_Unit_Data.File_Names (Body_Part);
1102
1103                --  If there is a body (or subunit) put its mapping in the file
1104                --  if it is from a project in the closure of Project.
1105
1106                if Data.Name /= No_Name and then Present (Data.Project) then
1107                   Put_Data (Spec => False);
1108                end if;
1109
1110             end if;
1111          end loop;
1112       end if;
1113
1114       GNAT.OS_Lib.Close (File, Status);
1115
1116       if not Status then
1117          Prj.Com.Fail ("disk full");
1118       end if;
1119    end Create_Mapping_File;
1120
1121    --------------------------
1122    -- Create_New_Path_File --
1123    --------------------------
1124
1125    procedure Create_New_Path_File
1126      (Path_FD   : out File_Descriptor;
1127       Path_Name : out Name_Id)
1128    is
1129    begin
1130       Tempdir.Create_Temp_File (Path_FD, Path_Name);
1131
1132       if Path_Name /= No_Name then
1133
1134          --  Record the name, so that the temp path file will be deleted
1135          --  at the end of the program.
1136
1137          Path_Files.Increment_Last;
1138          Path_Files.Table (Path_Files.Last) := Path_Name;
1139       end if;
1140    end Create_New_Path_File;
1141
1142    ---------------------------
1143    -- Delete_All_Path_Files --
1144    ---------------------------
1145
1146    procedure Delete_All_Path_Files is
1147       Disregard : Boolean := True;
1148
1149    begin
1150       for Index in 1 .. Path_Files.Last loop
1151          if Path_Files.Table (Index) /= No_Name then
1152             Delete_File
1153               (Get_Name_String (Path_Files.Table (Index)), Disregard);
1154          end if;
1155       end loop;
1156
1157       --  If any of the environment variables ADA_PRJ_INCLUDE_FILE or
1158       --  ADA_PRJ_OBJECTS_FILE has been set, then reset their value to
1159       --  the empty string. On VMS, this has the effect of deassigning
1160       --  the logical names.
1161
1162       if Ada_Prj_Include_File_Set then
1163          Setenv (Project_Include_Path_File, "");
1164          Ada_Prj_Include_File_Set := False;
1165       end if;
1166
1167       if Ada_Prj_Objects_File_Set then
1168          Setenv (Project_Objects_Path_File, "");
1169          Ada_Prj_Objects_File_Set := False;
1170       end if;
1171    end Delete_All_Path_Files;
1172
1173    ------------------------------------
1174    -- File_Name_Of_Library_Unit_Body --
1175    ------------------------------------
1176
1177    function File_Name_Of_Library_Unit_Body
1178      (Name              : String;
1179       Project           : Project_Id;
1180       Main_Project_Only : Boolean := True;
1181       Full_Path         : Boolean := False) return String
1182    is
1183       The_Project   : Project_Id := Project;
1184       Data          : Project_Data := Projects.Table (Project);
1185       Original_Name : String := Name;
1186
1187       Extended_Spec_Name : String :=
1188                              Name & Namet.Get_Name_String
1189                                       (Data.Naming.Ada_Spec_Suffix);
1190       Extended_Body_Name : String :=
1191                              Name & Namet.Get_Name_String
1192                                       (Data.Naming.Ada_Body_Suffix);
1193
1194       Unit : Unit_Data;
1195
1196       The_Original_Name : Name_Id;
1197       The_Spec_Name     : Name_Id;
1198       The_Body_Name     : Name_Id;
1199
1200    begin
1201       Canonical_Case_File_Name (Original_Name);
1202       Name_Len := Original_Name'Length;
1203       Name_Buffer (1 .. Name_Len) := Original_Name;
1204       The_Original_Name := Name_Find;
1205
1206       Canonical_Case_File_Name (Extended_Spec_Name);
1207       Name_Len := Extended_Spec_Name'Length;
1208       Name_Buffer (1 .. Name_Len) := Extended_Spec_Name;
1209       The_Spec_Name := Name_Find;
1210
1211       Canonical_Case_File_Name (Extended_Body_Name);
1212       Name_Len := Extended_Body_Name'Length;
1213       Name_Buffer (1 .. Name_Len) := Extended_Body_Name;
1214       The_Body_Name := Name_Find;
1215
1216       if Current_Verbosity = High then
1217          Write_Str  ("Looking for file name of """);
1218          Write_Str  (Name);
1219          Write_Char ('"');
1220          Write_Eol;
1221          Write_Str  ("   Extended Spec Name = """);
1222          Write_Str  (Extended_Spec_Name);
1223          Write_Char ('"');
1224          Write_Eol;
1225          Write_Str  ("   Extended Body Name = """);
1226          Write_Str  (Extended_Body_Name);
1227          Write_Char ('"');
1228          Write_Eol;
1229       end if;
1230
1231       --  For extending project, search in the extended project
1232       --  if the source is not found. For non extending projects,
1233       --  this loop will be run only once.
1234
1235       loop
1236          --  Loop through units
1237          --  Should have comment explaining reverse ???
1238
1239          for Current in reverse Units.First .. Units.Last loop
1240             Unit := Units.Table (Current);
1241
1242             --  Check for body
1243
1244             if not Main_Project_Only
1245               or else Unit.File_Names (Body_Part).Project = The_Project
1246             then
1247                declare
1248                   Current_Name : constant Name_Id :=
1249                                    Unit.File_Names (Body_Part).Name;
1250
1251                begin
1252                   --  Case of a body present
1253
1254                   if Current_Name /= No_Name then
1255                      if Current_Verbosity = High then
1256                         Write_Str  ("   Comparing with """);
1257                         Write_Str  (Get_Name_String (Current_Name));
1258                         Write_Char ('"');
1259                         Write_Eol;
1260                      end if;
1261
1262                      --  If it has the name of the original name,
1263                      --  return the original name
1264
1265                      if Unit.Name = The_Original_Name
1266                        or else Current_Name = The_Original_Name
1267                      then
1268                         if Current_Verbosity = High then
1269                            Write_Line ("   OK");
1270                         end if;
1271
1272                         if Full_Path then
1273                            return Get_Name_String
1274                              (Unit.File_Names (Body_Part).Path);
1275
1276                         else
1277                            return Get_Name_String (Current_Name);
1278                         end if;
1279
1280                         --  If it has the name of the extended body name,
1281                         --  return the extended body name
1282
1283                      elsif Current_Name = The_Body_Name then
1284                         if Current_Verbosity = High then
1285                            Write_Line ("   OK");
1286                         end if;
1287
1288                         if Full_Path then
1289                            return Get_Name_String
1290                              (Unit.File_Names (Body_Part).Path);
1291
1292                         else
1293                            return Extended_Body_Name;
1294                         end if;
1295
1296                      else
1297                         if Current_Verbosity = High then
1298                            Write_Line ("   not good");
1299                         end if;
1300                      end if;
1301                   end if;
1302                end;
1303             end if;
1304
1305             --  Check for spec
1306
1307             if not Main_Project_Only
1308               or else Unit.File_Names (Specification).Project = The_Project
1309             then
1310                declare
1311                   Current_Name : constant Name_Id :=
1312                                    Unit.File_Names (Specification).Name;
1313
1314                begin
1315                   --  Case of spec present
1316
1317                   if Current_Name /= No_Name then
1318                      if Current_Verbosity = High then
1319                         Write_Str  ("   Comparing with """);
1320                         Write_Str  (Get_Name_String (Current_Name));
1321                         Write_Char ('"');
1322                         Write_Eol;
1323                      end if;
1324
1325                      --  If name same as original name, return original name
1326
1327                      if Unit.Name = The_Original_Name
1328                        or else Current_Name = The_Original_Name
1329                      then
1330                         if Current_Verbosity = High then
1331                            Write_Line ("   OK");
1332                         end if;
1333
1334                         if Full_Path then
1335                            return Get_Name_String
1336                              (Unit.File_Names (Specification).Path);
1337                         else
1338                            return Get_Name_String (Current_Name);
1339                         end if;
1340
1341                         --  If it has the same name as the extended spec name,
1342                         --  return the extended spec name.
1343
1344                      elsif Current_Name = The_Spec_Name then
1345                         if Current_Verbosity = High then
1346                            Write_Line ("   OK");
1347                         end if;
1348
1349                         if Full_Path then
1350                            return Get_Name_String
1351                              (Unit.File_Names (Specification).Path);
1352                         else
1353                            return Extended_Spec_Name;
1354                         end if;
1355
1356                      else
1357                         if Current_Verbosity = High then
1358                            Write_Line ("   not good");
1359                         end if;
1360                      end if;
1361                   end if;
1362                end;
1363             end if;
1364          end loop;
1365
1366          --  If we are not in an extending project, give up
1367
1368          exit when (not Main_Project_Only) or else Data.Extends = No_Project;
1369
1370          --  Otherwise, look in the project we are extending
1371
1372          The_Project := Data.Extends;
1373          Data := Projects.Table (The_Project);
1374       end loop;
1375
1376       --  We don't know this file name, return an empty string
1377
1378       return "";
1379    end File_Name_Of_Library_Unit_Body;
1380
1381    -------------------------
1382    -- For_All_Object_Dirs --
1383    -------------------------
1384
1385    procedure For_All_Object_Dirs (Project : Project_Id) is
1386       Seen : Project_List := Empty_Project_List;
1387
1388       procedure Add (Project : Project_Id);
1389       --  Process a project. Remember the processes visited to avoid
1390       --  processing a project twice. Recursively process an eventual
1391       --  extended project, and all imported projects.
1392
1393       ---------
1394       -- Add --
1395       ---------
1396
1397       procedure Add (Project : Project_Id) is
1398          Data : constant Project_Data := Projects.Table (Project);
1399          List : Project_List := Data.Imported_Projects;
1400
1401       begin
1402          --  If the list of visited project is empty, then
1403          --  for sure we never visited this project.
1404
1405          if Seen = Empty_Project_List then
1406             Project_Lists.Increment_Last;
1407             Seen := Project_Lists.Last;
1408             Project_Lists.Table (Seen) :=
1409               (Project => Project, Next => Empty_Project_List);
1410
1411          else
1412             --  Check if the project is in the list
1413
1414             declare
1415                Current : Project_List := Seen;
1416
1417             begin
1418                loop
1419                   --  If it is, then there is nothing else to do
1420
1421                   if Project_Lists.Table (Current).Project = Project then
1422                      return;
1423                   end if;
1424
1425                   exit when Project_Lists.Table (Current).Next =
1426                     Empty_Project_List;
1427                   Current := Project_Lists.Table (Current).Next;
1428                end loop;
1429
1430                --  This project has never been visited, add it
1431                --  to the list.
1432
1433                Project_Lists.Increment_Last;
1434                Project_Lists.Table (Current).Next := Project_Lists.Last;
1435                Project_Lists.Table (Project_Lists.Last) :=
1436                  (Project => Project, Next => Empty_Project_List);
1437             end;
1438          end if;
1439
1440          --  If there is an object directory, call Action
1441          --  with its name
1442
1443          if Data.Object_Directory /= No_Name then
1444             Get_Name_String (Data.Object_Directory);
1445             Action (Name_Buffer (1 .. Name_Len));
1446          end if;
1447
1448          --  If we are extending a project, visit it
1449
1450          if Data.Extends /= No_Project then
1451             Add (Data.Extends);
1452          end if;
1453
1454          --  And visit all imported projects
1455
1456          while List /= Empty_Project_List loop
1457             Add (Project_Lists.Table (List).Project);
1458             List := Project_Lists.Table (List).Next;
1459          end loop;
1460       end Add;
1461
1462    --  Start of processing for For_All_Object_Dirs
1463
1464    begin
1465       --  Visit this project, and its imported projects,
1466       --  recursively
1467
1468       Add (Project);
1469    end For_All_Object_Dirs;
1470
1471    -------------------------
1472    -- For_All_Source_Dirs --
1473    -------------------------
1474
1475    procedure For_All_Source_Dirs (Project : Project_Id) is
1476       Seen : Project_List := Empty_Project_List;
1477
1478       procedure Add (Project : Project_Id);
1479       --  Process a project. Remember the processes visited to avoid
1480       --  processing a project twice. Recursively process an eventual
1481       --  extended project, and all imported projects.
1482
1483       ---------
1484       -- Add --
1485       ---------
1486
1487       procedure Add (Project : Project_Id) is
1488          Data : constant Project_Data := Projects.Table (Project);
1489          List : Project_List := Data.Imported_Projects;
1490
1491       begin
1492          --  If the list of visited project is empty, then
1493          --  for sure we never visited this project.
1494
1495          if Seen = Empty_Project_List then
1496             Project_Lists.Increment_Last;
1497             Seen := Project_Lists.Last;
1498             Project_Lists.Table (Seen) :=
1499               (Project => Project, Next => Empty_Project_List);
1500
1501          else
1502             --  Check if the project is in the list
1503
1504             declare
1505                Current : Project_List := Seen;
1506
1507             begin
1508                loop
1509                   --  If it is, then there is nothing else to do
1510
1511                   if Project_Lists.Table (Current).Project = Project then
1512                      return;
1513                   end if;
1514
1515                   exit when Project_Lists.Table (Current).Next =
1516                     Empty_Project_List;
1517                   Current := Project_Lists.Table (Current).Next;
1518                end loop;
1519
1520                --  This project has never been visited, add it
1521                --  to the list.
1522
1523                Project_Lists.Increment_Last;
1524                Project_Lists.Table (Current).Next := Project_Lists.Last;
1525                Project_Lists.Table (Project_Lists.Last) :=
1526                  (Project => Project, Next => Empty_Project_List);
1527             end;
1528          end if;
1529
1530          declare
1531             Current    : String_List_Id := Data.Source_Dirs;
1532             The_String : String_Element;
1533
1534          begin
1535             --  If there are Ada sources, call action with the name of every
1536             --  source directory.
1537
1538             if Projects.Table (Project).Ada_Sources_Present then
1539                while Current /= Nil_String loop
1540                   The_String := String_Elements.Table (Current);
1541                   Action (Get_Name_String (The_String.Value));
1542                   Current := The_String.Next;
1543                end loop;
1544             end if;
1545          end;
1546
1547          --  If we are extending a project, visit it
1548
1549          if Data.Extends /= No_Project then
1550             Add (Data.Extends);
1551          end if;
1552
1553          --  And visit all imported projects
1554
1555          while List /= Empty_Project_List loop
1556             Add (Project_Lists.Table (List).Project);
1557             List := Project_Lists.Table (List).Next;
1558          end loop;
1559       end Add;
1560
1561    --  Start of processing for For_All_Source_Dirs
1562
1563    begin
1564       --  Visit this project, and its imported projects recursively
1565
1566       Add (Project);
1567    end For_All_Source_Dirs;
1568
1569    -------------------
1570    -- Get_Reference --
1571    -------------------
1572
1573    procedure Get_Reference
1574      (Source_File_Name : String;
1575       Project          : out Project_Id;
1576       Path             : out Name_Id)
1577    is
1578    begin
1579       --  Body below could use some comments ???
1580
1581       if Current_Verbosity > Default then
1582          Write_Str ("Getting Reference_Of (""");
1583          Write_Str (Source_File_Name);
1584          Write_Str (""") ... ");
1585       end if;
1586
1587       declare
1588          Original_Name : String := Source_File_Name;
1589          Unit          : Unit_Data;
1590
1591       begin
1592          Canonical_Case_File_Name (Original_Name);
1593
1594          for Id in Units.First .. Units.Last loop
1595             Unit := Units.Table (Id);
1596
1597             if (Unit.File_Names (Specification).Name /= No_Name
1598                  and then
1599                    Namet.Get_Name_String
1600                      (Unit.File_Names (Specification).Name) = Original_Name)
1601               or else (Unit.File_Names (Specification).Path /= No_Name
1602                          and then
1603                            Namet.Get_Name_String
1604                            (Unit.File_Names (Specification).Path) =
1605                                                               Original_Name)
1606             then
1607                Project := Ultimate_Extension_Of
1608                             (Unit.File_Names (Specification).Project);
1609                Path := Unit.File_Names (Specification).Display_Path;
1610
1611                if Current_Verbosity > Default then
1612                   Write_Str ("Done: Specification.");
1613                   Write_Eol;
1614                end if;
1615
1616                return;
1617
1618             elsif (Unit.File_Names (Body_Part).Name /= No_Name
1619                     and then
1620                       Namet.Get_Name_String
1621                         (Unit.File_Names (Body_Part).Name) = Original_Name)
1622               or else (Unit.File_Names (Body_Part).Path /= No_Name
1623                          and then Namet.Get_Name_String
1624                                     (Unit.File_Names (Body_Part).Path) =
1625                                                              Original_Name)
1626             then
1627                Project := Ultimate_Extension_Of
1628                             (Unit.File_Names (Body_Part).Project);
1629                Path := Unit.File_Names (Body_Part).Display_Path;
1630
1631                if Current_Verbosity > Default then
1632                   Write_Str ("Done: Body.");
1633                   Write_Eol;
1634                end if;
1635
1636                return;
1637             end if;
1638          end loop;
1639       end;
1640
1641       Project := No_Project;
1642       Path    := No_Name;
1643
1644       if Current_Verbosity > Default then
1645          Write_Str ("Cannot be found.");
1646          Write_Eol;
1647       end if;
1648    end Get_Reference;
1649
1650    ----------------
1651    -- Initialize --
1652    ----------------
1653
1654    --  This is a place holder for possible required initialization in
1655    --  the future. In the current version no initialization is required.
1656
1657    procedure Initialize is
1658    begin
1659       null;
1660    end Initialize;
1661
1662    ------------------------------------
1663    -- Path_Name_Of_Library_Unit_Body --
1664    ------------------------------------
1665
1666    --  Could use some comments in the body here ???
1667
1668    function Path_Name_Of_Library_Unit_Body
1669      (Name    : String;
1670       Project : Project_Id) return String
1671    is
1672       Data          : constant Project_Data := Projects.Table (Project);
1673       Original_Name : String := Name;
1674
1675       Extended_Spec_Name : String :=
1676                              Name & Namet.Get_Name_String
1677                                      (Data.Naming.Ada_Spec_Suffix);
1678       Extended_Body_Name : String :=
1679                              Name & Namet.Get_Name_String
1680                                      (Data.Naming.Ada_Body_Suffix);
1681
1682       First   : Unit_Id := Units.First;
1683       Current : Unit_Id;
1684       Unit    : Unit_Data;
1685
1686    begin
1687       Canonical_Case_File_Name (Original_Name);
1688       Canonical_Case_File_Name (Extended_Spec_Name);
1689       Canonical_Case_File_Name (Extended_Body_Name);
1690
1691       if Current_Verbosity = High then
1692          Write_Str  ("Looking for path name of """);
1693          Write_Str  (Name);
1694          Write_Char ('"');
1695          Write_Eol;
1696          Write_Str  ("   Extended Spec Name = """);
1697          Write_Str  (Extended_Spec_Name);
1698          Write_Char ('"');
1699          Write_Eol;
1700          Write_Str  ("   Extended Body Name = """);
1701          Write_Str  (Extended_Body_Name);
1702          Write_Char ('"');
1703          Write_Eol;
1704       end if;
1705
1706       while First <= Units.Last
1707         and then Units.Table (First).File_Names (Body_Part).Project /= Project
1708       loop
1709          First := First + 1;
1710       end loop;
1711
1712       Current := First;
1713       while Current <= Units.Last loop
1714          Unit := Units.Table (Current);
1715
1716          if Unit.File_Names (Body_Part).Project = Project
1717            and then Unit.File_Names (Body_Part).Name /= No_Name
1718          then
1719             declare
1720                Current_Name : constant String :=
1721                  Namet.Get_Name_String (Unit.File_Names (Body_Part).Name);
1722             begin
1723                if Current_Verbosity = High then
1724                   Write_Str  ("   Comparing with """);
1725                   Write_Str  (Current_Name);
1726                   Write_Char ('"');
1727                   Write_Eol;
1728                end if;
1729
1730                if Current_Name = Original_Name then
1731                   if Current_Verbosity = High then
1732                      Write_Line ("   OK");
1733                   end if;
1734
1735                   return Body_Path_Name_Of (Current);
1736
1737                elsif Current_Name = Extended_Body_Name then
1738                   if Current_Verbosity = High then
1739                      Write_Line ("   OK");
1740                   end if;
1741
1742                   return Body_Path_Name_Of (Current);
1743
1744                else
1745                   if Current_Verbosity = High then
1746                      Write_Line ("   not good");
1747                   end if;
1748                end if;
1749             end;
1750
1751          elsif Unit.File_Names (Specification).Name /= No_Name then
1752             declare
1753                Current_Name : constant String :=
1754                                 Namet.Get_Name_String
1755                                   (Unit.File_Names (Specification).Name);
1756
1757             begin
1758                if Current_Verbosity = High then
1759                   Write_Str  ("   Comparing with """);
1760                   Write_Str  (Current_Name);
1761                   Write_Char ('"');
1762                   Write_Eol;
1763                end if;
1764
1765                if Current_Name = Original_Name then
1766                   if Current_Verbosity = High then
1767                      Write_Line ("   OK");
1768                   end if;
1769
1770                   return Spec_Path_Name_Of (Current);
1771
1772                elsif Current_Name = Extended_Spec_Name then
1773                   if Current_Verbosity = High then
1774                      Write_Line ("   OK");
1775                   end if;
1776
1777                   return Spec_Path_Name_Of (Current);
1778
1779                else
1780                   if Current_Verbosity = High then
1781                      Write_Line ("   not good");
1782                   end if;
1783                end if;
1784             end;
1785          end if;
1786          Current := Current + 1;
1787       end loop;
1788
1789       return "";
1790    end Path_Name_Of_Library_Unit_Body;
1791
1792    -------------------
1793    -- Print_Sources --
1794    -------------------
1795
1796    --  Could use some comments in this body ???
1797
1798    procedure Print_Sources is
1799       Unit : Unit_Data;
1800
1801    begin
1802       Write_Line ("List of Sources:");
1803
1804       for Id in Units.First .. Units.Last loop
1805          Unit := Units.Table (Id);
1806          Write_Str  ("   ");
1807          Write_Line (Namet.Get_Name_String (Unit.Name));
1808
1809          if Unit.File_Names (Specification).Name /= No_Name then
1810             if Unit.File_Names (Specification).Project = No_Project then
1811                Write_Line ("   No project");
1812
1813             else
1814                Write_Str  ("   Project: ");
1815                Get_Name_String
1816                  (Projects.Table
1817                    (Unit.File_Names (Specification).Project).Path_Name);
1818                Write_Line (Name_Buffer (1 .. Name_Len));
1819             end if;
1820
1821             Write_Str  ("      spec: ");
1822             Write_Line
1823               (Namet.Get_Name_String
1824                (Unit.File_Names (Specification).Name));
1825          end if;
1826
1827          if Unit.File_Names (Body_Part).Name /= No_Name then
1828             if Unit.File_Names (Body_Part).Project = No_Project then
1829                Write_Line ("   No project");
1830
1831             else
1832                Write_Str  ("   Project: ");
1833                Get_Name_String
1834                  (Projects.Table
1835                    (Unit.File_Names (Body_Part).Project).Path_Name);
1836                Write_Line (Name_Buffer (1 .. Name_Len));
1837             end if;
1838
1839             Write_Str  ("      body: ");
1840             Write_Line
1841               (Namet.Get_Name_String
1842                (Unit.File_Names (Body_Part).Name));
1843          end if;
1844       end loop;
1845
1846       Write_Line ("end of List of Sources.");
1847    end Print_Sources;
1848
1849    ----------------
1850    -- Project_Of --
1851    ----------------
1852
1853    function Project_Of
1854      (Name         : String;
1855       Main_Project : Project_Id) return Project_Id
1856    is
1857       Result : Project_Id := No_Project;
1858
1859       Original_Name : String := Name;
1860
1861       Data : constant Project_Data := Projects.Table (Main_Project);
1862
1863       Extended_Spec_Name : String :=
1864                              Name & Namet.Get_Name_String
1865                                       (Data.Naming.Ada_Spec_Suffix);
1866       Extended_Body_Name : String :=
1867                              Name & Namet.Get_Name_String
1868                                       (Data.Naming.Ada_Body_Suffix);
1869
1870       Unit : Unit_Data;
1871
1872       Current_Name : Name_Id;
1873
1874       The_Original_Name : Name_Id;
1875       The_Spec_Name     : Name_Id;
1876       The_Body_Name     : Name_Id;
1877
1878    begin
1879       Canonical_Case_File_Name (Original_Name);
1880       Name_Len := Original_Name'Length;
1881       Name_Buffer (1 .. Name_Len) := Original_Name;
1882       The_Original_Name := Name_Find;
1883
1884       Canonical_Case_File_Name (Extended_Spec_Name);
1885       Name_Len := Extended_Spec_Name'Length;
1886       Name_Buffer (1 .. Name_Len) := Extended_Spec_Name;
1887       The_Spec_Name := Name_Find;
1888
1889       Canonical_Case_File_Name (Extended_Body_Name);
1890       Name_Len := Extended_Body_Name'Length;
1891       Name_Buffer (1 .. Name_Len) := Extended_Body_Name;
1892       The_Body_Name := Name_Find;
1893
1894       for Current in reverse Units.First .. Units.Last loop
1895          Unit := Units.Table (Current);
1896
1897          --  Check for body
1898
1899          Current_Name := Unit.File_Names (Body_Part).Name;
1900
1901          --  Case of a body present
1902
1903          if Current_Name /= No_Name then
1904
1905             --  If it has the name of the original name or the body name,
1906             --  we have found the project.
1907
1908             if Unit.Name = The_Original_Name
1909               or else Current_Name = The_Original_Name
1910               or else Current_Name = The_Body_Name
1911             then
1912                Result := Unit.File_Names (Body_Part).Project;
1913                exit;
1914             end if;
1915          end if;
1916
1917          --  Check for spec
1918
1919          Current_Name := Unit.File_Names (Specification).Name;
1920
1921          if Current_Name /= No_Name then
1922
1923             --  If name same as the original name, or the spec name, we have
1924             --  found the project.
1925
1926             if Unit.Name = The_Original_Name
1927               or else Current_Name = The_Original_Name
1928               or else Current_Name = The_Spec_Name
1929             then
1930                Result := Unit.File_Names (Specification).Project;
1931                exit;
1932             end if;
1933          end if;
1934       end loop;
1935
1936       --  Get the ultimate extending project
1937
1938       if Result /= No_Project then
1939          while Projects.Table (Result).Extended_By /= No_Project loop
1940             Result := Projects.Table (Result).Extended_By;
1941          end loop;
1942       end if;
1943
1944       return Result;
1945    end Project_Of;
1946
1947    -------------------
1948    -- Set_Ada_Paths --
1949    -------------------
1950
1951    procedure Set_Ada_Paths
1952      (Project             : Project_Id;
1953       Including_Libraries : Boolean)
1954    is
1955       Source_FD : File_Descriptor := Invalid_FD;
1956       Object_FD : File_Descriptor := Invalid_FD;
1957
1958       Process_Source_Dirs : Boolean := False;
1959       Process_Object_Dirs : Boolean := False;
1960
1961       Status : Boolean;
1962       --  For calls to Close
1963
1964       Len : Natural;
1965
1966       procedure Add (Proj : Project_Id);
1967       --  Add all the source/object directories of a project to the path only
1968       --  if this project has not been visited. Calls an internal procedure
1969       --  recursively for projects being extended, and imported projects.
1970
1971       ---------
1972       -- Add --
1973       ---------
1974
1975       procedure Add (Proj : Project_Id) is
1976
1977          procedure Recursive_Add (Project : Project_Id);
1978          --  Recursive procedure to add the source/object paths of extended/
1979          --  imported projects.
1980
1981          -------------------
1982          -- Recursive_Add --
1983          -------------------
1984
1985          procedure Recursive_Add (Project : Project_Id) is
1986          begin
1987             --  If Seen is False, then the project has not yet been visited
1988
1989             if not Projects.Table (Project).Seen then
1990                Projects.Table (Project).Seen := True;
1991
1992                declare
1993                   Data : constant Project_Data := Projects.Table (Project);
1994                   List : Project_List := Data.Imported_Projects;
1995
1996                begin
1997                   if Process_Source_Dirs then
1998
1999                      --  Add to path all source directories of this project
2000                      --  if there are Ada sources.
2001
2002                      if Projects.Table (Project).Ada_Sources_Present then
2003                         Add_To_Source_Path (Data.Source_Dirs);
2004                      end if;
2005                   end if;
2006
2007                   if Process_Object_Dirs then
2008
2009                      --  Add to path the object directory of this project
2010                      --  except if we don't include library project and
2011                      --  this is a library project.
2012
2013                      if (Data.Library and then Including_Libraries)
2014                        or else
2015                          (Data.Object_Directory /= No_Name
2016                           and then
2017                             (not Including_Libraries or else not Data.Library))
2018                      then
2019                         --  For a library project, add the library directory
2020                         --  if there is no object directory or if the library
2021                         --  directory contains ALI files; otherwise add the
2022                         --  object directory.
2023
2024                         if Data.Library then
2025                            if Data.Object_Directory = No_Name
2026                              or else Contains_ALI_Files (Data.Library_Dir)
2027                            then
2028                               Add_To_Object_Path (Data.Library_Dir);
2029                            else
2030                               Add_To_Object_Path (Data.Object_Directory);
2031                            end if;
2032
2033                         --  For a non-library project, add the object
2034                         --  directory, if it is not a virtual project.
2035
2036                         elsif not Data.Virtual then
2037                            Add_To_Object_Path (Data.Object_Directory);
2038                         end if;
2039                      end if;
2040                   end if;
2041
2042                   --  Call Add to the project being extended, if any
2043
2044                   if Data.Extends /= No_Project then
2045                      Recursive_Add (Data.Extends);
2046                   end if;
2047
2048                   --  Call Add for each imported project, if any
2049
2050                   while List /= Empty_Project_List loop
2051                      Recursive_Add (Project_Lists.Table (List).Project);
2052                      List := Project_Lists.Table (List).Next;
2053                   end loop;
2054                end;
2055             end if;
2056          end Recursive_Add;
2057
2058       begin
2059          Source_Paths.Set_Last (0);
2060          Object_Paths.Set_Last (0);
2061
2062          for Index in 1 .. Projects.Last loop
2063             Projects.Table (Index).Seen := False;
2064          end loop;
2065
2066          Recursive_Add (Proj);
2067       end Add;
2068
2069    --  Start of processing for Set_Ada_Paths
2070
2071    begin
2072       --  If it is the first time we call this procedure for
2073       --  this project, compute the source path and/or the object path.
2074
2075       if Projects.Table (Project).Include_Path_File = No_Name then
2076          Process_Source_Dirs := True;
2077          Create_New_Path_File
2078            (Source_FD, Projects.Table (Project).Include_Path_File);
2079       end if;
2080
2081       --  For the object path, we make a distinction depending on
2082       --  Including_Libraries.
2083
2084       if Including_Libraries then
2085          if Projects.Table (Project).Objects_Path_File_With_Libs = No_Name then
2086             Process_Object_Dirs := True;
2087             Create_New_Path_File
2088               (Object_FD, Projects.Table (Project).
2089                                            Objects_Path_File_With_Libs);
2090          end if;
2091
2092       else
2093          if
2094            Projects.Table (Project).Objects_Path_File_Without_Libs = No_Name
2095          then
2096             Process_Object_Dirs := True;
2097             Create_New_Path_File
2098               (Object_FD, Projects.Table (Project).
2099                                            Objects_Path_File_Without_Libs);
2100          end if;
2101       end if;
2102
2103       --  If there is something to do, set Seen to False for all projects,
2104       --  then call the recursive procedure Add for Project.
2105
2106       if Process_Source_Dirs or Process_Object_Dirs then
2107          Add (Project);
2108       end if;
2109
2110       --  Write and close any file that has been created.
2111
2112       if Source_FD /= Invalid_FD then
2113          for Index in 1 .. Source_Paths.Last loop
2114             Get_Name_String (Source_Paths.Table (Index));
2115             Name_Len := Name_Len + 1;
2116             Name_Buffer (Name_Len) := ASCII.LF;
2117             Len := Write (Source_FD, Name_Buffer (1)'Address, Name_Len);
2118
2119             if Len /= Name_Len then
2120                Prj.Com.Fail ("disk full");
2121             end if;
2122          end loop;
2123
2124          Close (Source_FD, Status);
2125
2126          if not Status then
2127             Prj.Com.Fail ("disk full");
2128          end if;
2129       end if;
2130
2131       if Object_FD /= Invalid_FD then
2132          for Index in 1 .. Object_Paths.Last loop
2133             Get_Name_String (Object_Paths.Table (Index));
2134             Name_Len := Name_Len + 1;
2135             Name_Buffer (Name_Len) := ASCII.LF;
2136             Len := Write (Object_FD, Name_Buffer (1)'Address, Name_Len);
2137
2138             if Len /= Name_Len then
2139                Prj.Com.Fail ("disk full");
2140             end if;
2141          end loop;
2142
2143          Close (Object_FD, Status);
2144
2145          if not Status then
2146             Prj.Com.Fail ("disk full");
2147          end if;
2148       end if;
2149
2150       --  Set the env vars, if they need to be changed, and set the
2151       --  corresponding flags.
2152
2153       if Current_Source_Path_File /=
2154            Projects.Table (Project).Include_Path_File
2155       then
2156          Current_Source_Path_File :=
2157            Projects.Table (Project).Include_Path_File;
2158          Set_Path_File_Var
2159            (Project_Include_Path_File,
2160             Get_Name_String (Current_Source_Path_File));
2161          Ada_Prj_Include_File_Set := True;
2162       end if;
2163
2164       if Including_Libraries then
2165          if Current_Object_Path_File
2166               /= Projects.Table (Project).Objects_Path_File_With_Libs
2167          then
2168             Current_Object_Path_File :=
2169               Projects.Table (Project).Objects_Path_File_With_Libs;
2170             Set_Path_File_Var
2171               (Project_Objects_Path_File,
2172                Get_Name_String (Current_Object_Path_File));
2173             Ada_Prj_Objects_File_Set := True;
2174          end if;
2175
2176       else
2177          if Current_Object_Path_File
2178               /= Projects.Table (Project).Objects_Path_File_Without_Libs
2179          then
2180             Current_Object_Path_File :=
2181               Projects.Table (Project).Objects_Path_File_Without_Libs;
2182             Set_Path_File_Var
2183               (Project_Objects_Path_File,
2184                Get_Name_String (Current_Object_Path_File));
2185             Ada_Prj_Objects_File_Set := True;
2186          end if;
2187       end if;
2188    end Set_Ada_Paths;
2189
2190    ---------------------------------------------
2191    -- Set_Mapping_File_Initial_State_To_Empty --
2192    ---------------------------------------------
2193
2194    procedure Set_Mapping_File_Initial_State_To_Empty is
2195    begin
2196       Fill_Mapping_File := False;
2197    end Set_Mapping_File_Initial_State_To_Empty;
2198
2199    -----------------------
2200    -- Set_Path_File_Var --
2201    -----------------------
2202
2203    procedure Set_Path_File_Var (Name : String; Value : String) is
2204       Host_Spec : String_Access := To_Host_File_Spec (Value);
2205
2206    begin
2207       if Host_Spec = null then
2208          Prj.Com.Fail
2209            ("could not convert file name """, Value, """ to host spec");
2210       else
2211          Setenv (Name, Host_Spec.all);
2212          Free (Host_Spec);
2213       end if;
2214    end Set_Path_File_Var;
2215
2216    -----------------------
2217    -- Spec_Path_Name_Of --
2218    -----------------------
2219
2220    function Spec_Path_Name_Of (Unit : Unit_Id) return String is
2221       Data : Unit_Data := Units.Table (Unit);
2222
2223    begin
2224       if Data.File_Names (Specification).Path = No_Name then
2225          declare
2226             Current_Source : String_List_Id :=
2227               Projects.Table (Data.File_Names (Specification).Project).Sources;
2228             Path : GNAT.OS_Lib.String_Access;
2229
2230          begin
2231             Data.File_Names (Specification).Path :=
2232               Data.File_Names (Specification).Name;
2233
2234             while Current_Source /= Nil_String loop
2235                Path := Locate_Regular_File
2236                  (Namet.Get_Name_String
2237                   (Data.File_Names (Specification).Name),
2238                   Namet.Get_Name_String
2239                    (String_Elements.Table (Current_Source).Value));
2240
2241                if Path /= null then
2242                   Name_Len := Path'Length;
2243                   Name_Buffer (1 .. Name_Len) := Path.all;
2244                   Data.File_Names (Specification).Path := Name_Enter;
2245                   exit;
2246                else
2247                   Current_Source :=
2248                     String_Elements.Table (Current_Source).Next;
2249                end if;
2250             end loop;
2251
2252             Units.Table (Unit) := Data;
2253          end;
2254       end if;
2255
2256       return Namet.Get_Name_String (Data.File_Names (Specification).Path);
2257    end Spec_Path_Name_Of;
2258
2259    ---------------------------
2260    -- Ultimate_Extension_Of --
2261    ---------------------------
2262
2263    function Ultimate_Extension_Of (Project : in Project_Id) return Project_Id
2264    is
2265       Result : Project_Id := Project;
2266
2267    begin
2268       while Projects.Table (Result).Extended_By /= No_Project loop
2269          Result := Projects.Table (Result).Extended_By;
2270       end loop;
2271
2272       return Result;
2273    end Ultimate_Extension_Of;
2274
2275 --  Package initialization
2276 --  What is relationshiop to procedure Initialize
2277
2278 begin
2279    Path_Files.Set_Last (0);
2280 end Prj.Env;