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