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