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