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