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