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-2002 Free Software Foundation, Inc.          --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, USA.                                                      --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with GNAT.OS_Lib; use GNAT.OS_Lib;
  28 with Namet;       use Namet;
  29 with Opt;
  30 with Osint;       use Osint;
  31 with Output;      use Output;
  32 with Prj.Com;     use Prj.Com;
  33 with Prj.Util;
  34 with Snames;      use Snames;
  35 with Stringt;     use Stringt;
  36 with Table;
  37
  38 package body Prj.Env is
  39
  40    type Naming_Id is new Nat;
  41
  42    Ada_Path_Buffer : String_Access := new String (1 .. 1_000);
  43    --  A buffer where values for ADA_INCLUDE_PATH
  44    --  and ADA_OBJECTS_PATH are stored.
  45
  46    Ada_Path_Length : Natural := 0;
  47    --  Index of the last valid character in Ada_Path_Buffer.
  48
  49    package Namings is new Table.Table (
  50      Table_Component_Type => Naming_Data,
  51      Table_Index_Type     => Naming_Id,
  52      Table_Low_Bound      => 1,
  53      Table_Initial        => 5,
  54      Table_Increment      => 100,
  55      Table_Name           => "Prj.Env.Namings");
  56
  57    Default_Naming : constant Naming_Id := Namings.First;
  58
  59    Global_Configuration_Pragmas : Name_Id;
  60    Local_Configuration_Pragmas  : Name_Id;
  61
  62    Fill_Mapping_File : Boolean := True;
  63
  64    -----------------------
  65    -- Local Subprograms --
  66    -----------------------
  67
  68    function Body_Path_Name_Of (Unit : Unit_Id) return String;
  69    --  Returns the path name of the body of a unit.
  70    --  Compute it first, if necessary.
  71
  72    function Spec_Path_Name_Of (Unit : Unit_Id) return String;
  73    --  Returns the path name of the spec of a unit.
  74    --  Compute it first, if necessary.
  75
  76    procedure Add_To_Path (Source_Dirs : String_List_Id);
  77    --  Add to Ada_Path_Buffer all the source directories in string list
  78    --  Source_Dirs, if any. Increment Ada_Path_Length.
  79
  80    procedure Add_To_Path (Path : String);
  81    --  Add Path to global variable Ada_Path_Buffer
  82    --  Increment Ada_Path_Length
  83
  84    ----------------------
  85    -- Ada_Include_Path --
  86    ----------------------
  87
  88    function Ada_Include_Path (Project : Project_Id) return String_Access is
  89
  90       procedure Add (Project : Project_Id);
  91       --  Add all the source directories of a project to the path only if
  92       --  this project has not been visited. Calls itself recursively for
  93       --  projects being modified, and imported projects. Adds the project
  94       --  to the list Seen if this is the call to Add for this project.
  95
  96       ---------
  97       -- Add --
  98       ---------
  99
 100       procedure Add (Project : Project_Id) is
 101       begin
 102          --  If Seen is empty, then the project cannot have been visited
 103
 104          if not Projects.Table (Project).Seen then
 105             Projects.Table (Project).Seen := True;
 106
 107             declare
 108                Data : Project_Data := Projects.Table (Project);
 109                List : Project_List := Data.Imported_Projects;
 110
 111             begin
 112                --  Add to path all source directories of this project
 113
 114                Add_To_Path (Data.Source_Dirs);
 115
 116                --  Call Add to the project being modified, if any
 117
 118                if Data.Modifies /= No_Project then
 119                   Add (Data.Modifies);
 120                end if;
 121
 122                --  Call Add for each imported project, if any
 123
 124                while List /= Empty_Project_List loop
 125                   Add (Project_Lists.Table (List).Project);
 126                   List := Project_Lists.Table (List).Next;
 127                end loop;
 128             end;
 129          end if;
 130       end Add;
 131
 132    --  Start of processing for Ada_Include_Path
 133
 134    begin
 135       --  If it is the first time we call this function for
 136       --  this project, compute the source path
 137
 138       if Projects.Table (Project).Include_Path = null then
 139          Ada_Path_Length := 0;
 140
 141          for Index in 1 .. Projects.Last loop
 142             Projects.Table (Index).Seen := False;
 143          end loop;
 144
 145          Add (Project);
 146          Projects.Table (Project).Include_Path :=
 147            new String'(Ada_Path_Buffer (1 .. Ada_Path_Length));
 148       end if;
 149
 150       return Projects.Table (Project).Include_Path;
 151    end Ada_Include_Path;
 152
 153    function Ada_Include_Path
 154      (Project   : Project_Id;
 155       Recursive : Boolean)
 156       return      String
 157    is
 158    begin
 159       if Recursive then
 160          return Ada_Include_Path (Project).all;
 161       else
 162          Ada_Path_Length := 0;
 163          Add_To_Path (Projects.Table (Project).Source_Dirs);
 164          return Ada_Path_Buffer (1 .. Ada_Path_Length);
 165       end if;
 166    end Ada_Include_Path;
 167
 168    ----------------------
 169    -- Ada_Objects_Path --
 170    ----------------------
 171
 172    function Ada_Objects_Path
 173      (Project             : Project_Id;
 174       Including_Libraries : Boolean := True)
 175       return                String_Access
 176    is
 177       procedure Add (Project : Project_Id);
 178       --  Add all the object directories of a project to the path only if
 179       --  this project has not been visited. Calls itself recursively for
 180       --  projects being modified, and imported projects. Adds the project
 181       --  to the list Seen if this is the first call to Add for this project.
 182
 183       ---------
 184       -- Add --
 185       ---------
 186
 187       procedure Add (Project : Project_Id) is
 188       begin
 189          --  If this project has not been seen yet
 190
 191          if not Projects.Table (Project).Seen then
 192             Projects.Table (Project).Seen := True;
 193
 194             declare
 195                Data : Project_Data := Projects.Table (Project);
 196                List : Project_List := Data.Imported_Projects;
 197
 198             begin
 199                --  Add to path the object directory of this project
 200                --  except if we don't include library project and
 201                --  this is a library project.
 202
 203                if (Data.Library and then Including_Libraries)
 204                  or else
 205                  (Data.Object_Directory /= No_Name
 206                    and then
 207                    (not Including_Libraries or else not Data.Library))
 208                then
 209                   if Ada_Path_Length > 0 then
 210                      Add_To_Path (Path => (1 => Path_Separator));
 211                   end if;
 212
 213                   --  For a library project, att the library directory
 214
 215                   if Data.Library then
 216                      declare
 217                         New_Path : constant String :=
 218                           Get_Name_String (Data.Library_Dir);
 219                      begin
 220                         Add_To_Path (New_Path);
 221                      end;
 222                   else
 223
 224                      --  For a non library project, add the object directory
 225                      declare
 226                         New_Path : constant String :=
 227                           Get_Name_String (Data.Object_Directory);
 228                      begin
 229                         Add_To_Path (New_Path);
 230                      end;
 231                   end if;
 232                end if;
 233
 234                --  Call Add to the project being modified, if any
 235
 236                if Data.Modifies /= No_Project then
 237                   Add (Data.Modifies);
 238                end if;
 239
 240                --  Call Add for each imported project, if any
 241
 242                while List /= Empty_Project_List loop
 243                   Add (Project_Lists.Table (List).Project);
 244                   List := Project_Lists.Table (List).Next;
 245                end loop;
 246             end;
 247
 248          end if;
 249       end Add;
 250
 251    --  Start of processing for Ada_Objects_Path
 252
 253    begin
 254       --  If it is the first time we call this function for
 255       --  this project, compute the objects path
 256
 257       if Projects.Table (Project).Objects_Path = null then
 258          Ada_Path_Length := 0;
 259
 260          for Index in 1 .. Projects.Last loop
 261             Projects.Table (Index).Seen := False;
 262          end loop;
 263
 264          Add (Project);
 265          Projects.Table (Project).Objects_Path :=
 266            new String'(Ada_Path_Buffer (1 .. Ada_Path_Length));
 267       end if;
 268
 269       return Projects.Table (Project).Objects_Path;
 270    end Ada_Objects_Path;
 271
 272    -----------------
 273    -- Add_To_Path --
 274    -----------------
 275
 276    procedure Add_To_Path (Source_Dirs : String_List_Id) is
 277       Current    : String_List_Id := Source_Dirs;
 278       Source_Dir : String_Element;
 279
 280    begin
 281       while Current /= Nil_String loop
 282          if Ada_Path_Length > 0 then
 283             Add_To_Path (Path => (1 => Path_Separator));
 284          end if;
 285
 286          Source_Dir := String_Elements.Table (Current);
 287          String_To_Name_Buffer (Source_Dir.Value);
 288
 289          declare
 290             New_Path : constant String :=
 291               Name_Buffer (1 .. Name_Len);
 292          begin
 293             Add_To_Path (New_Path);
 294          end;
 295
 296          Current := Source_Dir.Next;
 297       end loop;
 298    end Add_To_Path;
 299
 300    procedure Add_To_Path (Path : String) is
 301    begin
 302       --  If Ada_Path_Buffer is too small, double it
 303
 304       if Ada_Path_Length + Path'Length > Ada_Path_Buffer'Last then
 305          declare
 306             New_Ada_Path_Buffer : constant String_Access :=
 307                                     new String
 308                                       (1 .. Ada_Path_Buffer'Last +
 309                                                  Ada_Path_Buffer'Last);
 310
 311          begin
 312             New_Ada_Path_Buffer (1 .. Ada_Path_Length) :=
 313               Ada_Path_Buffer (1 .. Ada_Path_Length);
 314             Ada_Path_Buffer := New_Ada_Path_Buffer;
 315          end;
 316       end if;
 317
 318       Ada_Path_Buffer
 319         (Ada_Path_Length + 1 .. Ada_Path_Length + Path'Length) := Path;
 320       Ada_Path_Length := Ada_Path_Length + Path'Length;
 321    end Add_To_Path;
 322
 323    -----------------------
 324    -- Body_Path_Name_Of --
 325    -----------------------
 326
 327    function Body_Path_Name_Of (Unit : Unit_Id) return String is
 328       Data : Unit_Data := Units.Table (Unit);
 329
 330    begin
 331       --  If we don't know the path name of the body of this unit,
 332       --  we compute it, and we store it.
 333
 334       if Data.File_Names (Body_Part).Path = No_Name then
 335          declare
 336             Current_Source : String_List_Id :=
 337               Projects.Table (Data.File_Names (Body_Part).Project).Sources;
 338             Path : GNAT.OS_Lib.String_Access;
 339
 340          begin
 341             --  By default, put the file name
 342
 343             Data.File_Names (Body_Part).Path :=
 344               Data.File_Names (Body_Part).Name;
 345
 346             --  For each source directory
 347
 348             while Current_Source /= Nil_String loop
 349                String_To_Name_Buffer
 350                  (String_Elements.Table (Current_Source).Value);
 351                Path :=
 352                  Locate_Regular_File
 353                  (Namet.Get_Name_String
 354                   (Data.File_Names (Body_Part).Name),
 355                   Name_Buffer (1 .. Name_Len));
 356
 357                --  If the file is in this directory,
 358                --  then we store the path, and we are done.
 359
 360                if Path /= null then
 361                   Name_Len := Path'Length;
 362                   Name_Buffer (1 .. Name_Len) := Path.all;
 363                   Data.File_Names (Body_Part).Path := Name_Enter;
 364                   exit;
 365
 366                else
 367                   Current_Source :=
 368                     String_Elements.Table (Current_Source).Next;
 369                end if;
 370             end loop;
 371
 372             Units.Table (Unit) := Data;
 373          end;
 374       end if;
 375
 376       --  Returned the value stored
 377
 378       return Namet.Get_Name_String (Data.File_Names (Body_Part).Path);
 379    end Body_Path_Name_Of;
 380
 381    --------------------------------
 382    -- Create_Config_Pragmas_File --
 383    --------------------------------
 384
 385    procedure Create_Config_Pragmas_File
 386      (For_Project  : Project_Id;
 387       Main_Project : Project_Id)
 388    is
 389       File_Name : Temp_File_Name;
 390       File      : File_Descriptor := Invalid_FD;
 391
 392       The_Packages : Package_Id;
 393       Gnatmake     : Prj.Package_Id;
 394       Compiler     : Prj.Package_Id;
 395
 396       Current_Unit : Unit_Id := Units.First;
 397
 398       First_Project : Project_List := Empty_Project_List;
 399
 400       Current_Project : Project_List;
 401       Current_Naming  : Naming_Id;
 402
 403       Global_Attribute : Variable_Value := Nil_Variable_Value;
 404       Local_Attribute  : Variable_Value := Nil_Variable_Value;
 405
 406       Global_Attribute_Present : Boolean := False;
 407       Local_Attribute_Present  : Boolean := False;
 408
 409       procedure Check (Project : Project_Id);
 410
 411       procedure Check_Temp_File;
 412       --  Check that a temporary file has been opened.
 413       --  If not, create one, and put its name in the project data,
 414       --  with the indication that it is a temporary file.
 415
 416       procedure Copy_File (Name : String_Id);
 417       --  Copy a configuration pragmas file into the temp file.
 418
 419       procedure Put
 420         (Unit_Name : Name_Id;
 421          File_Name : Name_Id;
 422          Unit_Kind : Spec_Or_Body);
 423       --  Put an SFN pragma in the temporary file.
 424
 425       procedure Put (File : File_Descriptor; S : String);
 426
 427       procedure Put_Line (File : File_Descriptor; S : String);
 428
 429       -----------
 430       -- Check --
 431       -----------
 432
 433       procedure Check (Project : Project_Id) is
 434          Data : constant Project_Data := Projects.Table (Project);
 435
 436       begin
 437          if Current_Verbosity = High then
 438             Write_Str ("Checking project file """);
 439             Write_Str (Namet.Get_Name_String (Data.Name));
 440             Write_Str (""".");
 441             Write_Eol;
 442          end if;
 443
 444          --  Is this project in the list of the visited project?
 445
 446          Current_Project := First_Project;
 447          while Current_Project /= Empty_Project_List
 448            and then Project_Lists.Table (Current_Project).Project /= Project
 449          loop
 450             Current_Project := Project_Lists.Table (Current_Project).Next;
 451          end loop;
 452
 453          --  If it is not, put it in the list, and visit it
 454
 455          if Current_Project = Empty_Project_List then
 456             Project_Lists.Increment_Last;
 457             Project_Lists.Table (Project_Lists.Last) :=
 458               (Project => Project, Next => First_Project);
 459             First_Project := Project_Lists.Last;
 460
 461             --  Is the naming scheme of this project one that we know?
 462
 463             Current_Naming := Default_Naming;
 464             while Current_Naming <= Namings.Last and then
 465               not Same_Naming_Scheme
 466               (Left => Namings.Table (Current_Naming),
 467                Right => Data.Naming) loop
 468                Current_Naming := Current_Naming + 1;
 469             end loop;
 470
 471             --  If we don't know it, add it
 472
 473             if Current_Naming > Namings.Last then
 474                Namings.Increment_Last;
 475                Namings.Table (Namings.Last) := Data.Naming;
 476
 477                --  We need a temporary file to be created
 478
 479                Check_Temp_File;
 480
 481                --  Put the SFN pragmas for the naming scheme
 482
 483                --  Spec
 484
 485                Put_Line
 486                  (File, "pragma Source_File_Name");
 487                Put_Line
 488                  (File, "  (Spec_File_Name  => ""*" &
 489                   Namet.Get_Name_String (Data.Naming.Current_Spec_Suffix) &
 490                   """,");
 491                Put_Line
 492                  (File, "   Casing          => " &
 493                   Image (Data.Naming.Casing) & ",");
 494                Put_Line
 495                  (File, "   Dot_Replacement => """ &
 496                  Namet.Get_Name_String (Data.Naming.Dot_Replacement) &
 497                   """);");
 498
 499                --  and body
 500
 501                Put_Line
 502                  (File, "pragma Source_File_Name");
 503                Put_Line
 504                  (File, "  (Body_File_Name  => ""*" &
 505                   Namet.Get_Name_String (Data.Naming.Current_Impl_Suffix) &
 506                   """,");
 507                Put_Line
 508                  (File, "   Casing          => " &
 509                   Image (Data.Naming.Casing) & ",");
 510                Put_Line
 511                  (File, "   Dot_Replacement => """ &
 512                   Namet.Get_Name_String (Data.Naming.Dot_Replacement) &
 513                   """);");
 514
 515                --  and maybe separate
 516
 517                if
 518                  Data.Naming.Current_Impl_Suffix /= Data.Naming.Separate_Suffix
 519                then
 520                   Put_Line
 521                     (File, "pragma Source_File_Name");
 522                   Put_Line
 523                     (File, "  (Subunit_File_Name  => ""*" &
 524                      Namet.Get_Name_String (Data.Naming.Separate_Suffix) &
 525                      """,");
 526                   Put_Line
 527                     (File, "   Casing          => " &
 528                      Image (Data.Naming.Casing) &
 529                      ",");
 530                   Put_Line
 531                     (File, "   Dot_Replacement => """ &
 532                      Namet.Get_Name_String (Data.Naming.Dot_Replacement) &
 533                      """);");
 534                end if;
 535             end if;
 536
 537             if Data.Modifies /= No_Project then
 538                Check (Data.Modifies);
 539             end if;
 540
 541             declare
 542                Current : Project_List := Data.Imported_Projects;
 543
 544             begin
 545                while Current /= Empty_Project_List loop
 546                   Check (Project_Lists.Table (Current).Project);
 547                   Current := Project_Lists.Table (Current).Next;
 548                end loop;
 549             end;
 550          end if;
 551       end Check;
 552
 553       ---------------------
 554       -- Check_Temp_File --
 555       ---------------------
 556
 557       procedure Check_Temp_File is
 558       begin
 559          if File = Invalid_FD then
 560             GNAT.OS_Lib.Create_Temp_File (File, Name => File_Name);
 561             if File = Invalid_FD then
 562                Osint.Fail
 563                  ("unable to create temporary configuration pragmas file");
 564             elsif Opt.Verbose_Mode then
 565                Write_Str ("Creating temp file """);
 566                Write_Str (File_Name);
 567                Write_Line ("""");
 568             end if;
 569          end if;
 570       end Check_Temp_File;
 571
 572       ---------------
 573       -- Copy_File --
 574       ---------------
 575
 576       procedure Copy_File (Name : in String_Id) is
 577          Input         : File_Descriptor;
 578          Buffer        : String (1 .. 1_000);
 579          Input_Length  : Integer;
 580          Output_Length : Integer;
 581
 582       begin
 583          Check_Temp_File;
 584          String_To_Name_Buffer (Name);
 585
 586          if Opt.Verbose_Mode then
 587             Write_Str ("Copying config pragmas file """);
 588             Write_Str (Name_Buffer (1 .. Name_Len));
 589             Write_Line (""" into temp file");
 590          end if;
 591
 592          declare
 593             Name : constant String :=
 594               Name_Buffer (1 .. Name_Len)  & ASCII.NUL;
 595          begin
 596             Input := Open_Read (Name'Address, Binary);
 597          end;
 598
 599          if Input = Invalid_FD then
 600             Osint.Fail
 601               ("cannot open configuration pragmas file " &
 602                Name_Buffer (1 .. Name_Len));
 603          end if;
 604
 605          loop
 606             Input_Length := Read (Input, Buffer'Address, Buffer'Length);
 607             Output_Length := Write (File, Buffer'Address, Input_Length);
 608
 609             if Output_Length /= Input_Length then
 610                Osint.Fail ("disk full");
 611             end if;
 612
 613             exit when Input_Length < Buffer'Length;
 614          end loop;
 615
 616          Close (Input);
 617
 618       end Copy_File;
 619
 620       ---------
 621       -- Put --
 622       ---------
 623
 624       procedure Put
 625         (Unit_Name : Name_Id;
 626          File_Name : Name_Id;
 627          Unit_Kind : Spec_Or_Body)
 628       is
 629       begin
 630          --  A temporary file needs to be open
 631
 632          Check_Temp_File;
 633
 634          --  Put the pragma SFN for the unit kind (spec or body)
 635
 636          Put (File, "pragma Source_File_Name (");
 637          Put (File, Namet.Get_Name_String (Unit_Name));
 638
 639          if Unit_Kind = Specification then
 640             Put (File, ", Spec_File_Name => """);
 641          else
 642             Put (File, ", Body_File_Name => """);
 643          end if;
 644
 645          Put (File, Namet.Get_Name_String (File_Name));
 646          Put_Line (File, """);");
 647       end Put;
 648
 649       procedure Put (File : File_Descriptor; S : String) is
 650          Last : Natural;
 651
 652       begin
 653          Last := Write (File, S (S'First)'Address, S'Length);
 654
 655          if Last /= S'Length then
 656             Osint.Fail ("Disk full");
 657          end if;
 658
 659          if Current_Verbosity = High then
 660             Write_Str (S);
 661          end if;
 662       end Put;
 663
 664       --------------
 665       -- Put_Line --
 666       --------------
 667
 668       procedure Put_Line (File : File_Descriptor; S : String) is
 669          S0   : String (1 .. S'Length + 1);
 670          Last : Natural;
 671
 672       begin
 673          --  Add an ASCII.LF to the string. As this gnat.adc is supposed to
 674          --  be used only by the compiler, we don't care about the characters
 675          --  for the end of line. In fact we could have put a space, but
 676          --  it is more convenient to be able to read gnat.adc during
 677          --  development, for which the ASCII.LF is fine.
 678
 679          S0 (1 .. S'Length) := S;
 680          S0 (S0'Last) := ASCII.LF;
 681          Last := Write (File, S0'Address, S0'Length);
 682
 683          if Last /= S'Length + 1 then
 684             Osint.Fail ("Disk full");
 685          end if;
 686
 687          if Current_Verbosity = High then
 688             Write_Line (S);
 689          end if;
 690       end Put_Line;
 691
 692    --  Start of processing for Create_Config_Pragmas_File
 693
 694    begin
 695       if not Projects.Table (For_Project).Config_Checked then
 696
 697          --  Remove any memory of processed naming schemes, if any
 698
 699          Namings.Set_Last (Default_Naming);
 700
 701          --  Check the naming schemes
 702
 703          Check (For_Project);
 704
 705          --  Visit all the units and process those that need an SFN pragma
 706
 707          while Current_Unit <= Units.Last loop
 708             declare
 709                Unit : constant Unit_Data :=
 710                  Units.Table (Current_Unit);
 711
 712             begin
 713                if Unit.File_Names (Specification).Needs_Pragma then
 714                   Put (Unit.Name,
 715                        Unit.File_Names (Specification).Name,
 716                        Specification);
 717                end if;
 718
 719                if Unit.File_Names (Body_Part).Needs_Pragma then
 720                   Put (Unit.Name,
 721                        Unit.File_Names (Body_Part).Name,
 722                        Body_Part);
 723                end if;
 724
 725                Current_Unit := Current_Unit + 1;
 726             end;
 727          end loop;
 728
 729          The_Packages := Projects.Table (Main_Project).Decl.Packages;
 730          Gnatmake :=
 731            Prj.Util.Value_Of
 732            (Name        => Name_Builder,
 733             In_Packages => The_Packages);
 734
 735          if Gnatmake /= No_Package then
 736             Global_Attribute := Prj.Util.Value_Of
 737               (Variable_Name => Global_Configuration_Pragmas,
 738                In_Variables => Packages.Table (Gnatmake).Decl.Attributes);
 739             Global_Attribute_Present :=
 740               Global_Attribute /= Nil_Variable_Value
 741               and then String_Length (Global_Attribute.Value) > 0;
 742          end if;
 743
 744          The_Packages := Projects.Table (For_Project).Decl.Packages;
 745          Compiler :=
 746            Prj.Util.Value_Of
 747            (Name        => Name_Compiler,
 748             In_Packages => The_Packages);
 749
 750          if Compiler /= No_Package then
 751             Local_Attribute := Prj.Util.Value_Of
 752               (Variable_Name => Local_Configuration_Pragmas,
 753                In_Variables => Packages.Table (Compiler).Decl.Attributes);
 754             Local_Attribute_Present :=
 755               Local_Attribute /= Nil_Variable_Value
 756               and then String_Length (Local_Attribute.Value) > 0;
 757          end if;
 758
 759          if Global_Attribute_Present then
 760             if File /= Invalid_FD
 761               or else Local_Attribute_Present
 762             then
 763                Copy_File (Global_Attribute.Value);
 764
 765             else
 766                String_To_Name_Buffer (Global_Attribute.Value);
 767                Projects.Table (For_Project).Config_File_Name := Name_Find;
 768             end if;
 769          end if;
 770
 771          if Local_Attribute_Present then
 772             if File /= Invalid_FD then
 773                Copy_File (Local_Attribute.Value);
 774
 775             else
 776                String_To_Name_Buffer (Local_Attribute.Value);
 777                Projects.Table (For_Project).Config_File_Name := Name_Find;
 778             end if;
 779          end if;
 780
 781          if File /= Invalid_FD then
 782             GNAT.OS_Lib.Close (File);
 783
 784             if Opt.Verbose_Mode then
 785                Write_Str ("Closing configuration file """);
 786                Write_Str (File_Name);
 787                Write_Line ("""");
 788             end if;
 789
 790             Name_Len := File_Name'Length;
 791             Name_Buffer (1 .. Name_Len) := File_Name;
 792             Projects.Table (For_Project).Config_File_Name := Name_Find;
 793             Projects.Table (For_Project).Config_File_Temp := True;
 794          end if;
 795
 796          Projects.Table (For_Project).Config_Checked := True;
 797       end if;
 798    end Create_Config_Pragmas_File;
 799
 800    -------------------------
 801    -- Create_Mapping_File --
 802    -------------------------
 803
 804    procedure Create_Mapping_File (Name : in out Temp_File_Name) is
 805       File          : File_Descriptor := Invalid_FD;
 806       The_Unit_Data : Unit_Data;
 807       Data          : File_Name_Data;
 808
 809       procedure Put_Name_Buffer;
 810       --  Put the line contained in the Name_Buffer in the mapping file
 811
 812       procedure Put_Data (Spec : Boolean);
 813       --  Put the mapping of the spec or body contained in Data in the file
 814       --  (3 lines).
 815
 816       ---------
 817       -- Put --
 818       ---------
 819
 820       procedure Put_Name_Buffer is
 821          Last : Natural;
 822
 823       begin
 824          Name_Len := Name_Len + 1;
 825          Name_Buffer (Name_Len) := ASCII.LF;
 826          Last := Write (File, Name_Buffer (1)'Address, Name_Len);
 827
 828          if Last /= Name_Len then
 829             Osint.Fail ("Disk full");
 830          end if;
 831       end Put_Name_Buffer;
 832
 833       --------------
 834       -- Put_Data --
 835       --------------
 836
 837       procedure Put_Data (Spec : Boolean) is
 838       begin
 839          --  Line with the unit name
 840
 841          Get_Name_String (The_Unit_Data.Name);
 842          Name_Len := Name_Len + 1;
 843          Name_Buffer (Name_Len) := '%';
 844          Name_Len := Name_Len + 1;
 845
 846          if Spec then
 847             Name_Buffer (Name_Len) := 's';
 848          else
 849             Name_Buffer (Name_Len) := 'b';
 850          end if;
 851
 852          Put_Name_Buffer;
 853
 854          --  Line with the file nale
 855
 856          Get_Name_String (Data.Name);
 857          Put_Name_Buffer;
 858
 859          --  Line with the path name
 860
 861          Get_Name_String (Data.Path);
 862          Put_Name_Buffer;
 863
 864       end Put_Data;
 865
 866    --  Start of processing for Create_Mapping_File
 867
 868    begin
 869       GNAT.OS_Lib.Create_Temp_File (File, Name => Name);
 870
 871       if File = Invalid_FD then
 872          Osint.Fail
 873            ("unable to create temporary mapping file");
 874
 875       elsif Opt.Verbose_Mode then
 876          Write_Str ("Creating temp mapping file """);
 877          Write_Str (Name);
 878          Write_Line ("""");
 879       end if;
 880
 881       if Fill_Mapping_File then
 882          --  For all units in table Units
 883
 884          for Unit in 1 .. Units.Last loop
 885             The_Unit_Data := Units.Table (Unit);
 886
 887             --  If the unit has a valid name
 888
 889             if The_Unit_Data.Name /= No_Name then
 890                Data := The_Unit_Data.File_Names (Specification);
 891
 892                --  If there is a spec, put it mapping in the file
 893
 894                if Data.Name /= No_Name then
 895                   Put_Data (Spec => True);
 896                end if;
 897
 898                Data := The_Unit_Data.File_Names (Body_Part);
 899
 900                --  If there is a body (or subunit) put its mapping in the file
 901
 902                if Data.Name /= No_Name then
 903                   Put_Data (Spec => False);
 904                end if;
 905
 906             end if;
 907          end loop;
 908       end if;
 909
 910       GNAT.OS_Lib.Close (File);
 911
 912    end Create_Mapping_File;
 913
 914    ------------------------------------
 915    -- File_Name_Of_Library_Unit_Body --
 916    ------------------------------------
 917
 918    function File_Name_Of_Library_Unit_Body
 919      (Name    : String;
 920       Project : Project_Id)
 921       return    String
 922    is
 923       Data          : constant Project_Data := Projects.Table (Project);
 924       Original_Name : String := Name;
 925
 926       Extended_Spec_Name : String :=
 927                              Name & Namet.Get_Name_String
 928                                       (Data.Naming.Current_Spec_Suffix);
 929       Extended_Body_Name : String :=
 930                              Name & Namet.Get_Name_String
 931                                       (Data.Naming.Current_Impl_Suffix);
 932
 933       Unit : Unit_Data;
 934
 935       The_Original_Name : Name_Id;
 936       The_Spec_Name     : Name_Id;
 937       The_Body_Name     : Name_Id;
 938
 939    begin
 940       Canonical_Case_File_Name (Original_Name);
 941       Name_Len := Original_Name'Length;
 942       Name_Buffer (1 .. Name_Len) := Original_Name;
 943       The_Original_Name := Name_Find;
 944
 945       Canonical_Case_File_Name (Extended_Spec_Name);
 946       Name_Len := Extended_Spec_Name'Length;
 947       Name_Buffer (1 .. Name_Len) := Extended_Spec_Name;
 948       The_Spec_Name := Name_Find;
 949
 950       Canonical_Case_File_Name (Extended_Body_Name);
 951       Name_Len := Extended_Body_Name'Length;
 952       Name_Buffer (1 .. Name_Len) := Extended_Body_Name;
 953       The_Body_Name := Name_Find;
 954
 955       if Current_Verbosity = High then
 956          Write_Str  ("Looking for file name of """);
 957          Write_Str  (Name);
 958          Write_Char ('"');
 959          Write_Eol;
 960          Write_Str  ("   Extended Spec Name = """);
 961          Write_Str  (Extended_Spec_Name);
 962          Write_Char ('"');
 963          Write_Eol;
 964          Write_Str  ("   Extended Body Name = """);
 965          Write_Str  (Extended_Body_Name);
 966          Write_Char ('"');
 967          Write_Eol;
 968       end if;
 969
 970       --  For every unit
 971
 972       for Current in reverse Units.First .. Units.Last loop
 973          Unit := Units.Table (Current);
 974
 975          --  Case of unit of the same project
 976
 977          if Unit.File_Names (Body_Part).Project = Project then
 978             declare
 979                Current_Name : constant Name_Id :=
 980                                 Unit.File_Names (Body_Part).Name;
 981
 982             begin
 983                --  Case of a body present
 984
 985                if Current_Name /= No_Name then
 986                   if Current_Verbosity = High then
 987                      Write_Str  ("   Comparing with """);
 988                      Write_Str  (Get_Name_String (Current_Name));
 989                      Write_Char ('"');
 990                      Write_Eol;
 991                   end if;
 992
 993                   --  If it has the name of the original name,
 994                   --  return the original name
 995
 996                   if Unit.Name = The_Original_Name
 997                     or else Current_Name = The_Original_Name
 998                   then
 999                      if Current_Verbosity = High then
1000                         Write_Line ("   OK");
1001                      end if;
1002
1003                      return Get_Name_String (Current_Name);
1004
1005                   --  If it has the name of the extended body name,
1006                   --  return the extended body name
1007
1008                   elsif Current_Name = The_Body_Name then
1009                      if Current_Verbosity = High then
1010                         Write_Line ("   OK");
1011                      end if;
1012
1013                      return Extended_Body_Name;
1014
1015                   else
1016                      if Current_Verbosity = High then
1017                         Write_Line ("   not good");
1018                      end if;
1019                   end if;
1020                end if;
1021             end;
1022          end if;
1023
1024          --  Case of a unit of the same project
1025
1026          if Units.Table (Current).File_Names (Specification).Project =
1027                                                                  Project
1028          then
1029             declare
1030                Current_Name : constant Name_Id :=
1031                                 Unit.File_Names (Specification).Name;
1032
1033             begin
1034                --  Case of spec present
1035
1036                if Current_Name /= No_Name then
1037                   if Current_Verbosity = High then
1038                      Write_Str  ("   Comparing with """);
1039                      Write_Str  (Get_Name_String (Current_Name));
1040                      Write_Char ('"');
1041                      Write_Eol;
1042                   end if;
1043
1044                   --  If name same as the original name, return original name
1045
1046                   if Unit.Name = The_Original_Name
1047                     or else Current_Name = The_Original_Name
1048                   then
1049                      if Current_Verbosity = High then
1050                         Write_Line ("   OK");
1051                      end if;
1052
1053                      return Get_Name_String (Current_Name);
1054
1055                   --  If it has the same name as the extended spec name,
1056                   --  return the extended spec name.
1057
1058                   elsif Current_Name = The_Spec_Name then
1059                      if Current_Verbosity = High then
1060                         Write_Line ("   OK");
1061                      end if;
1062
1063                      return Extended_Spec_Name;
1064
1065                   else
1066                      if Current_Verbosity = High then
1067                         Write_Line ("   not good");
1068                      end if;
1069                   end if;
1070                end if;
1071             end;
1072          end if;
1073       end loop;
1074
1075       --  We don't know this file name, return an empty string
1076
1077       return "";
1078    end File_Name_Of_Library_Unit_Body;
1079
1080    -------------------------
1081    -- For_All_Object_Dirs --
1082    -------------------------
1083
1084    procedure For_All_Object_Dirs (Project : Project_Id) is
1085       Seen : Project_List := Empty_Project_List;
1086
1087       procedure Add (Project : Project_Id);
1088       --  Process a project. Remember the processes visited to avoid
1089       --  processing a project twice. Recursively process an eventual
1090       --  modified project, and all imported projects.
1091
1092       ---------
1093       -- Add --
1094       ---------
1095
1096       procedure Add (Project : Project_Id) is
1097          Data : constant Project_Data := Projects.Table (Project);
1098          List : Project_List := Data.Imported_Projects;
1099
1100       begin
1101          --  If the list of visited project is empty, then
1102          --  for sure we never visited this project.
1103
1104          if Seen = Empty_Project_List then
1105             Project_Lists.Increment_Last;
1106             Seen := Project_Lists.Last;
1107             Project_Lists.Table (Seen) :=
1108               (Project => Project, Next => Empty_Project_List);
1109
1110          else
1111             --  Check if the project is in the list
1112
1113             declare
1114                Current : Project_List := Seen;
1115
1116             begin
1117                loop
1118                   --  If it is, then there is nothing else to do
1119
1120                   if Project_Lists.Table (Current).Project = Project then
1121                      return;
1122                   end if;
1123
1124                   exit when Project_Lists.Table (Current).Next =
1125                     Empty_Project_List;
1126                   Current := Project_Lists.Table (Current).Next;
1127                end loop;
1128
1129                --  This project has never been visited, add it
1130                --  to the list.
1131
1132                Project_Lists.Increment_Last;
1133                Project_Lists.Table (Current).Next := Project_Lists.Last;
1134                Project_Lists.Table (Project_Lists.Last) :=
1135                  (Project => Project, Next => Empty_Project_List);
1136             end;
1137          end if;
1138
1139          --  If there is an object directory, call Action
1140          --  with its name
1141
1142          if Data.Object_Directory /= No_Name then
1143             Get_Name_String (Data.Object_Directory);
1144             Action (Name_Buffer (1 .. Name_Len));
1145          end if;
1146
1147          --  If we are extending a project, visit it
1148
1149          if Data.Modifies /= No_Project then
1150             Add (Data.Modifies);
1151          end if;
1152
1153          --  And visit all imported projects
1154
1155          while List /= Empty_Project_List loop
1156             Add (Project_Lists.Table (List).Project);
1157             List := Project_Lists.Table (List).Next;
1158          end loop;
1159       end Add;
1160
1161    --  Start of processing for For_All_Object_Dirs
1162
1163    begin
1164       --  Visit this project, and its imported projects,
1165       --  recursively
1166
1167       Add (Project);
1168    end For_All_Object_Dirs;
1169
1170    -------------------------
1171    -- For_All_Source_Dirs --
1172    -------------------------
1173
1174    procedure For_All_Source_Dirs (Project : Project_Id) is
1175       Seen : Project_List := Empty_Project_List;
1176
1177       procedure Add (Project : Project_Id);
1178       --  Process a project. Remember the processes visited to avoid
1179       --  processing a project twice. Recursively process an eventual
1180       --  modified project, and all imported projects.
1181
1182       ---------
1183       -- Add --
1184       ---------
1185
1186       procedure Add (Project : Project_Id) is
1187          Data : constant Project_Data := Projects.Table (Project);
1188          List : Project_List := Data.Imported_Projects;
1189
1190       begin
1191          --  If the list of visited project is empty, then
1192          --  for sure we never visited this project.
1193
1194          if Seen = Empty_Project_List then
1195             Project_Lists.Increment_Last;
1196             Seen := Project_Lists.Last;
1197             Project_Lists.Table (Seen) :=
1198               (Project => Project, Next => Empty_Project_List);
1199
1200          else
1201             --  Check if the project is in the list
1202
1203             declare
1204                Current : Project_List := Seen;
1205
1206             begin
1207                loop
1208                   --  If it is, then there is nothing else to do
1209
1210                   if Project_Lists.Table (Current).Project = Project then
1211                      return;
1212                   end if;
1213
1214                   exit when Project_Lists.Table (Current).Next =
1215                     Empty_Project_List;
1216                   Current := Project_Lists.Table (Current).Next;
1217                end loop;
1218
1219                --  This project has never been visited, add it
1220                --  to the list.
1221
1222                Project_Lists.Increment_Last;
1223                Project_Lists.Table (Current).Next := Project_Lists.Last;
1224                Project_Lists.Table (Project_Lists.Last) :=
1225                  (Project => Project, Next => Empty_Project_List);
1226             end;
1227          end if;
1228
1229          declare
1230             Current    : String_List_Id := Data.Source_Dirs;
1231             The_String : String_Element;
1232
1233          begin
1234             --  Call action with the name of every source directorie
1235
1236             while Current /= Nil_String loop
1237                The_String := String_Elements.Table (Current);
1238                String_To_Name_Buffer (The_String.Value);
1239                Action (Name_Buffer (1 .. Name_Len));
1240                Current := The_String.Next;
1241             end loop;
1242          end;
1243
1244          --  If we are extending a project, visit it
1245
1246          if Data.Modifies /= No_Project then
1247             Add (Data.Modifies);
1248          end if;
1249
1250          --  And visit all imported projects
1251
1252          while List /= Empty_Project_List loop
1253             Add (Project_Lists.Table (List).Project);
1254             List := Project_Lists.Table (List).Next;
1255          end loop;
1256       end Add;
1257
1258    --  Start of processing for For_All_Source_Dirs
1259
1260    begin
1261       --  Visit this project, and its imported projects recursively
1262
1263       Add (Project);
1264    end For_All_Source_Dirs;
1265
1266    -------------------
1267    -- Get_Reference --
1268    -------------------
1269
1270    procedure Get_Reference
1271      (Source_File_Name : String;
1272       Project          : out Project_Id;
1273       Path             : out Name_Id)
1274    is
1275    begin
1276       if Current_Verbosity > Default then
1277          Write_Str ("Getting Reference_Of (""");
1278          Write_Str (Source_File_Name);
1279          Write_Str (""") ... ");
1280       end if;
1281
1282       declare
1283          Original_Name : String := Source_File_Name;
1284          Unit          : Unit_Data;
1285
1286       begin
1287          Canonical_Case_File_Name (Original_Name);
1288
1289          for Id in Units.First .. Units.Last loop
1290             Unit := Units.Table (Id);
1291
1292             if (Unit.File_Names (Specification).Name /= No_Name
1293                  and then
1294                    Namet.Get_Name_String
1295                      (Unit.File_Names (Specification).Name) = Original_Name)
1296               or else (Unit.File_Names (Specification).Path /= No_Name
1297                          and then
1298                            Namet.Get_Name_String
1299                            (Unit.File_Names (Specification).Path) =
1300                                                               Original_Name)
1301             then
1302                Project := Unit.File_Names (Specification).Project;
1303                Path := Unit.File_Names (Specification).Path;
1304
1305                if Current_Verbosity > Default then
1306                   Write_Str ("Done: Specification.");
1307                   Write_Eol;
1308                end if;
1309
1310                return;
1311
1312             elsif (Unit.File_Names (Body_Part).Name /= No_Name
1313                     and then
1314                       Namet.Get_Name_String
1315                         (Unit.File_Names (Body_Part).Name) = Original_Name)
1316               or else (Unit.File_Names (Body_Part).Path /= No_Name
1317                          and then Namet.Get_Name_String
1318                                     (Unit.File_Names (Body_Part).Path) =
1319                                                              Original_Name)
1320             then
1321                Project := Unit.File_Names (Body_Part).Project;
1322                Path := Unit.File_Names (Body_Part).Path;
1323
1324                if Current_Verbosity > Default then
1325                   Write_Str ("Done: Body.");
1326                   Write_Eol;
1327                end if;
1328
1329                return;
1330             end if;
1331
1332          end loop;
1333       end;
1334
1335       Project := No_Project;
1336       Path    := No_Name;
1337
1338       if Current_Verbosity > Default then
1339          Write_Str ("Cannot be found.");
1340          Write_Eol;
1341       end if;
1342    end Get_Reference;
1343
1344    ----------------
1345    -- Initialize --
1346    ----------------
1347
1348    procedure Initialize is
1349       Global : constant String := "global_configuration_pragmas";
1350       Local  : constant String :=  "local_configuration_pragmas";
1351
1352    begin
1353       --  Put the standard GNAT naming scheme in the Namings table
1354
1355       Namings.Increment_Last;
1356       Namings.Table (Namings.Last) := Standard_Naming_Data;
1357       Name_Len := Global'Length;
1358       Name_Buffer (1 .. Name_Len) := Global;
1359       Global_Configuration_Pragmas := Name_Find;
1360       Name_Len := Local'Length;
1361       Name_Buffer (1 .. Name_Len) := Local;
1362       Local_Configuration_Pragmas := Name_Find;
1363    end Initialize;
1364
1365    ------------------------------------
1366    -- Path_Name_Of_Library_Unit_Body --
1367    ------------------------------------
1368
1369    function Path_Name_Of_Library_Unit_Body
1370      (Name    : String;
1371       Project : Project_Id)
1372       return String
1373    is
1374       Data : constant Project_Data := Projects.Table (Project);
1375       Original_Name : String := Name;
1376
1377       Extended_Spec_Name : String :=
1378                              Name & Namet.Get_Name_String
1379                                      (Data.Naming.Current_Spec_Suffix);
1380       Extended_Body_Name : String :=
1381                              Name & Namet.Get_Name_String
1382                                      (Data.Naming.Current_Impl_Suffix);
1383
1384       First   : Unit_Id := Units.First;
1385       Current : Unit_Id;
1386       Unit    : Unit_Data;
1387
1388    begin
1389       Canonical_Case_File_Name (Original_Name);
1390       Canonical_Case_File_Name (Extended_Spec_Name);
1391       Canonical_Case_File_Name (Extended_Spec_Name);
1392
1393       if Current_Verbosity = High then
1394          Write_Str  ("Looking for path name of """);
1395          Write_Str  (Name);
1396          Write_Char ('"');
1397          Write_Eol;
1398          Write_Str  ("   Extended Spec Name = """);
1399          Write_Str  (Extended_Spec_Name);
1400          Write_Char ('"');
1401          Write_Eol;
1402          Write_Str  ("   Extended Body Name = """);
1403          Write_Str  (Extended_Body_Name);
1404          Write_Char ('"');
1405          Write_Eol;
1406       end if;
1407
1408       while First <= Units.Last
1409         and then Units.Table (First).File_Names (Body_Part).Project /= Project
1410       loop
1411          First := First + 1;
1412       end loop;
1413
1414       Current := First;
1415       while Current <= Units.Last loop
1416          Unit := Units.Table (Current);
1417
1418          if Unit.File_Names (Body_Part).Project = Project
1419            and then Unit.File_Names (Body_Part).Name /= No_Name
1420          then
1421             declare
1422                Current_Name : constant String :=
1423                  Namet.Get_Name_String (Unit.File_Names (Body_Part).Name);
1424             begin
1425                if Current_Verbosity = High then
1426                   Write_Str  ("   Comparing with """);
1427                   Write_Str  (Current_Name);
1428                   Write_Char ('"');
1429                   Write_Eol;
1430                end if;
1431
1432                if Current_Name = Original_Name then
1433                   if Current_Verbosity = High then
1434                      Write_Line ("   OK");
1435                   end if;
1436
1437                   return Body_Path_Name_Of (Current);
1438
1439                elsif Current_Name = Extended_Body_Name then
1440                   if Current_Verbosity = High then
1441                      Write_Line ("   OK");
1442                   end if;
1443
1444                   return Body_Path_Name_Of (Current);
1445
1446                else
1447                   if Current_Verbosity = High then
1448                      Write_Line ("   not good");
1449                   end if;
1450                end if;
1451             end;
1452
1453          elsif Unit.File_Names (Specification).Name /= No_Name then
1454             declare
1455                Current_Name : constant String :=
1456                                 Namet.Get_Name_String
1457                                   (Unit.File_Names (Specification).Name);
1458
1459             begin
1460                if Current_Verbosity = High then
1461                   Write_Str  ("   Comparing with """);
1462                   Write_Str  (Current_Name);
1463                   Write_Char ('"');
1464                   Write_Eol;
1465                end if;
1466
1467                if Current_Name = Original_Name then
1468                   if Current_Verbosity = High then
1469                      Write_Line ("   OK");
1470                   end if;
1471
1472                   return Spec_Path_Name_Of (Current);
1473
1474                elsif Current_Name = Extended_Spec_Name then
1475
1476                   if Current_Verbosity = High then
1477                      Write_Line ("   OK");
1478                   end if;
1479
1480                   return Spec_Path_Name_Of (Current);
1481
1482                else
1483                   if Current_Verbosity = High then
1484                      Write_Line ("   not good");
1485                   end if;
1486                end if;
1487             end;
1488          end if;
1489          Current := Current + 1;
1490       end loop;
1491
1492       return "";
1493    end Path_Name_Of_Library_Unit_Body;
1494
1495    -------------------
1496    -- Print_Sources --
1497    -------------------
1498
1499    procedure Print_Sources is
1500       Unit : Unit_Data;
1501
1502    begin
1503       Write_Line ("List of Sources:");
1504
1505       for Id in Units.First .. Units.Last loop
1506          Unit := Units.Table (Id);
1507          Write_Str  ("   ");
1508          Write_Line (Namet.Get_Name_String (Unit.Name));
1509
1510          if Unit.File_Names (Specification).Name /= No_Name then
1511             if Unit.File_Names (Specification).Project = No_Project then
1512                Write_Line ("   No project");
1513
1514             else
1515                Write_Str  ("   Project: ");
1516                Get_Name_String
1517                  (Projects.Table
1518                    (Unit.File_Names (Specification).Project).Path_Name);
1519                Write_Line (Name_Buffer (1 .. Name_Len));
1520             end if;
1521
1522             Write_Str  ("      spec: ");
1523             Write_Line
1524               (Namet.Get_Name_String
1525                (Unit.File_Names (Specification).Name));
1526          end if;
1527
1528          if Unit.File_Names (Body_Part).Name /= No_Name then
1529             if Unit.File_Names (Body_Part).Project = No_Project then
1530                Write_Line ("   No project");
1531
1532             else
1533                Write_Str  ("   Project: ");
1534                Get_Name_String
1535                  (Projects.Table
1536                    (Unit.File_Names (Body_Part).Project).Path_Name);
1537                Write_Line (Name_Buffer (1 .. Name_Len));
1538             end if;
1539
1540             Write_Str  ("      body: ");
1541             Write_Line
1542               (Namet.Get_Name_String
1543                (Unit.File_Names (Body_Part).Name));
1544          end if;
1545
1546       end loop;
1547
1548       Write_Line ("end of List of Sources.");
1549    end Print_Sources;
1550
1551    ---------------------------------------------
1552    -- Set_Mapping_File_Initial_State_To_Empty --
1553    ---------------------------------------------
1554
1555    procedure Set_Mapping_File_Initial_State_To_Empty is
1556    begin
1557       Fill_Mapping_File := False;
1558    end Set_Mapping_File_Initial_State_To_Empty;
1559
1560    -----------------------
1561    -- Spec_Path_Name_Of --
1562    -----------------------
1563
1564    function Spec_Path_Name_Of (Unit : Unit_Id) return String is
1565       Data : Unit_Data := Units.Table (Unit);
1566
1567    begin
1568       if Data.File_Names (Specification).Path = No_Name then
1569          declare
1570             Current_Source : String_List_Id :=
1571               Projects.Table (Data.File_Names (Specification).Project).Sources;
1572             Path : GNAT.OS_Lib.String_Access;
1573
1574          begin
1575             Data.File_Names (Specification).Path :=
1576               Data.File_Names (Specification).Name;
1577
1578             while Current_Source /= Nil_String loop
1579                String_To_Name_Buffer
1580                  (String_Elements.Table (Current_Source).Value);
1581                Path := Locate_Regular_File
1582                  (Namet.Get_Name_String
1583                   (Data.File_Names (Specification).Name),
1584                   Name_Buffer (1 .. Name_Len));
1585
1586                if Path /= null then
1587                   Name_Len := Path'Length;
1588                   Name_Buffer (1 .. Name_Len) := Path.all;
1589                   Data.File_Names (Specification).Path := Name_Enter;
1590                   exit;
1591                else
1592                   Current_Source :=
1593                     String_Elements.Table (Current_Source).Next;
1594                end if;
1595             end loop;
1596
1597             Units.Table (Unit) := Data;
1598          end;
1599       end if;
1600
1601       return Namet.Get_Name_String (Data.File_Names (Specification).Path);
1602    end Spec_Path_Name_Of;
1603
1604 end Prj.Env;