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