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