gcc/ada/mlib-prj.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                            M L I B . P R J                               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                     Copyright (C) 2001-2005, AdaCore                     --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with ALI;      use ALI;
  28 with Gnatvsn;  use Gnatvsn;
  29 with Hostparm;
  30 with MLib.Fil; use MLib.Fil;
  31 with MLib.Tgt; use MLib.Tgt;
  32 with MLib.Utl; use MLib.Utl;
  33 with Namet;    use Namet;
  34 with Opt;
  35 with Output;   use Output;
  36 with Prj.Com;  use Prj.Com;
  37 with Prj.Env;  use Prj.Env;
  38 with Prj.Util; use Prj.Util;
  39 with Sinput.P;
  40 with Snames;   use Snames;
  41 with Switch;   use Switch;
  42 with Table;
  43
  44 with Ada.Characters.Handling;
  45
  46 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
  47 with GNAT.HTable;
  48 with Interfaces.C_Streams;      use Interfaces.C_Streams;
  49 with System;                    use System;
  50 with System.Case_Util;          use System.Case_Util;
  51
  52 package body MLib.Prj is
  53
  54    Prj_Add_Obj_Files : Types.Int;
  55    pragma Import (C, Prj_Add_Obj_Files, "__gnat_prj_add_obj_files");
  56    Add_Object_Files : constant Boolean := Prj_Add_Obj_Files /= 0;
  57    --  Indicates if object files in pragmas Linker_Options (found in the
  58    --  binder generated file) should be taken when linking aq stand-alone
  59    --  library.
  60    --  False for Windows, True for other platforms.
  61
  62    ALI_Suffix : constant String := ".ali";
  63    B_Start    : String := "b~";
  64
  65    S_Osinte_Ads : Name_Id := No_Name;
  66    --  Name_Id for "s-osinte.ads"
  67
  68    S_Dec_Ads : Name_Id := No_Name;
  69    --  Name_Id for "dec.ads"
  70
  71    G_Trasym_Ads : Name_Id := No_Name;
  72    --  Name_Id for "g-trasym.ads"
  73
  74    No_Argument_List : aliased String_List := (1 .. 0 => null);
  75    No_Argument      : constant String_List_Access := No_Argument_List'Access;
  76
  77    Arguments : String_List_Access := No_Argument;
  78    --  Used to accumulate arguments for the invocation of gnatbind and of
  79    --  the compiler. Also used to collect the interface ALI when copying
  80    --  the ALI files to the library directory.
  81
  82    Argument_Number : Natural := 0;
  83    --  Index of the last argument in Arguments
  84
  85    Initial_Argument_Max : constant := 10;
  86
  87    No_Main_String : aliased String := "-n";
  88    No_Main : constant String_Access := No_Main_String'Access;
  89
  90    Output_Switch_String : aliased String := "-o";
  91    Output_Switch : constant String_Access := Output_Switch_String'Access;
  92
  93    Compile_Switch_String : aliased String := "-c";
  94    Compile_Switch : constant String_Access := Compile_Switch_String'Access;
  95
  96    Auto_Initialize : constant String := "-a";
  97
  98    --  List of objects to put inside the library
  99
 100    Object_Files : Argument_List_Access;
 101
 102    package Objects is new Table.Table
 103      (Table_Name           => "Mlib.Prj.Objects",
 104       Table_Component_Type => String_Access,
 105       Table_Index_Type     => Natural,
 106       Table_Low_Bound      => 1,
 107       Table_Initial        => 50,
 108       Table_Increment      => 100);
 109
 110    package Objects_Htable is new GNAT.HTable.Simple_HTable
 111      (Header_Num => Header_Num,
 112       Element    => Boolean,
 113       No_Element => False,
 114       Key        => Name_Id,
 115       Hash       => Hash,
 116       Equal      => "=");
 117
 118    --  List of non-Ada object files
 119
 120    Foreign_Objects : Argument_List_Access;
 121
 122    package Foreigns is new Table.Table
 123      (Table_Name           => "Mlib.Prj.Foreigns",
 124       Table_Component_Type => String_Access,
 125       Table_Index_Type     => Natural,
 126       Table_Low_Bound      => 1,
 127       Table_Initial        => 20,
 128       Table_Increment      => 100);
 129
 130    --  List of ALI files
 131
 132    Ali_Files : Argument_List_Access;
 133
 134    package ALIs is new Table.Table
 135      (Table_Name           => "Mlib.Prj.Alis",
 136       Table_Component_Type => String_Access,
 137       Table_Index_Type     => Natural,
 138       Table_Low_Bound      => 1,
 139       Table_Initial        => 50,
 140       Table_Increment      => 100);
 141
 142    --  List of options set in the command line
 143
 144    Options : Argument_List_Access;
 145
 146    package Opts is new Table.Table
 147      (Table_Name           => "Mlib.Prj.Opts",
 148       Table_Component_Type => String_Access,
 149       Table_Index_Type     => Natural,
 150       Table_Low_Bound      => 1,
 151       Table_Initial        => 5,
 152       Table_Increment      => 100);
 153
 154    --  All the ALI file in the library
 155
 156    package Library_ALIs is new GNAT.HTable.Simple_HTable
 157      (Header_Num => Header_Num,
 158       Element    => Boolean,
 159       No_Element => False,
 160       Key        => Name_Id,
 161       Hash       => Hash,
 162       Equal      => "=");
 163
 164    --  The ALI files in the interface sets
 165
 166    package Interface_ALIs is new GNAT.HTable.Simple_HTable
 167      (Header_Num => Header_Num,
 168       Element    => Boolean,
 169       No_Element => False,
 170       Key        => Name_Id,
 171       Hash       => Hash,
 172       Equal      => "=");
 173
 174    --  The ALI files that have been processed to check if the corresponding
 175    --  library unit is in the interface set.
 176
 177    package Processed_ALIs is new GNAT.HTable.Simple_HTable
 178      (Header_Num => Header_Num,
 179       Element    => Boolean,
 180       No_Element => False,
 181       Key        => Name_Id,
 182       Hash       => Hash,
 183       Equal      => "=");
 184
 185    --  The projects imported directly or indirectly
 186
 187    package Processed_Projects is new GNAT.HTable.Simple_HTable
 188      (Header_Num => Header_Num,
 189       Element    => Boolean,
 190       No_Element => False,
 191       Key        => Name_Id,
 192       Hash       => Hash,
 193       Equal      => "=");
 194
 195    --  The library projects imported directly or indirectly
 196
 197    package Library_Projs is new Table.Table (
 198      Table_Component_Type => Project_Id,
 199      Table_Index_Type     => Integer,
 200      Table_Low_Bound      => 1,
 201      Table_Initial        => 10,
 202      Table_Increment      => 10,
 203      Table_Name           => "Make.Library_Projs");
 204
 205    type Build_Mode_State is (None, Static, Dynamic, Relocatable);
 206
 207    procedure Add_Argument (S : String);
 208    --  Add one argument to Arguments array, if array is full, double its size
 209
 210    function ALI_File_Name (Source : String) return String;
 211    --  Return the ALI file name corresponding to a source
 212
 213    procedure Check (Filename : String);
 214    --  Check if filename is a regular file. Fail if it is not
 215
 216    procedure Check_Context;
 217    --  Check each object files in table Object_Files
 218    --  Fail if any of them is not a regular file
 219
 220    procedure Copy_Interface_Sources
 221      (For_Project : Project_Id;
 222       In_Tree     : Project_Tree_Ref;
 223       Interfaces  : Argument_List;
 224       To_Dir      : Name_Id);
 225    --  Copy the interface sources of a SAL to directory To_Dir
 226
 227    procedure Display (Executable : String);
 228    --  Display invocation of gnatbind and of the compiler with the arguments
 229    --  in Arguments, except when Quiet_Output is True.
 230
 231    procedure Process_Binder_File (Name : String);
 232    --  For Stand-Alone libraries, get the Linker Options in the binder
 233    --  generated file.
 234
 235    procedure Reset_Tables;
 236    --  Make sure that all the above tables are empty
 237    --  (Objects, Foreign_Objects, Ali_Files, Options).
 238
 239    function SALs_Use_Constructors return Boolean;
 240    --  Indicate if Stand-Alone Libraries are automatically initialized using
 241    --  the constructor mechanism.
 242
 243    function Ultimate_Extension_Of
 244      (Project : Project_Id;
 245       In_Tree : Project_Tree_Ref) return Project_Id;
 246    --  Returns the Project_Id of project Project. Returns No_Project
 247    --  if Project is No_Project.
 248
 249    ------------------
 250    -- Add_Argument --
 251    ------------------
 252
 253    procedure Add_Argument (S : String) is
 254    begin
 255       if Argument_Number = Arguments'Last then
 256          declare
 257             New_Args : constant String_List_Access :=
 258               new String_List (1 .. 2 * Arguments'Last);
 259
 260          begin
 261             --  Copy the String_Accesses and set them to null in Arguments
 262             --  so that they will not be deallocated by the call to
 263             --  Free (Arguments).
 264
 265             New_Args (Arguments'Range) := Arguments.all;
 266             Arguments.all := (others => null);
 267             Free (Arguments);
 268             Arguments := New_Args;
 269          end;
 270       end if;
 271
 272       Argument_Number := Argument_Number + 1;
 273       Arguments (Argument_Number) := new String'(S);
 274    end Add_Argument;
 275
 276    -------------------
 277    -- ALI_File_Name --
 278    -------------------
 279
 280    function ALI_File_Name (Source : String) return String is
 281    begin
 282       --  If the source name has an extension, then replace it with
 283       --  the ALI suffix.
 284
 285       for Index in reverse Source'First + 1 .. Source'Last loop
 286          if Source (Index) = '.' then
 287             return Source (Source'First .. Index - 1) & ALI_Suffix;
 288          end if;
 289       end loop;
 290
 291       --  If there is no dot, or if it is the first character, just add the
 292       --  ALI suffix.
 293
 294       return Source & ALI_Suffix;
 295    end ALI_File_Name;
 296
 297    -------------------
 298    -- Build_Library --
 299    -------------------
 300
 301    procedure Build_Library
 302      (For_Project   : Project_Id;
 303       In_Tree       : Project_Tree_Ref;
 304       Gnatbind      : String;
 305       Gnatbind_Path : String_Access;
 306       Gcc           : String;
 307       Gcc_Path      : String_Access;
 308       Bind          : Boolean := True;
 309       Link          : Boolean := True)
 310    is
 311       Warning_For_Library : Boolean := False;
 312       --  Set to True for the first warning about a unit missing from the
 313       --  interface set.
 314
 315       Libgnarl_Needed   : Boolean := False;
 316       --  Set to True if library needs to be linked with libgnarl
 317
 318       Libdecgnat_Needed : Boolean := False;
 319       --  On OpenVMS, set to True if library needs to be linked with libdecgnat
 320
 321       Gtrasymobj_Needed : Boolean := False;
 322       --  On OpenVMS, set to True if library needs to be linked with
 323       --  g-trasym.obj.
 324
 325       Data : Project_Data := In_Tree.Projects.Table (For_Project);
 326
 327       Object_Directory_Path : constant String :=
 328                           Get_Name_String (Data.Object_Directory);
 329
 330       Standalone   : constant Boolean := Data.Standalone_Library;
 331
 332       Project_Name : constant String := Get_Name_String (Data.Name);
 333
 334       Current_Dir  : constant String := Get_Current_Dir;
 335
 336       Lib_Filename : String_Access;
 337       Lib_Dirpath  : String_Access;
 338       Lib_Version  : String_Access := new String'("");
 339
 340       The_Build_Mode : Build_Mode_State := None;
 341
 342       Success : Boolean := False;
 343
 344       Library_Options : Variable_Value := Nil_Variable_Value;
 345
 346       Library_GCC     : Variable_Value := Nil_Variable_Value;
 347
 348       Driver_Name : Name_Id := No_Name;
 349
 350       In_Main_Object_Directory : Boolean := True;
 351
 352       Rpath : String_Access := null;
 353       --  Allocated only if Path Option is supported
 354
 355       Rpath_Last : Natural := 0;
 356       --  Index of last valid character of Rpath
 357
 358       Initial_Rpath_Length : constant := 200;
 359       --  Initial size of Rpath, when first allocated
 360
 361       Path_Option : String_Access := Linker_Library_Path_Option;
 362       --  If null, Path Option is not supported.
 363       --  Not a constant so that it can be deallocated.
 364
 365       First_ALI : Name_Id := No_Name;
 366       --  Store the ALI file name of a source of the library (the first found)
 367
 368       procedure Add_ALI_For (Source : Name_Id);
 369       --  Add the name of the ALI file corresponding to Source to the
 370       --  Arguments.
 371
 372       procedure Add_Rpath (Path : String);
 373       --  Add a path name to Rpath
 374
 375       function Check_Project (P : Project_Id) return Boolean;
 376       --  Returns True if P is For_Project or a project extended by For_Project
 377
 378       procedure Check_Libs (ALI_File : String);
 379       --  Set Libgnarl_Needed if the ALI_File indicates that there is a need
 380       --  to link with -lgnarl (this is the case when there is a dependency
 381       --  on s-osinte.ads). On OpenVMS, set Libdecgnat_Needed if the ALI file
 382       --  indicates that there is a need to link with -ldecgnat (this is the
 383       --  case when there is a dependency on dec.ads), and set
 384       --  Gtrasymobj_Needed if there is a dependency on g-trasym.ads.
 385
 386       procedure Process (The_ALI : File_Name_Type);
 387       --  Check if the closure of a library unit which is or should be in the
 388       --  interface set is also in the interface set. Issue a warning for each
 389       --  missing library unit.
 390
 391       procedure Process_Imported_Libraries;
 392       --  Add the -L and -l switches for the imported Library Project Files,
 393       --  and, if Path Option is supported, the library directory path names
 394       --  to Rpath.
 395
 396       -----------------
 397       -- Add_ALI_For --
 398       -----------------
 399
 400       procedure Add_ALI_For (Source : Name_Id) is
 401          ALI    : constant String := ALI_File_Name (Get_Name_String (Source));
 402          ALI_Id : Name_Id;
 403
 404       begin
 405          if Bind then
 406             Add_Argument (ALI);
 407          end if;
 408
 409          Name_Len := 0;
 410          Add_Str_To_Name_Buffer (S => ALI);
 411          ALI_Id := Name_Find;
 412
 413          --  Add the ALI file name to the library ALIs
 414
 415          if Bind then
 416             Library_ALIs.Set (ALI_Id, True);
 417          end if;
 418
 419          --  Set First_ALI, if not already done
 420
 421          if First_ALI = No_Name then
 422             First_ALI := ALI_Id;
 423          end if;
 424       end Add_ALI_For;
 425
 426       ---------------
 427       -- Add_Rpath --
 428       ---------------
 429
 430       procedure Add_Rpath (Path : String) is
 431
 432          procedure Double;
 433          --  Double Rpath size
 434
 435          ------------
 436          -- Double --
 437          ------------
 438
 439          procedure Double is
 440             New_Rpath : constant String_Access :=
 441                           new String (1 .. 2 * Rpath'Length);
 442          begin
 443             New_Rpath (1 .. Rpath_Last) := Rpath (1 .. Rpath_Last);
 444             Free (Rpath);
 445             Rpath := New_Rpath;
 446          end Double;
 447
 448       --  Start of processing for Add_Rpath
 449
 450       begin
 451          --  If firt path, allocate initial Rpath
 452
 453          if Rpath = null then
 454             Rpath := new String (1 .. Initial_Rpath_Length);
 455             Rpath_Last := 0;
 456
 457          else
 458             --  Otherwise, add a path separator between two path names
 459
 460             if Rpath_Last = Rpath'Last then
 461                Double;
 462             end if;
 463
 464             Rpath_Last := Rpath_Last + 1;
 465             Rpath (Rpath_Last) := Path_Separator;
 466          end if;
 467
 468          --  Increase Rpath size until it is large enough
 469
 470          while Rpath_Last + Path'Length > Rpath'Last loop
 471             Double;
 472          end loop;
 473
 474          --  Add the path name
 475
 476          Rpath (Rpath_Last + 1 .. Rpath_Last + Path'Length) := Path;
 477          Rpath_Last := Rpath_Last + Path'Length;
 478       end Add_Rpath;
 479
 480       -------------------
 481       -- Check_Project --
 482       -------------------
 483
 484       function Check_Project (P : Project_Id) return Boolean is
 485       begin
 486          if P = For_Project then
 487             return True;
 488
 489          elsif P /= No_Project then
 490             declare
 491                Data : Project_Data :=
 492                         In_Tree.Projects.Table (For_Project);
 493             begin
 494                while Data.Extends /= No_Project loop
 495                   if P = Data.Extends then
 496                      return True;
 497                   end if;
 498
 499                   Data := In_Tree.Projects.Table (Data.Extends);
 500                end loop;
 501             end;
 502          end if;
 503
 504          return False;
 505       end Check_Project;
 506
 507       ----------------
 508       -- Check_Libs --
 509       ----------------
 510
 511       procedure Check_Libs (ALI_File : String) is
 512          Lib_File : Name_Id;
 513          Text     : Text_Buffer_Ptr;
 514          Id       : ALI.ALI_Id;
 515
 516       begin
 517          if not Libgnarl_Needed or
 518            (Hostparm.OpenVMS and then
 519               ((not Libdecgnat_Needed) or
 520                (not Gtrasymobj_Needed)))
 521          then
 522             --  Scan the ALI file
 523
 524             Name_Len := ALI_File'Length;
 525             Name_Buffer (1 .. Name_Len) := ALI_File;
 526             Lib_File := Name_Find;
 527             Text := Read_Library_Info (Lib_File, True);
 528
 529             Id  := ALI.Scan_ALI
 530                          (F          => Lib_File,
 531                           T          => Text,
 532                           Ignore_ED  => False,
 533                           Err        => True,
 534                           Read_Lines => "D");
 535             Free (Text);
 536
 537             --  Look for s-osinte.ads in the dependencies
 538
 539             for Index in ALI.ALIs.Table (Id).First_Sdep ..
 540                          ALI.ALIs.Table (Id).Last_Sdep
 541             loop
 542                if ALI.Sdep.Table (Index).Sfile = S_Osinte_Ads then
 543                   Libgnarl_Needed := True;
 544
 545                elsif Hostparm.OpenVMS then
 546                   if ALI.Sdep.Table (Index).Sfile = S_Dec_Ads then
 547                      Libdecgnat_Needed := True;
 548
 549                   elsif ALI.Sdep.Table (Index).Sfile = G_Trasym_Ads then
 550                      Gtrasymobj_Needed := True;
 551                   end if;
 552                end if;
 553             end loop;
 554          end if;
 555       end Check_Libs;
 556
 557       -------------
 558       -- Process --
 559       -------------
 560
 561       procedure Process (The_ALI : File_Name_Type) is
 562          Text       : Text_Buffer_Ptr;
 563          Idread     : ALI_Id;
 564          First_Unit : ALI.Unit_Id;
 565          Last_Unit  : ALI.Unit_Id;
 566          Unit_Data  : Unit_Record;
 567          Afile      : File_Name_Type;
 568
 569       begin
 570          --  Nothing to do if the ALI file has already been processed.
 571          --  This happens if an interface imports another interface.
 572
 573          if not Processed_ALIs.Get (The_ALI) then
 574             Processed_ALIs.Set (The_ALI, True);
 575             Text := Read_Library_Info (The_ALI);
 576
 577             if Text /= null then
 578                Idread :=
 579                  Scan_ALI
 580                    (F         => The_ALI,
 581                     T         => Text,
 582                     Ignore_ED => False,
 583                     Err       => True);
 584                Free (Text);
 585
 586                if Idread /= No_ALI_Id then
 587                   First_Unit := ALI.ALIs.Table (Idread).First_Unit;
 588                   Last_Unit  := ALI.ALIs.Table (Idread).Last_Unit;
 589
 590                   --  Process both unit (spec and body) if the body is needed
 591                   --  by the spec (inline or generic). Otherwise, just process
 592                   --  the spec.
 593
 594                   if First_Unit /= Last_Unit and then
 595                     not ALI.Units.Table (Last_Unit).Body_Needed_For_SAL
 596                   then
 597                      First_Unit := Last_Unit;
 598                   end if;
 599
 600                   for Unit in First_Unit .. Last_Unit loop
 601                      Unit_Data := ALI.Units.Table (Unit);
 602
 603                      --  Check if each withed unit which is in the library is
 604                      --  also in the interface set, if it has not yet been
 605                      --  processed.
 606
 607                      for W in Unit_Data.First_With .. Unit_Data.Last_With loop
 608                         Afile := Withs.Table (W).Afile;
 609
 610                         if Afile /= No_Name and then Library_ALIs.Get (Afile)
 611                           and then not Processed_ALIs.Get (Afile)
 612                         then
 613                            if not Interface_ALIs.Get (Afile) then
 614                               if not Warning_For_Library then
 615                                  Write_Str ("Warning: In library project """);
 616                                  Get_Name_String (Data.Name);
 617                                  To_Mixed (Name_Buffer (1 .. Name_Len));
 618                                  Write_Str (Name_Buffer (1 .. Name_Len));
 619                                  Write_Line ("""");
 620                                  Warning_For_Library := True;
 621                               end if;
 622
 623                               Write_Str ("         Unit """);
 624                               Get_Name_String (Withs.Table (W).Uname);
 625                               To_Mixed (Name_Buffer (1 .. Name_Len - 2));
 626                               Write_Str (Name_Buffer (1 .. Name_Len - 2));
 627                               Write_Line (""" is not in the interface set");
 628                               Write_Str ("         but it is needed by ");
 629
 630                               case Unit_Data.Utype is
 631                                  when Is_Spec =>
 632                                     Write_Str ("the spec of ");
 633
 634                                  when Is_Body =>
 635                                     Write_Str ("the body of ");
 636
 637                                  when others =>
 638                                     null;
 639                               end case;
 640
 641                               Write_Str ("""");
 642                               Get_Name_String (Unit_Data.Uname);
 643                               To_Mixed (Name_Buffer (1 .. Name_Len - 2));
 644                               Write_Str (Name_Buffer (1 .. Name_Len - 2));
 645                               Write_Line ("""");
 646                            end if;
 647
 648                            --  Now, process this unit
 649
 650                            Process (Afile);
 651                         end if;
 652                      end loop;
 653                   end loop;
 654                end if;
 655             end if;
 656          end if;
 657       end Process;
 658
 659       --------------------------------
 660       -- Process_Imported_Libraries --
 661       --------------------------------
 662
 663       procedure Process_Imported_Libraries is
 664          Current : Project_Id;
 665
 666          procedure Process_Project (Project : Project_Id);
 667          --  Process Project and its imported projects recursively.
 668          --  Add any library projects to table Library_Projs.
 669
 670          ---------------------
 671          -- Process_Project --
 672          ---------------------
 673
 674          procedure Process_Project (Project : Project_Id) is
 675             Data     : constant Project_Data :=
 676                          In_Tree.Projects.Table (Project);
 677             Imported : Project_List := Data.Imported_Projects;
 678             Element  : Project_Element;
 679
 680          begin
 681             --  Nothing to do if process has already been processed
 682
 683             if not Processed_Projects.Get (Data.Name) then
 684                Processed_Projects.Set (Data.Name, True);
 685
 686                --  Call Process_Project recursively for any imported project.
 687                --  We first process the imported projects to guarantee that
 688                --  we have a proper reverse order for the libraries.
 689
 690                while Imported /= Empty_Project_List loop
 691                   Element :=
 692                     In_Tree.Project_Lists.Table (Imported);
 693
 694                   if Element.Project /= No_Project then
 695                      Process_Project (Element.Project);
 696                   end if;
 697
 698                   Imported := Element.Next;
 699                end loop;
 700
 701                --  If it is a library project, add it to Library_Projs
 702
 703                if Project /= For_Project and then Data.Library then
 704                   Library_Projs.Increment_Last;
 705                   Library_Projs.Table (Library_Projs.Last) := Project;
 706                end if;
 707
 708             end if;
 709          end Process_Project;
 710
 711       --  Start of processing for Process_Imported_Libraries
 712
 713       begin
 714          --  Build list of library projects imported directly or indirectly,
 715          --  in the reverse order.
 716
 717          Process_Project (For_Project);
 718
 719          --  Add the -L and -l switches and, if the Rpath option is supported,
 720          --  add the directory to the Rpath.
 721          --  As the library projects are in the wrong order, process from the
 722          --  last to the first.
 723
 724          for Index in reverse 1 .. Library_Projs.Last loop
 725             Current := Library_Projs.Table (Index);
 726
 727             Get_Name_String
 728               (In_Tree.Projects.Table (Current).Library_Dir);
 729             Opts.Increment_Last;
 730             Opts.Table (Opts.Last) :=
 731               new String'("-L" & Name_Buffer (1 .. Name_Len));
 732
 733             if Path_Option /= null then
 734                Add_Rpath (Name_Buffer (1 .. Name_Len));
 735             end if;
 736
 737             Opts.Increment_Last;
 738             Opts.Table (Opts.Last) :=
 739               new String'
 740                 ("-l" &
 741                  Get_Name_String
 742                    (In_Tree.Projects.Table
 743                       (Current).Library_Name));
 744          end loop;
 745       end Process_Imported_Libraries;
 746
 747    --  Start of processing for Build_Library
 748
 749    begin
 750       Reset_Tables;
 751
 752       --  Fail if project is not a library project
 753
 754       if not Data.Library then
 755          Com.Fail ("project """, Project_Name, """ has no library");
 756       end if;
 757
 758       --  If this is the first time Build_Library is called, get the Name_Id
 759       --  of "s-osinte.ads".
 760
 761       if S_Osinte_Ads = No_Name then
 762          Name_Len := 0;
 763          Add_Str_To_Name_Buffer ("s-osinte.ads");
 764          S_Osinte_Ads := Name_Find;
 765       end if;
 766
 767       if S_Dec_Ads = No_Name then
 768          Name_Len := 0;
 769          Add_Str_To_Name_Buffer ("dec.ads");
 770          S_Dec_Ads := Name_Find;
 771       end if;
 772
 773       if G_Trasym_Ads = No_Name then
 774          Name_Len := 0;
 775          Add_Str_To_Name_Buffer ("g-trasym.ads");
 776          G_Trasym_Ads := Name_Find;
 777       end if;
 778
 779       --  We work in the object directory
 780
 781       Change_Dir (Object_Directory_Path);
 782
 783       if Standalone then
 784          --  Call gnatbind only if Bind is True
 785
 786          if Bind then
 787             if Gnatbind_Path = null then
 788                Com.Fail ("unable to locate ", Gnatbind);
 789             end if;
 790
 791             if Gcc_Path = null then
 792                Com.Fail ("unable to locate ", Gcc);
 793             end if;
 794
 795             --  Allocate Arguments, if it is the first time we see a standalone
 796             --  library.
 797
 798             if Arguments = No_Argument then
 799                Arguments := new String_List (1 .. Initial_Argument_Max);
 800             end if;
 801
 802             --  Add "-n -o b~<lib>.adb (b$<lib>.adb on VMS) -L<lib>"
 803
 804             Argument_Number := 2;
 805             Arguments (1) := No_Main;
 806             Arguments (2) := Output_Switch;
 807
 808             if Hostparm.OpenVMS then
 809                B_Start (B_Start'Last) := '$';
 810             end if;
 811
 812             Add_Argument
 813               (B_Start & Get_Name_String (Data.Library_Name) & ".adb");
 814             Add_Argument ("-L" & Get_Name_String (Data.Library_Name));
 815
 816             if Data.Lib_Auto_Init and then SALs_Use_Constructors then
 817                Add_Argument (Auto_Initialize);
 818             end if;
 819
 820             --  Check if Binder'Default_Switches ("Ada") is defined. If it is,
 821             --  add these switches to call gnatbind.
 822
 823             declare
 824                Binder_Package : constant Package_Id :=
 825                                   Value_Of
 826                                     (Name        => Name_Binder,
 827                                      In_Packages => Data.Decl.Packages,
 828                                      In_Tree     => In_Tree);
 829
 830             begin
 831                if Binder_Package /= No_Package then
 832                   declare
 833                      Defaults : constant Array_Element_Id :=
 834                                   Value_Of
 835                                     (Name      => Name_Default_Switches,
 836                                      In_Arrays =>
 837                                        In_Tree.Packages.Table
 838                                          (Binder_Package).Decl.Arrays,
 839                                      In_Tree   => In_Tree);
 840                      Switches : Variable_Value := Nil_Variable_Value;
 841
 842                      Switch : String_List_Id := Nil_String;
 843
 844                   begin
 845                      if Defaults /= No_Array_Element then
 846                         Switches :=
 847                           Value_Of
 848                             (Index     => Name_Ada,
 849                              Src_Index => 0,
 850                              In_Array  => Defaults,
 851                              In_Tree   => In_Tree);
 852
 853                         if not Switches.Default then
 854                            Switch := Switches.Values;
 855
 856                            while Switch /= Nil_String loop
 857                               Add_Argument
 858                                 (Get_Name_String
 859                                    (In_Tree.String_Elements.Table
 860                                       (Switch).Value));
 861                               Switch := In_Tree.String_Elements.
 862                                           Table (Switch).Next;
 863                            end loop;
 864                         end if;
 865                      end if;
 866                   end;
 867                end if;
 868             end;
 869          end if;
 870
 871          --  Get all the ALI files of the project file. We do that even if
 872          --  Bind is False, so that First_ALI is set.
 873
 874          declare
 875             Unit : Unit_Data;
 876
 877          begin
 878             Library_ALIs.Reset;
 879             Interface_ALIs.Reset;
 880             Processed_ALIs.Reset;
 881
 882             for Source in Unit_Table.First ..
 883                           Unit_Table.Last (In_Tree.Units)
 884             loop
 885                Unit := In_Tree.Units.Table (Source);
 886
 887                if Unit.File_Names (Body_Part).Name /= No_Name
 888                  and then Unit.File_Names (Body_Part).Path /= Slash
 889                then
 890                   if
 891                     Check_Project (Unit.File_Names (Body_Part).Project)
 892                   then
 893                      if Unit.File_Names (Specification).Name = No_Name then
 894                         declare
 895                            Src_Ind : Source_File_Index;
 896
 897                         begin
 898                            Src_Ind := Sinput.P.Load_Project_File
 899                              (Get_Name_String
 900                                 (Unit.File_Names
 901                                    (Body_Part).Path));
 902
 903                            --  Add the ALI file only if it is not a subunit
 904
 905                            if
 906                            not Sinput.P.Source_File_Is_Subunit (Src_Ind)
 907                            then
 908                               Add_ALI_For
 909                                 (Unit.File_Names (Body_Part).Name);
 910                               exit when not Bind;
 911                            end if;
 912                         end;
 913
 914                      else
 915                         Add_ALI_For (Unit.File_Names (Body_Part).Name);
 916                         exit when not Bind;
 917                      end if;
 918                   end if;
 919
 920                elsif Unit.File_Names (Specification).Name /= No_Name
 921                  and then Unit.File_Names (Specification).Path /= Slash
 922                  and then Check_Project
 923                    (Unit.File_Names (Specification).Project)
 924                then
 925                   Add_ALI_For (Unit.File_Names (Specification).Name);
 926                   exit when not Bind;
 927                end if;
 928             end loop;
 929          end;
 930
 931          --  Continue setup and call gnatbind if Bind is True
 932
 933          if Bind then
 934
 935             --  Get an eventual --RTS from the ALI file
 936
 937             if First_ALI /= No_Name then
 938                declare
 939                   T : Text_Buffer_Ptr;
 940                   A : ALI_Id;
 941
 942                begin
 943                   --  Load the ALI file
 944
 945                   T := Read_Library_Info (First_ALI, True);
 946
 947                   --  Read it
 948
 949                   A := Scan_ALI
 950                          (First_ALI, T, Ignore_ED => False, Err => False);
 951
 952                   if A /= No_ALI_Id then
 953                      for Index in
 954                        ALI.Units.Table
 955                          (ALI.ALIs.Table (A).First_Unit).First_Arg ..
 956                        ALI.Units.Table
 957                          (ALI.ALIs.Table (A).First_Unit).Last_Arg
 958                      loop
 959                         --  Look for --RTS. If found, add the switch to call
 960                         --  gnatbind.
 961
 962                         declare
 963                            Arg : String_Ptr renames Args.Table (Index);
 964                         begin
 965                            if Arg'Length >= 6 and then
 966                               Arg (Arg'First + 2 .. Arg'First + 5) = "RTS="
 967                            then
 968                               Add_Argument (Arg.all);
 969                               exit;
 970                            end if;
 971                         end;
 972                      end loop;
 973                   end if;
 974                end;
 975             end if;
 976
 977             --  Set the paths
 978
 979             Set_Ada_Paths
 980               (Project             => For_Project,
 981                In_Tree             => In_Tree,
 982                Including_Libraries => True);
 983
 984             --  Display the gnatbind command, if not in quiet output
 985
 986             Display (Gnatbind);
 987
 988             --  Invoke gnatbind
 989
 990             GNAT.OS_Lib.Spawn
 991               (Gnatbind_Path.all, Arguments (1 .. Argument_Number), Success);
 992
 993             if not Success then
 994                Com.Fail ("could not bind standalone library ",
 995                          Get_Name_String (Data.Library_Name));
 996             end if;
 997          end if;
 998
 999          --  Compile the binder generated file only if Link is true
1000
1001          if Link then
1002             --  Set the paths
1003
1004             Set_Ada_Paths
1005               (Project             => For_Project,
1006                In_Tree             => In_Tree,
1007                Including_Libraries => True);
1008
1009             --  Invoke <gcc> -c b$$<lib>.adb
1010
1011             --  Allocate Arguments, if it is the first time we see a standalone
1012             --  library.
1013
1014             if Arguments = No_Argument then
1015                Arguments := new String_List (1 .. Initial_Argument_Max);
1016             end if;
1017
1018             Argument_Number := 1;
1019             Arguments (1) := Compile_Switch;
1020
1021             if Hostparm.OpenVMS then
1022                B_Start (B_Start'Last) := '$';
1023             end if;
1024
1025             Add_Argument
1026               (B_Start & Get_Name_String (Data.Library_Name) & ".adb");
1027
1028             --  If necessary, add the PIC option
1029
1030             if PIC_Option /= "" then
1031                Add_Argument (PIC_Option);
1032             end if;
1033
1034             --  Get the back-end switches and --RTS from the ALI file
1035
1036             if First_ALI /= No_Name then
1037                declare
1038                   T : Text_Buffer_Ptr;
1039                   A : ALI_Id;
1040
1041                begin
1042                   --  Load the ALI file
1043
1044                   T := Read_Library_Info (First_ALI, True);
1045
1046                   --  Read it
1047
1048                   A := Scan_ALI
1049                          (First_ALI, T, Ignore_ED => False, Err => False);
1050
1051                   if A /= No_ALI_Id then
1052                      for Index in
1053                        ALI.Units.Table
1054                          (ALI.ALIs.Table (A).First_Unit).First_Arg ..
1055                        ALI.Units.Table
1056                          (ALI.ALIs.Table (A).First_Unit).Last_Arg
1057                      loop
1058                         --  Do not compile with the front end switches except
1059                         --  for --RTS.
1060
1061                         declare
1062                            Arg : String_Ptr renames Args.Table (Index);
1063                         begin
1064                            if not Is_Front_End_Switch (Arg.all)
1065                              or else
1066                                Arg (Arg'First + 2 .. Arg'First + 5) = "RTS="
1067                            then
1068                               Add_Argument (Arg.all);
1069                            end if;
1070                         end;
1071                      end loop;
1072                   end if;
1073                end;
1074             end if;
1075
1076             --  Now that all the arguments are set, compile the binder
1077             --  generated file.
1078
1079             Display (Gcc);
1080             GNAT.OS_Lib.Spawn
1081               (Gcc_Path.all, Arguments (1 .. Argument_Number), Success);
1082
1083             if not Success then
1084                Com.Fail
1085                  ("could not compile binder generated file for library ",
1086                   Get_Name_String (Data.Library_Name));
1087             end if;
1088
1089             --  Process binder generated file for pragmas Linker_Options
1090
1091             Process_Binder_File (Arguments (2).all & ASCII.NUL);
1092          end if;
1093       end if;
1094
1095       --  Build the library only if Link is True
1096
1097       if Link then
1098          --  If attribute Library_GCC was specified, get the driver name
1099
1100          Library_GCC :=
1101            Value_Of (Name_Library_GCC, Data.Decl.Attributes, In_Tree);
1102
1103          if not Library_GCC.Default then
1104             Driver_Name := Library_GCC.Value;
1105          end if;
1106
1107          --  If attribute Library_Options was specified, add these additional
1108          --  options.
1109
1110          Library_Options :=
1111            Value_Of (Name_Library_Options, Data.Decl.Attributes, In_Tree);
1112
1113          if not Library_Options.Default then
1114             declare
1115                Current : String_List_Id := Library_Options.Values;
1116                Element : String_Element;
1117
1118             begin
1119                while Current /= Nil_String loop
1120                   Element :=
1121                     In_Tree.String_Elements.Table (Current);
1122                   Get_Name_String (Element.Value);
1123
1124                   if Name_Len /= 0 then
1125                      Opts.Increment_Last;
1126                      Opts.Table (Opts.Last) :=
1127                        new String'(Name_Buffer (1 .. Name_Len));
1128                   end if;
1129
1130                   Current := Element.Next;
1131                end loop;
1132             end;
1133          end if;
1134
1135          Lib_Dirpath  := new String'(Get_Name_String (Data.Library_Dir));
1136          Lib_Filename := new String'(Get_Name_String (Data.Library_Name));
1137
1138          case Data.Library_Kind is
1139             when Static =>
1140                The_Build_Mode := Static;
1141
1142             when Dynamic =>
1143                The_Build_Mode := Dynamic;
1144
1145             when Relocatable =>
1146                The_Build_Mode := Relocatable;
1147
1148                if PIC_Option /= "" then
1149                   Opts.Increment_Last;
1150                   Opts.Table (Opts.Last) := new String'(PIC_Option);
1151                end if;
1152          end case;
1153
1154          --  Get the library version, if any
1155
1156          if Data.Lib_Internal_Name /= No_Name then
1157             Lib_Version :=
1158               new String'(Get_Name_String (Data.Lib_Internal_Name));
1159          end if;
1160
1161          --  Add the objects found in the object directory and the object
1162          --  directories of the extended files, if any, except for generated
1163          --  object files (b~.. or B$..) from extended projects.
1164          --  When there are one or more extended files, only add an object file
1165          --  if no object file with the same name have already been added.
1166
1167          In_Main_Object_Directory := True;
1168
1169          loop
1170             declare
1171                Object_Dir_Path : constant String :=
1172                                    Get_Name_String (Data.Object_Directory);
1173                Object_Dir      : Dir_Type;
1174                Filename        : String (1 .. 255);
1175                Last            : Natural;
1176                Id              : Name_Id;
1177
1178             begin
1179                Open (Dir => Object_Dir, Dir_Name => Object_Dir_Path);
1180
1181                --  For all entries in the object directory
1182
1183                loop
1184                   Read (Object_Dir, Filename, Last);
1185
1186                   exit when Last = 0;
1187
1188                   --  Check if it is an object file
1189
1190                   if Is_Obj (Filename (1 .. Last)) then
1191                      declare
1192                         Object_Path : String :=
1193                           Normalize_Pathname
1194                             (Object_Dir_Path & Directory_Separator &
1195                              Filename (1 .. Last));
1196
1197                      begin
1198                         Canonical_Case_File_Name (Object_Path);
1199                         Canonical_Case_File_Name (Filename (1 .. Last));
1200
1201                         --  If in the object directory of an extended project,
1202                         --  do not consider generated object files.
1203
1204                         if In_Main_Object_Directory
1205                           or else Last < 5
1206                           or else Filename (1 .. B_Start'Length) /= B_Start
1207                         then
1208                            Name_Len := Last;
1209                            Name_Buffer (1 .. Name_Len) := Filename (1 .. Last);
1210                            Id := Name_Find;
1211
1212                            if not Objects_Htable.Get (Id) then
1213
1214                               --  Record this object file
1215
1216                               Objects_Htable.Set (Id, True);
1217                               Objects.Increment_Last;
1218                               Objects.Table (Objects.Last) :=
1219                                 new String'(Object_Path);
1220
1221                               declare
1222                                  ALI_File : constant String :=
1223                                               Ext_To (Object_Path, "ali");
1224
1225                               begin
1226                                  if Is_Regular_File (ALI_File) then
1227
1228                                     --  Record the ALI file
1229
1230                                     ALIs.Increment_Last;
1231                                     ALIs.Table (ALIs.Last) :=
1232                                       new String'(ALI_File);
1233
1234                                     --  Find out if for this ALI file,
1235                                     --  libgnarl or libdecgnat or g-trasym.obj
1236                                     --  (on OpenVMS) is necessary.
1237
1238                                     Check_Libs (ALI_File);
1239
1240                                  else
1241                                     --  Object file is a foreign object file
1242
1243                                     Foreigns.Increment_Last;
1244                                     Foreigns.Table (Foreigns.Last) :=
1245                                       new String'(Object_Path);
1246                                  end if;
1247                               end;
1248                            end if;
1249                         end if;
1250                      end;
1251                   end if;
1252                end loop;
1253
1254                Close (Dir => Object_Dir);
1255
1256             exception
1257                when Directory_Error =>
1258                   Com.Fail ("cannot find object directory """,
1259                             Get_Name_String (Data.Object_Directory),
1260                             """");
1261             end;
1262
1263             exit when Data.Extends = No_Project;
1264
1265             In_Main_Object_Directory  := False;
1266             Data := In_Tree.Projects.Table (Data.Extends);
1267          end loop;
1268
1269          --  Add the -L and -l switches for the imported Library Project Files,
1270          --  and, if Path Option is supported, the library directory path names
1271          --  to Rpath.
1272
1273          Process_Imported_Libraries;
1274
1275          --  Link with libgnat and possibly libgnarl
1276
1277          Opts.Increment_Last;
1278          Opts.Table (Opts.Last) := new String'("-L" & Lib_Directory);
1279
1280          --  If Path Option is supported, add libgnat directory path name to
1281          --  Rpath.
1282
1283          if Path_Option /= null then
1284             Add_Rpath (Lib_Directory);
1285          end if;
1286
1287          if Libgnarl_Needed then
1288             Opts.Increment_Last;
1289
1290             if The_Build_Mode = Static then
1291                Opts.Table (Opts.Last) := new String'("-lgnarl");
1292             else
1293                Opts.Table (Opts.Last) := new String'(Shared_Lib ("gnarl"));
1294             end if;
1295          end if;
1296
1297          if Gtrasymobj_Needed then
1298             Opts.Increment_Last;
1299             Opts.Table (Opts.Last) :=
1300               new String'(Lib_Directory & "/g-trasym.obj");
1301          end if;
1302
1303          if Libdecgnat_Needed then
1304             Opts.Increment_Last;
1305             Opts.Table (Opts.Last) :=
1306               new String'("-L" & Lib_Directory & "/../declib");
1307             Opts.Increment_Last;
1308             Opts.Table (Opts.Last) := new String'("-ldecgnat");
1309          end if;
1310
1311          Opts.Increment_Last;
1312
1313          if The_Build_Mode = Static then
1314             Opts.Table (Opts.Last) := new String'("-lgnat");
1315          else
1316             Opts.Table (Opts.Last) := new String'(Shared_Lib ("gnat"));
1317          end if;
1318
1319          --  If Path Option is supported, add the necessary switch with the
1320          --  content of Rpath. As Rpath contains at least libgnat directory
1321          --  path name, it is guaranteed that it is not null.
1322
1323          if Path_Option /= null then
1324             Opts.Increment_Last;
1325             Opts.Table (Opts.Last) :=
1326               new String'(Path_Option.all & Rpath (1 .. Rpath_Last));
1327             Free (Path_Option);
1328             Free (Rpath);
1329          end if;
1330
1331          Object_Files :=
1332            new Argument_List'
1333              (Argument_List (Objects.Table (1 .. Objects.Last)));
1334
1335          Foreign_Objects :=
1336            new Argument_List'(Argument_List
1337                                 (Foreigns.Table (1 .. Foreigns.Last)));
1338
1339          Ali_Files :=
1340            new Argument_List'(Argument_List (ALIs.Table (1 .. ALIs.Last)));
1341
1342          Options :=
1343            new Argument_List'(Argument_List (Opts.Table (1 .. Opts.Last)));
1344
1345          --  We fail if there are no object to put in the library
1346          --  (Ada or foreign objects).
1347
1348          if Object_Files'Length = 0 then
1349             Com.Fail ("no object files for library """ &
1350                       Lib_Filename.all & '"');
1351          end if;
1352
1353          if not Opt.Quiet_Output then
1354             Write_Eol;
1355             Write_Str  ("building ");
1356             Write_Str (Ada.Characters.Handling.To_Lower
1357                          (Build_Mode_State'Image (The_Build_Mode)));
1358             Write_Str  (" library for project ");
1359             Write_Line (Project_Name);
1360
1361             Write_Eol;
1362
1363             Write_Line ("object files:");
1364
1365             for Index in Object_Files'Range loop
1366                Write_Str  ("   ");
1367                Write_Line (Object_Files (Index).all);
1368             end loop;
1369
1370             Write_Eol;
1371
1372             if Ali_Files'Length = 0 then
1373                Write_Line ("NO ALI files");
1374
1375             else
1376                Write_Line ("ALI files:");
1377
1378                for Index in Ali_Files'Range loop
1379                   Write_Str  ("   ");
1380                   Write_Line (Ali_Files (Index).all);
1381                end loop;
1382             end if;
1383
1384             Write_Eol;
1385          end if;
1386
1387          --  We check that all object files are regular files
1388
1389          Check_Context;
1390
1391          --  Delete the existing library file, if it exists.
1392          --  Fail if the library file is not writable, or if it is not possible
1393          --  to delete the file.
1394
1395          declare
1396             DLL_Name : aliased String :=
1397                          Lib_Dirpath.all & '/' & DLL_Prefix &
1398                            Lib_Filename.all & "." & DLL_Ext;
1399
1400             Archive_Name : aliased String :=
1401                              Lib_Dirpath.all & "/lib" &
1402                                Lib_Filename.all & "." & Archive_Ext;
1403
1404             type Str_Ptr is access all String;
1405             --  This type is necessary to meet the accessibility rules of Ada.
1406             --  It is not possible to use String_Access here.
1407
1408             Full_Lib_Name : Str_Ptr;
1409             --  Designates the full library path name. Either DLL_Name or
1410             --  Archive_Name, depending on the library kind.
1411
1412             Success : Boolean := False;
1413             --  Used to call Delete_File
1414
1415          begin
1416             if The_Build_Mode = Static then
1417                Full_Lib_Name := Archive_Name'Access;
1418             else
1419                Full_Lib_Name := DLL_Name'Access;
1420             end if;
1421
1422             if Is_Regular_File (Full_Lib_Name.all) then
1423                if Is_Writable_File (Full_Lib_Name.all) then
1424                   Delete_File (Full_Lib_Name.all, Success);
1425                end if;
1426
1427                if Is_Regular_File (Full_Lib_Name.all) then
1428                   Com.Fail ("could not delete """ & Full_Lib_Name.all & """");
1429                end if;
1430             end if;
1431          end;
1432
1433          Argument_Number := 0;
1434
1435          --  If we have a standalone library, gather all the interface ALI.
1436          --  They are passed to Build_Dynamic_Library, where they are used by
1437          --  some platforms (VMS, for example) to decide what symbols should be
1438          --  exported. They are also flagged as Interface when we copy them to
1439          --  the library directory (by Copy_ALI_Files, below).
1440
1441          if Standalone then
1442             Data := In_Tree.Projects.Table (For_Project);
1443
1444             declare
1445                Iface : String_List_Id := Data.Lib_Interface_ALIs;
1446                ALI   : File_Name_Type;
1447
1448             begin
1449                while Iface /= Nil_String loop
1450                   ALI :=
1451                     In_Tree.String_Elements.Table (Iface).Value;
1452                   Interface_ALIs.Set (ALI, True);
1453                   Get_Name_String
1454                     (In_Tree.String_Elements.Table (Iface).Value);
1455                   Add_Argument (Name_Buffer (1 .. Name_Len));
1456                   Iface :=
1457                     In_Tree.String_Elements.Table (Iface).Next;
1458                end loop;
1459
1460                Iface := Data.Lib_Interface_ALIs;
1461
1462                if not Opt.Quiet_Output then
1463
1464                   --  Check that the interface set is complete: any unit in the
1465                   --  library that is needed by an interface should also be an
1466                   --  interface. If it is not the case, output a warning.
1467
1468                   while Iface /= Nil_String loop
1469                      ALI := In_Tree.String_Elements.Table
1470                               (Iface).Value;
1471                      Process (ALI);
1472                      Iface :=
1473                        In_Tree.String_Elements.Table (Iface).Next;
1474                   end loop;
1475                end if;
1476             end;
1477          end if;
1478
1479          declare
1480             Current_Dir  : constant String := Get_Current_Dir;
1481             Dir          : Dir_Type;
1482
1483             Name : String (1 .. 200);
1484             Last : Natural;
1485
1486             Disregard : Boolean;
1487
1488             DLL_Name : aliased constant String :=
1489                          Lib_Filename.all & "." & DLL_Ext;
1490
1491             Archive_Name : aliased constant String :=
1492                              Lib_Filename.all & "." & Archive_Ext;
1493
1494             Delete : Boolean := False;
1495
1496          begin
1497             --  Clean the library directory: remove any file with the name of
1498             --  the library file and any ALI file of a source of the project.
1499
1500             begin
1501                Get_Name_String
1502                  (In_Tree.Projects.Table (For_Project).Library_Dir);
1503                Change_Dir (Name_Buffer (1 .. Name_Len));
1504
1505             exception
1506                when others =>
1507                   Com.Fail
1508                     ("unable to access library directory """,
1509                      Name_Buffer (1 .. Name_Len),
1510                      """");
1511             end;
1512
1513             Open (Dir, ".");
1514
1515             loop
1516                Read (Dir, Name, Last);
1517                exit when Last = 0;
1518
1519                if Is_Regular_File (Name (1 .. Last)) then
1520                   Canonical_Case_File_Name (Name (1 .. Last));
1521                   Delete := False;
1522
1523                   if (The_Build_Mode = Static and then
1524                         Name (1 .. Last) =  Archive_Name)
1525                     or else
1526                       ((The_Build_Mode = Dynamic or else
1527                           The_Build_Mode = Relocatable)
1528                        and then
1529                          Name (1 .. Last) = DLL_Name)
1530                   then
1531                      Delete := True;
1532
1533                   elsif Last > 4 and then Name (Last - 3 .. Last) = ".ali" then
1534                      declare
1535                         Unit : Unit_Data;
1536                      begin
1537                         --  Compare with ALI file names of the project
1538
1539                         for Index in 1 .. Unit_Table.Last (In_Tree.Units) loop
1540                            Unit := In_Tree.Units.Table (Index);
1541
1542                            if Unit.File_Names (Body_Part).Project /=
1543                              No_Project
1544                            then
1545                               if  Ultimate_Extension_Of
1546                                 (Unit.File_Names (Body_Part).Project, In_Tree)
1547                                  = For_Project
1548                               then
1549                                  Get_Name_String
1550                                    (Unit.File_Names (Body_Part).Name);
1551                                  Name_Len := Name_Len -
1552                                    File_Extension
1553                                      (Name (1 .. Name_Len))'Length;
1554                                  if Name_Buffer (1 .. Name_Len) =
1555                                      Name (1 .. Last - 4)
1556                                  then
1557                                     Delete := True;
1558                                     exit;
1559                                  end if;
1560                               end if;
1561
1562                            elsif Ultimate_Extension_Of
1563                              (Unit.File_Names (Specification).Project, In_Tree)
1564                              = For_Project
1565                            then
1566                               Get_Name_String
1567                                 (Unit.File_Names (Specification).Name);
1568                               Name_Len := Name_Len -
1569                                 File_Extension (Name (1 .. Name_Len))'Length;
1570
1571                               if Name_Buffer (1 .. Name_Len) =
1572                                    Name (1 .. Last - 4)
1573                               then
1574                                  Delete := True;
1575                                  exit;
1576                               end if;
1577                            end if;
1578                         end loop;
1579                      end;
1580                   end if;
1581
1582                   if Delete then
1583                      Set_Writable (Name (1 .. Last));
1584                      Delete_File (Name (1 .. Last), Disregard);
1585                   end if;
1586                end if;
1587             end loop;
1588
1589             Close (Dir);
1590
1591             Change_Dir (Current_Dir);
1592          end;
1593
1594          --  Call procedure to build the library, depending on the build mode
1595
1596          case The_Build_Mode is
1597             when Dynamic | Relocatable =>
1598                Build_Dynamic_Library
1599                  (Ofiles        => Object_Files.all,
1600                   Foreign       => Foreign_Objects.all,
1601                   Afiles        => Ali_Files.all,
1602                   Options       => Options.all,
1603                   Options_2     => No_Argument_List,
1604                   Interfaces    => Arguments (1 .. Argument_Number),
1605                   Lib_Filename  => Lib_Filename.all,
1606                   Lib_Dir       => Lib_Dirpath.all,
1607                   Symbol_Data   => Data.Symbol_Data,
1608                   Driver_Name   => Driver_Name,
1609                   Lib_Version   => Lib_Version.all,
1610                   Auto_Init     => Data.Lib_Auto_Init);
1611
1612             when Static =>
1613                MLib.Build_Library
1614                  (Object_Files.all,
1615                   Ali_Files.all,
1616                   Lib_Filename.all,
1617                   Lib_Dirpath.all);
1618
1619             when None =>
1620                null;
1621          end case;
1622
1623          --  We need to copy the ALI files from the object directory to
1624          --  the library ALI directory, so that the linker find them there,
1625          --  and does not need to look in the object directory where it
1626          --  would also find the object files; and we don't want that:
1627          --  we want the linker to use the library.
1628
1629          --  Copy the ALI files and make the copies read-only. For interfaces,
1630          --  mark the copies as interfaces.
1631
1632          Copy_ALI_Files
1633            (Files      => Ali_Files.all,
1634             To         => In_Tree.Projects.Table (For_Project).Library_ALI_Dir,
1635             Interfaces => Arguments (1 .. Argument_Number));
1636
1637          --  Copy interface sources if Library_Src_Dir specified
1638
1639          if Standalone
1640            and then In_Tree.Projects.Table
1641                       (For_Project).Library_Src_Dir /= No_Name
1642          then
1643             --  Clean the interface copy directory: remove any source that
1644             --  could be a source of the project.
1645
1646             begin
1647                Get_Name_String
1648                  (In_Tree.Projects.Table (For_Project).Library_Src_Dir);
1649                Change_Dir (Name_Buffer (1 .. Name_Len));
1650
1651             exception
1652                when others =>
1653                   Com.Fail
1654                     ("unable to access library source copy directory """,
1655                      Name_Buffer (1 .. Name_Len),
1656                      """");
1657             end;
1658
1659             declare
1660                Dir    : Dir_Type;
1661                Delete : Boolean;
1662                Unit   : Unit_Data;
1663
1664                Name : String (1 .. 200);
1665                Last : Natural;
1666
1667                Disregard : Boolean;
1668
1669             begin
1670                Open (Dir, ".");
1671
1672                loop
1673                   Read (Dir, Name, Last);
1674                   exit when Last = 0;
1675
1676                   if Is_Regular_File (Name (1 .. Last)) then
1677                      Canonical_Case_File_Name (Name (1 .. Last));
1678                      Delete := False;
1679
1680                      --  Compare with source file names of the project
1681
1682                      for Index in 1 .. Unit_Table.Last (In_Tree.Units) loop
1683                         Unit := In_Tree.Units.Table (Index);
1684
1685                         if Ultimate_Extension_Of
1686                             (Unit.File_Names (Body_Part).Project, In_Tree) =
1687                             For_Project
1688                           and then
1689                             Get_Name_String
1690                               (Unit.File_Names (Body_Part).Name) =
1691                             Name (1 .. Last)
1692                         then
1693                            Delete := True;
1694                            exit;
1695                         end if;
1696
1697                         if Ultimate_Extension_Of
1698                            (Unit.File_Names (Specification).Project, In_Tree) =
1699                            For_Project
1700                           and then
1701                            Get_Name_String
1702                              (Unit.File_Names (Specification).Name) =
1703                            Name (1 .. Last)
1704                         then
1705                            Delete := True;
1706                            exit;
1707                         end if;
1708                      end loop;
1709                   end if;
1710
1711                   if Delete then
1712                      Set_Writable (Name (1 .. Last));
1713                      Delete_File (Name (1 .. Last), Disregard);
1714                   end if;
1715                end loop;
1716
1717                Close (Dir);
1718             end;
1719
1720             Copy_Interface_Sources
1721               (For_Project => For_Project,
1722                In_Tree     => In_Tree,
1723                Interfaces  => Arguments (1 .. Argument_Number),
1724                To_Dir      => In_Tree.Projects.Table
1725                                 (For_Project).Library_Src_Dir);
1726          end if;
1727       end if;
1728
1729       --  Reset the current working directory to its previous value
1730
1731       Change_Dir (Current_Dir);
1732    end Build_Library;
1733
1734    -----------
1735    -- Check --
1736    -----------
1737
1738    procedure Check (Filename : String) is
1739    begin
1740       if not Is_Regular_File (Filename) then
1741          Com.Fail (Filename, " not found.");
1742       end if;
1743    end Check;
1744
1745    -------------------
1746    -- Check_Context --
1747    -------------------
1748
1749    procedure Check_Context is
1750    begin
1751       --  Check that each object file exists
1752
1753       for F in Object_Files'Range loop
1754          Check (Object_Files (F).all);
1755       end loop;
1756    end Check_Context;
1757
1758    -------------------
1759    -- Check_Library --
1760    -------------------
1761
1762    procedure Check_Library
1763      (For_Project : Project_Id; In_Tree : Project_Tree_Ref)
1764    is
1765       Data    : constant Project_Data :=
1766                   In_Tree.Projects.Table (For_Project);
1767       Lib_TS  : Time_Stamp_Type;
1768       Current : constant Dir_Name_Str := Get_Current_Dir;
1769
1770    begin
1771       --  No need to build the library if there is no object directory,
1772       --  hence no object files to build the library.
1773
1774       if Data.Library then
1775          declare
1776             Lib_Name : constant Name_Id :=
1777               Library_File_Name_For (For_Project, In_Tree);
1778          begin
1779             Change_Dir (Get_Name_String (Data.Library_Dir));
1780             Lib_TS := File_Stamp (Lib_Name);
1781             In_Tree.Projects.Table (For_Project).Library_TS := Lib_TS;
1782          end;
1783
1784          if not Data.Externally_Built
1785            and then not Data.Need_To_Build_Lib
1786            and then Data.Object_Directory /= No_Name
1787          then
1788             declare
1789                Obj_TS     : Time_Stamp_Type;
1790                Object_Dir : Dir_Type;
1791
1792             begin
1793                if Hostparm.OpenVMS then
1794                   B_Start (B_Start'Last) := '$';
1795                end if;
1796
1797                --  If the library file does not exist, then the time stamp will
1798                --  be Empty_Time_Stamp, earlier than any other time stamp.
1799
1800                Change_Dir (Get_Name_String (Data.Object_Directory));
1801                Open (Dir => Object_Dir, Dir_Name => ".");
1802
1803                --  For all entries in the object directory
1804
1805                loop
1806                   Read (Object_Dir, Name_Buffer, Name_Len);
1807                   exit when Name_Len = 0;
1808
1809                   --  Check if it is an object file, but ignore any binder
1810                   --  generated file.
1811
1812                   if Is_Obj (Name_Buffer (1 .. Name_Len))
1813                     and then Name_Buffer (1 .. B_Start'Length) /= B_Start
1814                   then
1815                      --  Get the object file time stamp
1816
1817                      Obj_TS := File_Stamp (Name_Find);
1818
1819                      --  If library file time stamp is earlier, set
1820                      --  Need_To_Build_Lib and return. String comparaison is
1821                      --  used, otherwise time stamps may be too close and the
1822                      --  comparaison would return True, which would trigger
1823                      --  an unnecessary rebuild of the library.
1824
1825                      if String (Lib_TS) < String (Obj_TS) then
1826
1827                         --  Library must be rebuilt
1828
1829                         In_Tree.Projects.Table
1830                           (For_Project).Need_To_Build_Lib := True;
1831                         exit;
1832                      end if;
1833                   end if;
1834                end loop;
1835
1836                Close (Object_Dir);
1837             end;
1838          end if;
1839
1840          Change_Dir (Current);
1841       end if;
1842    end Check_Library;
1843
1844    ----------------------------
1845    -- Copy_Interface_Sources --
1846    ----------------------------
1847
1848    procedure Copy_Interface_Sources
1849      (For_Project : Project_Id;
1850       In_Tree     : Project_Tree_Ref;
1851       Interfaces  : Argument_List;
1852       To_Dir      : Name_Id)
1853    is
1854       Current : constant Dir_Name_Str := Get_Current_Dir;
1855       --  The current directory, where to return to at the end
1856
1857       Target : constant Dir_Name_Str := Get_Name_String (To_Dir);
1858       --  The directory where to copy sources
1859
1860       Text     : Text_Buffer_Ptr;
1861       The_ALI  : ALI.ALI_Id;
1862       Lib_File : Name_Id;
1863
1864       First_Unit  : ALI.Unit_Id;
1865       Second_Unit : ALI.Unit_Id;
1866
1867       Data : Unit_Data;
1868
1869       Copy_Subunits : Boolean := False;
1870       --  When True, indicates that subunits, if any, need to be copied too
1871
1872       procedure Copy (File_Name : Name_Id);
1873       --  Copy one source of the project to the target directory
1874
1875       function Is_Same_Or_Extension
1876         (Extending : Project_Id;
1877          Extended  : Project_Id) return Boolean;
1878       --  Return True if project Extending is equal to or extends project
1879       --  Extended.
1880
1881       ----------
1882       -- Copy --
1883       ----------
1884
1885       procedure Copy (File_Name : Name_Id) is
1886          Success : Boolean := False;
1887
1888       begin
1889          Unit_Loop :
1890          for Index in Unit_Table.First ..
1891                       Unit_Table.Last (In_Tree.Units)
1892          loop
1893             Data := In_Tree.Units.Table (Index);
1894
1895             --  Find and copy the immediate or inherited source
1896
1897             for J in Data.File_Names'Range loop
1898                if Is_Same_Or_Extension
1899                     (For_Project, Data.File_Names (J).Project)
1900                  and then Data.File_Names (J).Name = File_Name
1901                then
1902                   Copy_File
1903                     (Get_Name_String (Data.File_Names (J).Path),
1904                      Target,
1905                      Success,
1906                      Mode => Overwrite,
1907                      Preserve => Preserve);
1908                   exit Unit_Loop;
1909                end if;
1910             end loop;
1911          end loop Unit_Loop;
1912       end Copy;
1913
1914       --------------------------
1915       -- Is_Same_Or_Extension --
1916       --------------------------
1917
1918       function Is_Same_Or_Extension
1919         (Extending : Project_Id;
1920          Extended  : Project_Id) return Boolean
1921       is
1922          Ext : Project_Id := Extending;
1923
1924       begin
1925          while Ext /= No_Project loop
1926             if Ext = Extended then
1927                return True;
1928             end if;
1929
1930             Ext := In_Tree.Projects.Table (Ext).Extends;
1931          end loop;
1932
1933          return False;
1934       end Is_Same_Or_Extension;
1935
1936    --  Start of processing for Copy_Interface_Sources
1937
1938    begin
1939       --  Change the working directory to the object directory
1940
1941       Change_Dir
1942         (Get_Name_String
1943            (In_Tree.Projects.Table
1944               (For_Project).Object_Directory));
1945
1946       for Index in Interfaces'Range loop
1947
1948          --  First, load the ALI file
1949
1950          Name_Len := 0;
1951          Add_Str_To_Name_Buffer (Interfaces (Index).all);
1952          Lib_File := Name_Find;
1953          Text := Read_Library_Info (Lib_File);
1954          The_ALI := Scan_ALI (Lib_File, Text, Ignore_ED => False, Err => True);
1955          Free (Text);
1956
1957          Second_Unit := No_Unit_Id;
1958          First_Unit := ALI.ALIs.Table (The_ALI).First_Unit;
1959          Copy_Subunits := True;
1960
1961          --  If there is both a spec and a body, check if they are both needed
1962
1963          if ALI.Units.Table (First_Unit).Utype = Is_Body then
1964             Second_Unit := ALI.ALIs.Table (The_ALI).Last_Unit;
1965
1966             --  If the body is not needed, then reset First_Unit
1967
1968             if not ALI.Units.Table (Second_Unit).Body_Needed_For_SAL then
1969                First_Unit := No_Unit_Id;
1970                Copy_Subunits := False;
1971             end if;
1972
1973          elsif ALI.Units.Table (First_Unit).Utype = Is_Spec_Only then
1974             Copy_Subunits := False;
1975          end if;
1976
1977          --  Copy the file(s) that need to be copied
1978
1979          if First_Unit /= No_Unit_Id then
1980             Copy (File_Name => ALI.Units.Table (First_Unit).Sfile);
1981          end if;
1982
1983          if Second_Unit /= No_Unit_Id then
1984             Copy (File_Name => ALI.Units.Table (Second_Unit).Sfile);
1985          end if;
1986
1987          --  Copy all the separates, if any
1988
1989          if Copy_Subunits then
1990             for Dep in ALI.ALIs.Table (The_ALI).First_Sdep ..
1991               ALI.ALIs.Table (The_ALI).Last_Sdep
1992             loop
1993                if Sdep.Table (Dep).Subunit_Name /= No_Name then
1994                   Copy (File_Name => Sdep.Table (Dep).Sfile);
1995                end if;
1996             end loop;
1997          end if;
1998       end loop;
1999
2000       --  Restore the initial working directory
2001
2002       Change_Dir (Current);
2003    end Copy_Interface_Sources;
2004
2005    -------------
2006    -- Display --
2007    -------------
2008
2009    procedure Display (Executable : String) is
2010    begin
2011       if not Opt.Quiet_Output then
2012          Write_Str (Executable);
2013
2014          for Index in 1 .. Argument_Number loop
2015             Write_Char (' ');
2016             Write_Str (Arguments (Index).all);
2017          end loop;
2018
2019          Write_Eol;
2020       end if;
2021    end Display;
2022
2023    -------------------------
2024    -- Process_Binder_File --
2025    -------------------------
2026
2027    procedure Process_Binder_File (Name : String) is
2028       Fd : FILEs;
2029       --  Binder file's descriptor
2030
2031       Read_Mode : constant String := "r" & ASCII.Nul;
2032       --  For fopen
2033
2034       Status : Interfaces.C_Streams.int;
2035       pragma Unreferenced (Status);
2036       --  For fclose
2037
2038       Begin_Info : constant String := "--  BEGIN Object file/option list";
2039       End_Info   : constant String := "--  END Object file/option list   ";
2040
2041       Next_Line : String (1 .. 1000);
2042       --  Current line value
2043       --  Where does this odd constant 1000 come from, looks suspicious ???
2044
2045       Nlast : Integer;
2046       --  End of line slice (the slice does not contain the line terminator)
2047
2048       procedure Get_Next_Line;
2049       --  Read the next line from the binder file without the line terminator
2050
2051       -------------------
2052       -- Get_Next_Line --
2053       -------------------
2054
2055       procedure Get_Next_Line is
2056          Fchars : chars;
2057
2058       begin
2059          Fchars := fgets (Next_Line'Address, Next_Line'Length, Fd);
2060
2061          if Fchars = System.Null_Address then
2062             Fail ("Error reading binder output");
2063          end if;
2064
2065          Nlast := 1;
2066          while Nlast <= Next_Line'Last
2067            and then Next_Line (Nlast) /= ASCII.LF
2068            and then Next_Line (Nlast) /= ASCII.CR
2069          loop
2070             Nlast := Nlast + 1;
2071          end loop;
2072
2073          Nlast := Nlast - 1;
2074       end Get_Next_Line;
2075
2076    --  Start of processing for Process_Binder_File
2077
2078    begin
2079       Fd := fopen (Name'Address, Read_Mode'Address);
2080
2081       if Fd = NULL_Stream then
2082          Fail ("Failed to open binder output");
2083       end if;
2084
2085       --  Skip up to the Begin Info line
2086
2087       loop
2088          Get_Next_Line;
2089          exit when Next_Line (1 .. Nlast) = Begin_Info;
2090       end loop;
2091
2092       --  Find the first switch
2093
2094       loop
2095          Get_Next_Line;
2096
2097          exit when Next_Line (1 .. Nlast) = End_Info;
2098
2099          --  As the binder generated file is in Ada, remove the first eight
2100          --  characters "   --   ".
2101
2102          Next_Line (1 .. Nlast - 8) := Next_Line (9 .. Nlast);
2103          Nlast := Nlast - 8;
2104
2105          --  Stop when the first switch is found
2106
2107          exit when Next_Line (1) = '-';
2108       end loop;
2109
2110       if Next_Line (1 .. Nlast) /= End_Info then
2111          loop
2112             --  Ignore -static and -shared, since -shared will be used
2113             --  in any case.
2114
2115             --  Ignore -lgnat, -lgnarl and -ldecgnat as they will be added
2116             --  later, because they are also needed for non Stand-Alone shared
2117             --  libraries.
2118
2119             --  Also ignore the shared libraries which are :
2120
2121             --  UNIX / Windows    VMS
2122             --  -lgnat-<version>  -lgnat_<version>  (7 + version'length chars)
2123             --  -lgnarl-<version> -lgnarl_<version> (8 + version'length chars)
2124
2125             if Next_Line (1 .. Nlast) /= "-static" and then
2126                Next_Line (1 .. Nlast) /= "-shared" and then
2127                Next_Line (1 .. Nlast) /= "-ldecgnat" and then
2128                Next_Line (1 .. Nlast) /= "-lgnarl" and then
2129                Next_Line (1 .. Nlast) /= "-lgnat" and then
2130                Next_Line
2131                  (1 .. Natural'Min (Nlast, 8 + Library_Version'Length)) /=
2132                    Shared_Lib ("gnarl") and then
2133                Next_Line
2134                  (1 .. Natural'Min (Nlast, 7 + Library_Version'Length)) /=
2135                    Shared_Lib ("gnat")
2136             then
2137                if Next_Line (1) /= '-' then
2138
2139                   --  This is not an option, should we add it?
2140
2141                   if Add_Object_Files then
2142                      Opts.Increment_Last;
2143                      Opts.Table (Opts.Last) :=
2144                        new String'(Next_Line (1 .. Nlast));
2145                   end if;
2146
2147                else
2148                   --  Add all other options
2149
2150                   Opts.Increment_Last;
2151                   Opts.Table (Opts.Last) :=
2152                     new String'(Next_Line (1 .. Nlast));
2153                end if;
2154             end if;
2155
2156             --  Next option, if any
2157
2158             Get_Next_Line;
2159             exit when Next_Line (1 .. Nlast) = End_Info;
2160
2161             --  Remove first eight characters "   --   "
2162
2163             Next_Line (1 .. Nlast - 8) := Next_Line (9 .. Nlast);
2164             Nlast := Nlast - 8;
2165          end loop;
2166       end if;
2167
2168       Status := fclose (Fd);
2169
2170       --  Is it really right to ignore any close error ???
2171
2172    end Process_Binder_File;
2173
2174    ------------------
2175    -- Reset_Tables --
2176    ------------------
2177
2178    procedure Reset_Tables is
2179    begin
2180       Objects.Init;
2181       Objects_Htable.Reset;
2182       Foreigns.Init;
2183       ALIs.Init;
2184       Opts.Init;
2185       Processed_Projects.Reset;
2186       Library_Projs.Init;
2187    end Reset_Tables;
2188
2189    ---------------------------
2190    -- SALs_Use_Constructors --
2191    ---------------------------
2192
2193    function SALs_Use_Constructors return Boolean is
2194       function C_SALs_Init_Using_Constructors return Integer;
2195       pragma Import (C, C_SALs_Init_Using_Constructors,
2196                      "__gnat_sals_init_using_constructors");
2197    begin
2198       return C_SALs_Init_Using_Constructors /= 0;
2199    end SALs_Use_Constructors;
2200
2201    ---------------------------
2202    -- Ultimate_Extension_Of --
2203    ---------------------------
2204
2205    function Ultimate_Extension_Of
2206      (Project : Project_Id;
2207       In_Tree : Project_Tree_Ref) return Project_Id
2208    is
2209       Result : Project_Id := Project;
2210       Data   : Project_Data;
2211
2212    begin
2213       if Project /= No_Project then
2214          loop
2215             Data := In_Tree.Projects.Table (Result);
2216             exit when Data.Extended_By = No_Project;
2217             Result := Data.Extended_By;
2218          end loop;
2219       end if;
2220
2221       return Result;
2222    end Ultimate_Extension_Of;
2223
2224 end MLib.Prj;