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