gcc/ada/prj-conf.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             P R J . C O N F                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --            Copyright (C) 2006-2015, Free Software Foundation, Inc.       --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with Makeutl;  use Makeutl;
  27 with MLib.Tgt;
  28 with Opt;      use Opt;
  29 with Output;   use Output;
  30 with Prj.Env;
  31 with Prj.Err;
  32 with Prj.Part;
  33 with Prj.PP;
  34 with Prj.Proc; use Prj.Proc;
  35 with Prj.Tree; use Prj.Tree;
  36 with Prj.Util; use Prj.Util;
  37 with Prj;      use Prj;
  38 with Snames;   use Snames;
  39
  40 with Ada.Directories; use Ada.Directories;
  41 with Ada.Exceptions;  use Ada.Exceptions;
  42
  43 with GNAT.Case_Util; use GNAT.Case_Util;
  44 with GNAT.HTable;    use GNAT.HTable;
  45
  46 package body Prj.Conf is
  47
  48    Auto_Cgpr : constant String := "auto.cgpr";
  49
  50    Config_Project_Env_Var : constant String := "GPR_CONFIG";
  51    --  Name of the environment variable that provides the name of the
  52    --  configuration file to use.
  53
  54    Gprconfig_Name : constant String := "gprconfig";
  55
  56    Warn_For_RTS : Boolean := True;
  57    --  Set to False when gprbuild parse again the project files, to avoid
  58    --  an incorrect warning.
  59
  60    type Runtime_Root_Data;
  61    type Runtime_Root_Ptr is access Runtime_Root_Data;
  62    type Runtime_Root_Data is record
  63       Root : String_Access;
  64       Next : Runtime_Root_Ptr;
  65    end record;
  66    --  Data for a runtime root to be used when adding directories to the
  67    --  project path.
  68
  69    type Compiler_Root_Data;
  70    type Compiler_Root_Ptr is access Compiler_Root_Data;
  71    type Compiler_Root_Data is record
  72       Root : String_Access;
  73       Runtimes : Runtime_Root_Ptr;
  74       Next     : Compiler_Root_Ptr;
  75    end record;
  76    --  Data for a compiler root to be used when adding directories to the
  77    --  project path.
  78
  79    First_Compiler_Root : Compiler_Root_Ptr := null;
  80    --  Head of the list of compiler roots
  81
  82    package RTS_Languages is new GNAT.HTable.Simple_HTable
  83      (Header_Num => Prj.Header_Num,
  84       Element    => Name_Id,
  85       No_Element => No_Name,
  86       Key        => Name_Id,
  87       Hash       => Prj.Hash,
  88       Equal      => "=");
  89    --  Stores the runtime names for the various languages. This is in general
  90    --  set from a --RTS command line option.
  91
  92    -----------------------
  93    -- Local_Subprograms --
  94    -----------------------
  95
  96    function Check_Target
  97      (Config_File        : Prj.Project_Id;
  98       Autoconf_Specified : Boolean;
  99       Project_Tree       : Prj.Project_Tree_Ref;
 100       Target             : String := "") return Boolean;
 101    --  Check that the config file's target matches Target.
 102    --  Target should be set to the empty string when the user did not specify
 103    --  a target. If the target in the configuration file is invalid, this
 104    --  function will raise Invalid_Config with an appropriate message.
 105    --  Autoconf_Specified should be set to True if the user has used
 106    --  autoconf.
 107
 108    function Locate_Config_File (Name : String) return String_Access;
 109    --  Search for Name in the config files directory. Return full path if
 110    --  found, or null otherwise.
 111
 112    procedure Raise_Invalid_Config (Msg : String);
 113    pragma No_Return (Raise_Invalid_Config);
 114    --  Raises exception Invalid_Config with given message
 115
 116    procedure Apply_Config_File
 117      (Config_File  : Prj.Project_Id;
 118       Project_Tree : Prj.Project_Tree_Ref);
 119    --  Apply the configuration file settings to all the projects in the
 120    --  project tree. The Project_Tree must have been parsed first, and
 121    --  processed through the first phase so that all its projects are known.
 122    --
 123    --  Currently, this will add new attributes and packages in the various
 124    --  projects, so that when the second phase of the processing is performed
 125    --  these attributes are automatically taken into account.
 126
 127    type State is (No_State);
 128
 129    procedure Look_For_Project_Paths
 130      (Project    : Project_Id;
 131       Tree       : Project_Tree_Ref;
 132       With_State : in out State);
 133    --  Check the compilers in the Project and add record them in the list
 134    --  rooted at First_Compiler_Root, with their runtimes, if they are not
 135    --  already in the list.
 136
 137    procedure Update_Project_Path is new
 138      For_Every_Project_Imported
 139        (State  => State,
 140         Action => Look_For_Project_Paths);
 141
 142    ------------------------------------
 143    -- Add_Default_GNAT_Naming_Scheme --
 144    ------------------------------------
 145
 146    procedure Add_Default_GNAT_Naming_Scheme
 147      (Config_File  : in out Project_Node_Id;
 148       Project_Tree : Project_Node_Tree_Ref)
 149    is
 150       procedure Create_Attribute
 151         (Name  : Name_Id;
 152          Value : String;
 153          Index : String := "";
 154          Pkg   : Project_Node_Id := Empty_Node);
 155
 156       ----------------------
 157       -- Create_Attribute --
 158       ----------------------
 159
 160       procedure Create_Attribute
 161         (Name  : Name_Id;
 162          Value : String;
 163          Index : String := "";
 164          Pkg   : Project_Node_Id := Empty_Node)
 165       is
 166          Attr : Project_Node_Id;
 167          pragma Unreferenced (Attr);
 168
 169          Expr   : Name_Id         := No_Name;
 170          Val    : Name_Id         := No_Name;
 171          Parent : Project_Node_Id := Config_File;
 172
 173       begin
 174          if Index /= "" then
 175             Name_Len := Index'Length;
 176             Name_Buffer (1 .. Name_Len) := Index;
 177             Val := Name_Find;
 178          end if;
 179
 180          if Pkg /= Empty_Node then
 181             Parent := Pkg;
 182          end if;
 183
 184          Name_Len := Value'Length;
 185          Name_Buffer (1 .. Name_Len) := Value;
 186          Expr := Name_Find;
 187
 188          Attr := Create_Attribute
 189            (Tree       => Project_Tree,
 190             Prj_Or_Pkg => Parent,
 191             Name       => Name,
 192             Index_Name => Val,
 193             Kind       => Prj.Single,
 194             Value      => Create_Literal_String (Expr, Project_Tree));
 195       end Create_Attribute;
 196
 197       --  Local variables
 198
 199       Name     : Name_Id;
 200       Naming   : Project_Node_Id;
 201       Compiler : Project_Node_Id;
 202
 203    --  Start of processing for Add_Default_GNAT_Naming_Scheme
 204
 205    begin
 206       if Config_File = Empty_Node then
 207
 208          --  Create a dummy config file if none was found
 209
 210          Name_Len := Auto_Cgpr'Length;
 211          Name_Buffer (1 .. Name_Len) := Auto_Cgpr;
 212          Name := Name_Find;
 213
 214          --  An invalid project name to avoid conflicts with user-created ones
 215
 216          Name_Len := 5;
 217          Name_Buffer (1 .. Name_Len) := "_auto";
 218
 219          Config_File :=
 220            Create_Project
 221              (In_Tree        => Project_Tree,
 222               Name           => Name_Find,
 223               Full_Path      => Path_Name_Type (Name),
 224               Is_Config_File => True);
 225
 226          --  Setup library support
 227
 228          case MLib.Tgt.Support_For_Libraries is
 229             when None =>
 230                null;
 231
 232             when Static_Only =>
 233                Create_Attribute (Name_Library_Support, "static_only");
 234
 235             when Full =>
 236                Create_Attribute (Name_Library_Support, "full");
 237          end case;
 238
 239          if MLib.Tgt.Standalone_Library_Auto_Init_Is_Supported then
 240             Create_Attribute (Name_Library_Auto_Init_Supported, "true");
 241          else
 242             Create_Attribute (Name_Library_Auto_Init_Supported, "false");
 243          end if;
 244
 245          --  Declare an empty target
 246
 247          Create_Attribute (Name_Target, "");
 248
 249          --  Setup Ada support (Ada is the default language here, since this
 250          --  is only called when no config file existed initially, ie for
 251          --  gnatmake).
 252
 253          Create_Attribute (Name_Default_Language, "ada");
 254
 255          Compiler := Create_Package (Project_Tree, Config_File, "compiler");
 256          Create_Attribute
 257            (Name_Driver, "gcc", "ada", Pkg => Compiler);
 258          Create_Attribute
 259            (Name_Language_Kind, "unit_based", "ada", Pkg => Compiler);
 260          Create_Attribute
 261            (Name_Dependency_Kind, "ALI_File", "ada", Pkg => Compiler);
 262
 263          Naming := Create_Package (Project_Tree, Config_File, "naming");
 264          Create_Attribute (Name_Spec_Suffix, ".ads", "ada",     Pkg => Naming);
 265          Create_Attribute (Name_Separate_Suffix, ".adb", "ada", Pkg => Naming);
 266          Create_Attribute (Name_Body_Suffix, ".adb", "ada",     Pkg => Naming);
 267          Create_Attribute (Name_Dot_Replacement, "-",           Pkg => Naming);
 268          Create_Attribute (Name_Casing,          "lowercase",   Pkg => Naming);
 269
 270          if Current_Verbosity = High then
 271             Write_Line ("Automatically generated (in-memory) config file");
 272             Prj.PP.Pretty_Print
 273               (Project                => Config_File,
 274                In_Tree                => Project_Tree,
 275                Backward_Compatibility => False);
 276          end if;
 277       end if;
 278    end Add_Default_GNAT_Naming_Scheme;
 279
 280    -----------------------
 281    -- Apply_Config_File --
 282    -----------------------
 283
 284    procedure Apply_Config_File
 285      (Config_File  : Prj.Project_Id;
 286       Project_Tree : Prj.Project_Tree_Ref)
 287    is
 288       procedure Add_Attributes
 289         (Project_Tree : Project_Tree_Ref;
 290          Conf_Decl    : Declarations;
 291          User_Decl    : in out Declarations);
 292       --  Process the attributes in the config declarations.  For
 293       --  single string values, if the attribute is not declared in
 294       --  the user declarations, declare it with the value in the
 295       --  config declarations.  For string list values, prepend the
 296       --  value in the user declarations with the value in the config
 297       --  declarations.
 298
 299       --------------------
 300       -- Add_Attributes --
 301       --------------------
 302
 303       procedure Add_Attributes
 304         (Project_Tree : Project_Tree_Ref;
 305          Conf_Decl    : Declarations;
 306          User_Decl    : in out Declarations)
 307       is
 308          Shared             : constant Shared_Project_Tree_Data_Access :=
 309                                 Project_Tree.Shared;
 310          Conf_Attr_Id       : Variable_Id;
 311          Conf_Attr          : Variable;
 312          Conf_Array_Id      : Array_Id;
 313          Conf_Array         : Array_Data;
 314          Conf_Array_Elem_Id : Array_Element_Id;
 315          Conf_Array_Elem    : Array_Element;
 316          Conf_List          : String_List_Id;
 317          Conf_List_Elem     : String_Element;
 318
 319          User_Attr_Id       : Variable_Id;
 320          User_Attr          : Variable;
 321          User_Array_Id      : Array_Id;
 322          User_Array         : Array_Data;
 323          User_Array_Elem_Id : Array_Element_Id;
 324          User_Array_Elem    : Array_Element;
 325
 326       begin
 327          Conf_Attr_Id := Conf_Decl.Attributes;
 328          User_Attr_Id := User_Decl.Attributes;
 329
 330          while Conf_Attr_Id /= No_Variable loop
 331             Conf_Attr := Shared.Variable_Elements.Table (Conf_Attr_Id);
 332             User_Attr := Shared.Variable_Elements.Table (User_Attr_Id);
 333
 334             if not Conf_Attr.Value.Default then
 335                if User_Attr.Value.Default then
 336
 337                   --  No attribute declared in user project file: just copy
 338                   --  the value of the configuration attribute.
 339
 340                   User_Attr.Value := Conf_Attr.Value;
 341                   Shared.Variable_Elements.Table (User_Attr_Id) := User_Attr;
 342
 343                elsif User_Attr.Value.Kind = List
 344                  and then Conf_Attr.Value.Values /= Nil_String
 345                then
 346                   --  List attribute declared in both the user project and the
 347                   --  configuration project: prepend the user list with the
 348                   --  configuration list.
 349
 350                   declare
 351                      User_List : constant String_List_Id :=
 352                                    User_Attr.Value.Values;
 353                      Conf_List : String_List_Id := Conf_Attr.Value.Values;
 354                      Conf_Elem : String_Element;
 355                      New_List  : String_List_Id;
 356                      New_Elem  : String_Element;
 357
 358                   begin
 359                      --  Create new list
 360
 361                      String_Element_Table.Increment_Last
 362                        (Shared.String_Elements);
 363                      New_List :=
 364                        String_Element_Table.Last (Shared.String_Elements);
 365
 366                      --  Value of attribute is new list
 367
 368                      User_Attr.Value.Values := New_List;
 369                      Shared.Variable_Elements.Table (User_Attr_Id) :=
 370                        User_Attr;
 371
 372                      loop
 373                         --  Get each element of configuration list
 374
 375                         Conf_Elem := Shared.String_Elements.Table (Conf_List);
 376                         New_Elem  := Conf_Elem;
 377                         Conf_List := Conf_Elem.Next;
 378
 379                         if Conf_List = Nil_String then
 380
 381                            --  If it is the last element in the list, connect
 382                            --  to first element of user list, and we are done.
 383
 384                            New_Elem.Next := User_List;
 385                            Shared.String_Elements.Table (New_List) := New_Elem;
 386                            exit;
 387
 388                         else
 389                            --  If it is not the last element in the list, add
 390                            --  to new list.
 391
 392                            String_Element_Table.Increment_Last
 393                              (Shared.String_Elements);
 394                            New_Elem.Next := String_Element_Table.Last
 395                              (Shared.String_Elements);
 396                            Shared.String_Elements.Table (New_List) := New_Elem;
 397                            New_List := New_Elem.Next;
 398                         end if;
 399                      end loop;
 400                   end;
 401                end if;
 402             end if;
 403
 404             Conf_Attr_Id := Conf_Attr.Next;
 405             User_Attr_Id := User_Attr.Next;
 406          end loop;
 407
 408          Conf_Array_Id := Conf_Decl.Arrays;
 409          while Conf_Array_Id /= No_Array loop
 410             Conf_Array := Shared.Arrays.Table (Conf_Array_Id);
 411
 412             User_Array_Id := User_Decl.Arrays;
 413             while User_Array_Id /= No_Array loop
 414                User_Array := Shared.Arrays.Table (User_Array_Id);
 415                exit when User_Array.Name = Conf_Array.Name;
 416                User_Array_Id := User_Array.Next;
 417             end loop;
 418
 419             --  If this associative array does not exist in the user project
 420             --  file, do a shallow copy of the full associative array.
 421
 422             if User_Array_Id = No_Array then
 423                Array_Table.Increment_Last (Shared.Arrays);
 424                User_Array := Conf_Array;
 425                User_Array.Next := User_Decl.Arrays;
 426                User_Decl.Arrays := Array_Table.Last (Shared.Arrays);
 427                Shared.Arrays.Table (User_Decl.Arrays) := User_Array;
 428
 429             --  Otherwise, check each array element
 430
 431             else
 432                Conf_Array_Elem_Id := Conf_Array.Value;
 433                while Conf_Array_Elem_Id /= No_Array_Element loop
 434                   Conf_Array_Elem :=
 435                     Shared.Array_Elements.Table (Conf_Array_Elem_Id);
 436
 437                   User_Array_Elem_Id := User_Array.Value;
 438                   while User_Array_Elem_Id /= No_Array_Element loop
 439                      User_Array_Elem :=
 440                        Shared.Array_Elements.Table (User_Array_Elem_Id);
 441                      exit when User_Array_Elem.Index = Conf_Array_Elem.Index;
 442                      User_Array_Elem_Id := User_Array_Elem.Next;
 443                   end loop;
 444
 445                   --  If the array element doesn't exist in the user array,
 446                   --  insert a shallow copy of the conf array element in the
 447                   --  user array.
 448
 449                   if User_Array_Elem_Id = No_Array_Element then
 450                      Array_Element_Table.Increment_Last
 451                        (Shared.Array_Elements);
 452                      User_Array_Elem := Conf_Array_Elem;
 453                      User_Array_Elem.Next := User_Array.Value;
 454                      User_Array.Value :=
 455                        Array_Element_Table.Last (Shared.Array_Elements);
 456                      Shared.Array_Elements.Table (User_Array.Value) :=
 457                        User_Array_Elem;
 458                      Shared.Arrays.Table (User_Array_Id) := User_Array;
 459
 460                   --  Otherwise, if the value is a string list, prepend the
 461                   --  conf array element value to the array element.
 462
 463                   elsif Conf_Array_Elem.Value.Kind = List then
 464                      Conf_List := Conf_Array_Elem.Value.Values;
 465
 466                      if Conf_List /= Nil_String then
 467                         declare
 468                            Link     : constant String_List_Id :=
 469                                         User_Array_Elem.Value.Values;
 470                            Previous : String_List_Id := Nil_String;
 471                            Next     : String_List_Id;
 472
 473                         begin
 474                            loop
 475                               Conf_List_Elem :=
 476                                 Shared.String_Elements.Table (Conf_List);
 477                               String_Element_Table.Increment_Last
 478                                 (Shared.String_Elements);
 479                               Next :=
 480                                 String_Element_Table.Last
 481                                 (Shared.String_Elements);
 482                               Shared.String_Elements.Table (Next) :=
 483                                 Conf_List_Elem;
 484
 485                               if Previous = Nil_String then
 486                                  User_Array_Elem.Value.Values := Next;
 487                                  Shared.Array_Elements.Table
 488                                    (User_Array_Elem_Id) := User_Array_Elem;
 489
 490                               else
 491                                  Shared.String_Elements.Table
 492                                    (Previous).Next := Next;
 493                               end if;
 494
 495                               Previous := Next;
 496
 497                               Conf_List := Conf_List_Elem.Next;
 498
 499                               if Conf_List = Nil_String then
 500                                  Shared.String_Elements.Table
 501                                    (Previous).Next := Link;
 502                                  exit;
 503                               end if;
 504                            end loop;
 505                         end;
 506                      end if;
 507                   end if;
 508
 509                   Conf_Array_Elem_Id := Conf_Array_Elem.Next;
 510                end loop;
 511             end if;
 512
 513             Conf_Array_Id := Conf_Array.Next;
 514          end loop;
 515       end Add_Attributes;
 516
 517       Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
 518
 519       Conf_Decl    : constant Declarations := Config_File.Decl;
 520       Conf_Pack_Id : Package_Id;
 521       Conf_Pack    : Package_Element;
 522
 523       User_Decl    : Declarations;
 524       User_Pack_Id : Package_Id;
 525       User_Pack    : Package_Element;
 526       Proj         : Project_List;
 527
 528    begin
 529       Debug_Output ("Applying config file to a project tree");
 530
 531       Proj := Project_Tree.Projects;
 532       while Proj /= null loop
 533          if Proj.Project /= Config_File then
 534             User_Decl := Proj.Project.Decl;
 535             Add_Attributes
 536               (Project_Tree => Project_Tree,
 537                Conf_Decl    => Conf_Decl,
 538                User_Decl    => User_Decl);
 539
 540             Conf_Pack_Id := Conf_Decl.Packages;
 541             while Conf_Pack_Id /= No_Package loop
 542                Conf_Pack := Shared.Packages.Table (Conf_Pack_Id);
 543
 544                User_Pack_Id := User_Decl.Packages;
 545                while User_Pack_Id /= No_Package loop
 546                   User_Pack := Shared.Packages.Table (User_Pack_Id);
 547                   exit when User_Pack.Name = Conf_Pack.Name;
 548                   User_Pack_Id := User_Pack.Next;
 549                end loop;
 550
 551                if User_Pack_Id = No_Package then
 552                   Package_Table.Increment_Last (Shared.Packages);
 553                   User_Pack := Conf_Pack;
 554                   User_Pack.Next := User_Decl.Packages;
 555                   User_Decl.Packages := Package_Table.Last (Shared.Packages);
 556                   Shared.Packages.Table (User_Decl.Packages) := User_Pack;
 557
 558                else
 559                   Add_Attributes
 560                     (Project_Tree => Project_Tree,
 561                      Conf_Decl    => Conf_Pack.Decl,
 562                      User_Decl    => Shared.Packages.Table
 563                                        (User_Pack_Id).Decl);
 564                end if;
 565
 566                Conf_Pack_Id := Conf_Pack.Next;
 567             end loop;
 568
 569             Proj.Project.Decl := User_Decl;
 570
 571             --  For aggregate projects, we need to apply the config to all
 572             --  their aggregated trees as well.
 573
 574             if Proj.Project.Qualifier in Aggregate_Project then
 575                declare
 576                   List : Aggregated_Project_List;
 577                begin
 578                   List := Proj.Project.Aggregated_Projects;
 579                   while List /= null loop
 580                      Debug_Output
 581                        ("Recursively apply config to aggregated tree",
 582                         List.Project.Name);
 583                      Apply_Config_File
 584                        (Config_File, Project_Tree => List.Tree);
 585                      List := List.Next;
 586                   end loop;
 587                end;
 588             end if;
 589          end if;
 590
 591          Proj := Proj.Next;
 592       end loop;
 593    end Apply_Config_File;
 594
 595    ------------------
 596    -- Check_Target --
 597    ------------------
 598
 599    function Check_Target
 600      (Config_File        : Project_Id;
 601       Autoconf_Specified : Boolean;
 602       Project_Tree       : Prj.Project_Tree_Ref;
 603       Target             : String := "") return Boolean
 604    is
 605       Shared   : constant Shared_Project_Tree_Data_Access :=
 606                    Project_Tree.Shared;
 607       Variable : constant Variable_Value :=
 608                    Value_Of
 609                      (Name_Target, Config_File.Decl.Attributes, Shared);
 610       Tgt_Name : Name_Id := No_Name;
 611       OK       : Boolean;
 612
 613    begin
 614       if Variable /= Nil_Variable_Value and then not Variable.Default then
 615          Tgt_Name := Variable.Value;
 616       end if;
 617
 618       OK :=
 619         Target = ""
 620           or else
 621             (Tgt_Name /= No_Name
 622               and then (Length_Of_Name (Tgt_Name) = 0
 623                          or else Target = Get_Name_String (Tgt_Name)));
 624
 625       if not OK then
 626          if Autoconf_Specified then
 627             if Verbose_Mode then
 628                Write_Line ("inconsistent targets, performing autoconf");
 629             end if;
 630
 631             return False;
 632
 633          else
 634             if Tgt_Name /= No_Name then
 635                Raise_Invalid_Config
 636                  ("mismatched targets: """
 637                   & Get_Name_String (Tgt_Name) & """ in configuration, """
 638                   & Target & """ specified");
 639             else
 640                Raise_Invalid_Config
 641                  ("no target specified in configuration file");
 642             end if;
 643          end if;
 644       end if;
 645
 646       return True;
 647    end Check_Target;
 648
 649    --------------------------------------
 650    -- Get_Or_Create_Configuration_File --
 651    --------------------------------------
 652
 653    procedure Get_Or_Create_Configuration_File
 654      (Project                    : Project_Id;
 655       Conf_Project               : Project_Id;
 656       Project_Tree               : Project_Tree_Ref;
 657       Project_Node_Tree          : Prj.Tree.Project_Node_Tree_Ref;
 658       Env                        : in out Prj.Tree.Environment;
 659       Allow_Automatic_Generation : Boolean;
 660       Config_File_Name           : String := "";
 661       Autoconf_Specified         : Boolean;
 662       Target_Name                : String := "";
 663       Normalized_Hostname        : String;
 664       Packages_To_Check          : String_List_Access := null;
 665       Config                     : out Prj.Project_Id;
 666       Config_File_Path           : out String_Access;
 667       Automatically_Generated    : out Boolean;
 668       On_Load_Config             : Config_File_Hook := null)
 669    is
 670       Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
 671
 672       At_Least_One_Compiler_Command : Boolean := False;
 673       --  Set to True if at least one attribute Ide'Compiler_Command is
 674       --  specified for one language of the system.
 675
 676       Conf_File_Name : String_Access := new String'(Config_File_Name);
 677       --  The configuration project file name. May be modified if there are
 678       --  switches --config= in the Builder package of the main project.
 679
 680       Selected_Target : String_Access := new String'(Target_Name);
 681
 682       function Default_File_Name return String;
 683       --  Return the name of the default config file that should be tested
 684
 685       procedure Do_Autoconf;
 686       --  Generate a new config file through gprconfig. In case of error, this
 687       --  raises the Invalid_Config exception with an appropriate message
 688
 689       procedure Check_Builder_Switches;
 690       --  Check for switches --config and --RTS in package Builder
 691
 692       procedure Get_Project_Target;
 693       --  If Target_Name is empty, get the specified target in the project
 694       --  file, if any.
 695
 696       procedure Get_Project_Runtimes;
 697       --  Get the various Runtime (<lang>) in the project file or any project
 698       --  it extends, if any are specified.
 699
 700       function Get_Config_Switches return Argument_List_Access;
 701       --  Return the --config switches to use for gprconfig
 702
 703       function Get_Db_Switches return Argument_List_Access;
 704       --  Return the --db switches to use for gprconfig
 705
 706       function Might_Have_Sources (Project : Project_Id) return Boolean;
 707       --  True if the specified project might have sources (ie the user has not
 708       --  explicitly specified it. We haven't checked the file system, nor do
 709       --  we need to at this stage.
 710
 711       ----------------------------
 712       -- Check_Builder_Switches --
 713       ----------------------------
 714
 715       procedure Check_Builder_Switches is
 716          Get_RTS_Switches : constant Boolean :=
 717                               RTS_Languages.Get_First = No_Name;
 718          --  If no switch --RTS have been specified on the command line, look
 719          --  for --RTS switches in the Builder switches.
 720
 721          Builder : constant Package_Id :=
 722                      Value_Of (Name_Builder, Project.Decl.Packages, Shared);
 723
 724          Switch_Array_Id : Array_Element_Id;
 725          --  The Switches to be checked
 726
 727          procedure Check_Switches;
 728          --  Check the switches in Switch_Array_Id
 729
 730          --------------------
 731          -- Check_Switches --
 732          --------------------
 733
 734          procedure Check_Switches is
 735             Switch_Array    : Array_Element;
 736             Switch_List     : String_List_Id := Nil_String;
 737             Switch          : String_Element;
 738             Lang            : Name_Id;
 739             Lang_Last       : Positive;
 740
 741          begin
 742             while Switch_Array_Id /= No_Array_Element loop
 743                Switch_Array :=
 744                  Shared.Array_Elements.Table (Switch_Array_Id);
 745
 746                Switch_List := Switch_Array.Value.Values;
 747                List_Loop : while Switch_List /= Nil_String loop
 748                   Switch := Shared.String_Elements.Table (Switch_List);
 749
 750                   if Switch.Value /= No_Name then
 751                      Get_Name_String (Switch.Value);
 752
 753                      if Conf_File_Name'Length = 0
 754                        and then Name_Len > 9
 755                        and then Name_Buffer (1 .. 9) = "--config="
 756                      then
 757                         Conf_File_Name :=
 758                           new String'(Name_Buffer (10 .. Name_Len));
 759
 760                      elsif Get_RTS_Switches
 761                        and then Name_Len >= 7
 762                        and then Name_Buffer (1 .. 5) = "--RTS"
 763                      then
 764                         if Name_Buffer (6) = '=' then
 765                            if not Runtime_Name_Set_For (Name_Ada) then
 766                               Set_Runtime_For
 767                                 (Name_Ada,
 768                                  Name_Buffer (7 .. Name_Len));
 769                            end if;
 770
 771                         elsif Name_Len > 7
 772                           and then Name_Buffer (6) = ':'
 773                           and then Name_Buffer (7) /= '='
 774                         then
 775                            Lang_Last := 7;
 776                            while Lang_Last < Name_Len
 777                              and then Name_Buffer (Lang_Last + 1) /= '='
 778                            loop
 779                               Lang_Last := Lang_Last + 1;
 780                            end loop;
 781
 782                            if Name_Buffer (Lang_Last + 1) = '=' then
 783                               declare
 784                                  RTS : constant String :=
 785                                    Name_Buffer (Lang_Last + 2 .. Name_Len);
 786                               begin
 787                                  Name_Buffer (1 .. Lang_Last - 6) :=
 788                                    Name_Buffer (7 .. Lang_Last);
 789                                  Name_Len := Lang_Last - 6;
 790                                  To_Lower (Name_Buffer (1 .. Name_Len));
 791                                  Lang := Name_Find;
 792
 793                                  if not Runtime_Name_Set_For (Lang) then
 794                                     Set_Runtime_For (Lang, RTS);
 795                                  end if;
 796                               end;
 797                            end if;
 798                         end if;
 799                      end if;
 800                   end if;
 801
 802                   Switch_List := Switch.Next;
 803                end loop List_Loop;
 804
 805                Switch_Array_Id := Switch_Array.Next;
 806             end loop;
 807          end Check_Switches;
 808
 809       --  Start of processing for Check_Builder_Switches
 810
 811       begin
 812          if Builder /= No_Package then
 813             Switch_Array_Id :=
 814               Value_Of
 815                 (Name      => Name_Switches,
 816                  In_Arrays => Shared.Packages.Table (Builder).Decl.Arrays,
 817                  Shared    => Shared);
 818             Check_Switches;
 819
 820             Switch_Array_Id :=
 821               Value_Of
 822                 (Name      => Name_Default_Switches,
 823                  In_Arrays => Shared.Packages.Table (Builder).Decl.Arrays,
 824                  Shared    => Shared);
 825             Check_Switches;
 826          end if;
 827       end Check_Builder_Switches;
 828
 829       ------------------------
 830       -- Get_Project_Target --
 831       ------------------------
 832
 833       procedure Get_Project_Target is
 834       begin
 835          if Selected_Target'Length = 0 then
 836
 837             --  Check if attribute Target is specified in the main
 838             --  project, or in a project it extends. If it is, use this
 839             --  target to invoke gprconfig.
 840
 841             declare
 842                Variable : Variable_Value;
 843                Proj     : Project_Id;
 844                Tgt_Name : Name_Id := No_Name;
 845
 846             begin
 847                Proj := Project;
 848                Project_Loop :
 849                while Proj /= No_Project loop
 850                   Variable :=
 851                     Value_Of (Name_Target, Proj.Decl.Attributes, Shared);
 852
 853                   if Variable /= Nil_Variable_Value
 854                     and then not Variable.Default
 855                     and then Variable.Value /= No_Name
 856                   then
 857                      Tgt_Name := Variable.Value;
 858                      exit Project_Loop;
 859                   end if;
 860
 861                   Proj := Proj.Extends;
 862                end loop Project_Loop;
 863
 864                if Tgt_Name /= No_Name then
 865                   Selected_Target := new String'(Get_Name_String (Tgt_Name));
 866                end if;
 867             end;
 868          end if;
 869       end Get_Project_Target;
 870
 871       --------------------------
 872       -- Get_Project_Runtimes --
 873       --------------------------
 874
 875       procedure Get_Project_Runtimes is
 876          Element : Array_Element;
 877          Id      : Array_Element_Id;
 878          Lang    : Name_Id;
 879          Proj    : Project_Id;
 880
 881       begin
 882          Proj := Project;
 883          while Proj /= No_Project loop
 884             Id := Value_Of (Name_Runtime, Proj.Decl.Arrays, Shared);
 885             while Id /= No_Array_Element loop
 886                Element := Shared.Array_Elements.Table (Id);
 887                Lang := Element.Index;
 888
 889                if not Runtime_Name_Set_For (Lang) then
 890                   Set_Runtime_For
 891                     (Lang, RTS_Name => Get_Name_String (Element.Value.Value));
 892                end if;
 893
 894                Id := Element.Next;
 895             end loop;
 896
 897             Proj := Proj.Extends;
 898          end loop;
 899       end Get_Project_Runtimes;
 900
 901       -----------------------
 902       -- Default_File_Name --
 903       -----------------------
 904
 905       function Default_File_Name return String is
 906          Ada_RTS : constant String := Runtime_Name_For (Name_Ada);
 907          Tmp     : String_Access;
 908
 909       begin
 910          if Selected_Target'Length /= 0 then
 911             if Ada_RTS /= "" then
 912                return
 913                  Selected_Target.all & '-' &
 914                  Ada_RTS & Config_Project_File_Extension;
 915             else
 916                return
 917                  Selected_Target.all & Config_Project_File_Extension;
 918             end if;
 919
 920          elsif Ada_RTS /= "" then
 921             return Ada_RTS & Config_Project_File_Extension;
 922
 923          else
 924             Tmp := Getenv (Config_Project_Env_Var);
 925
 926             declare
 927                T : constant String := Tmp.all;
 928
 929             begin
 930                Free (Tmp);
 931
 932                if T'Length = 0 then
 933                   return Default_Config_Name;
 934                else
 935                   return T;
 936                end if;
 937             end;
 938          end if;
 939       end Default_File_Name;
 940
 941       -----------------
 942       -- Do_Autoconf --
 943       -----------------
 944
 945       procedure Do_Autoconf is
 946          Obj_Dir : constant Variable_Value :=
 947                      Value_Of
 948                        (Name_Object_Dir,
 949                         Conf_Project.Decl.Attributes,
 950                         Shared);
 951
 952          Gprconfig_Path  : String_Access;
 953          Success         : Boolean;
 954
 955       begin
 956          Gprconfig_Path := Locate_Exec_On_Path (Gprconfig_Name);
 957
 958          if Gprconfig_Path = null then
 959             Raise_Invalid_Config
 960               ("could not locate gprconfig for auto-configuration");
 961          end if;
 962
 963          --  First, find the object directory of the Conf_Project
 964
 965          --  If the object directory is a relative one and Build_Tree_Dir is
 966          --  set, first add it.
 967
 968          Name_Len := 0;
 969
 970          if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then
 971
 972             if Build_Tree_Dir /= null then
 973                Add_Str_To_Name_Buffer (Build_Tree_Dir.all);
 974
 975                if Get_Name_String (Conf_Project.Directory.Display_Name)'Length
 976                                                          < Root_Dir'Length
 977                then
 978                   Raise_Invalid_Config
 979                     ("cannot relocate deeper than object directory");
 980                end if;
 981
 982                Add_Str_To_Name_Buffer
 983                  (Relative_Path
 984                     (Get_Name_String (Conf_Project.Directory.Display_Name),
 985                      Root_Dir.all));
 986             else
 987                Get_Name_String (Conf_Project.Directory.Display_Name);
 988             end if;
 989
 990          else
 991             if Is_Absolute_Path (Get_Name_String (Obj_Dir.Value)) then
 992                Get_Name_String (Obj_Dir.Value);
 993
 994             else
 995                if Build_Tree_Dir /= null then
 996                   if Get_Name_String
 997                     (Conf_Project.Directory.Display_Name)'Length <
 998                                                           Root_Dir'Length
 999                   then
1000                      Raise_Invalid_Config
1001                        ("cannot relocate deeper than object directory");
1002                   end if;
1003
1004                   Add_Str_To_Name_Buffer (Build_Tree_Dir.all);
1005                   Add_Str_To_Name_Buffer
1006                     (Relative_Path
1007                        (Get_Name_String (Conf_Project.Directory.Display_Name),
1008                         Root_Dir.all));
1009                else
1010                   Add_Str_To_Name_Buffer
1011                     (Get_Name_String (Conf_Project.Directory.Display_Name));
1012                end if;
1013
1014                Add_Str_To_Name_Buffer (Get_Name_String (Obj_Dir.Value));
1015             end if;
1016          end if;
1017
1018          if Subdirs /= null then
1019             Add_Char_To_Name_Buffer (Directory_Separator);
1020             Add_Str_To_Name_Buffer (Subdirs.all);
1021          end if;
1022
1023          for J in 1 .. Name_Len loop
1024             if Name_Buffer (J) = '/' then
1025                Name_Buffer (J) := Directory_Separator;
1026             end if;
1027          end loop;
1028
1029          --  Make sure that Obj_Dir ends with a directory separator
1030
1031          if Name_Buffer (Name_Len) /= Directory_Separator then
1032             Name_Len := Name_Len + 1;
1033             Name_Buffer (Name_Len) := Directory_Separator;
1034          end if;
1035
1036          declare
1037             Obj_Dir         : constant String := Name_Buffer (1 .. Name_Len);
1038             Config_Switches : Argument_List_Access;
1039             Db_Switches     : Argument_List_Access;
1040             Args            : Argument_List (1 .. 5);
1041             Arg_Last        : Positive;
1042             Obj_Dir_Exists  : Boolean := True;
1043
1044          begin
1045             --  Check if the object directory exists. If Setup_Projects is True
1046             --  (-p) and directory does not exist, attempt to create it.
1047             --  Otherwise, if directory does not exist, fail without calling
1048             --  gprconfig.
1049
1050             if not Is_Directory (Obj_Dir)
1051               and then (Setup_Projects or else Subdirs /= null)
1052             then
1053                begin
1054                   Create_Path (Obj_Dir);
1055
1056                   if not Quiet_Output then
1057                      Write_Str ("object directory """);
1058                      Write_Str (Obj_Dir);
1059                      Write_Line (""" created");
1060                   end if;
1061
1062                exception
1063                   when others =>
1064                      Raise_Invalid_Config
1065                        ("could not create object directory " & Obj_Dir);
1066                end;
1067             end if;
1068
1069             if not Is_Directory (Obj_Dir) then
1070                case Env.Flags.Require_Obj_Dirs is
1071                   when Error =>
1072                      Raise_Invalid_Config
1073                        ("object directory " & Obj_Dir & " does not exist");
1074
1075                   when Warning =>
1076                      Prj.Err.Error_Msg
1077                        (Env.Flags,
1078                         "?object directory " & Obj_Dir & " does not exist");
1079                      Obj_Dir_Exists := False;
1080
1081                   when Silent =>
1082                      null;
1083                end case;
1084             end if;
1085
1086             --  Get the config switches. This should be done only now, as some
1087             --  runtimes may have been found in the Builder switches.
1088
1089             Config_Switches := Get_Config_Switches;
1090
1091             --  Get eventual --db switches
1092
1093             Db_Switches := Get_Db_Switches;
1094
1095             --  Invoke gprconfig
1096
1097             Args (1) := new String'("--batch");
1098             Args (2) := new String'("-o");
1099
1100             --  If no config file was specified, set the auto.cgpr one
1101
1102             if Conf_File_Name'Length = 0 then
1103                if Obj_Dir_Exists then
1104                   Args (3) := new String'(Obj_Dir & Auto_Cgpr);
1105
1106                else
1107                   declare
1108                      Path_FD   : File_Descriptor;
1109                      Path_Name : Path_Name_Type;
1110
1111                   begin
1112                      Prj.Env.Create_Temp_File
1113                        (Shared    => Project_Tree.Shared,
1114                         Path_FD   => Path_FD,
1115                         Path_Name => Path_Name,
1116                         File_Use  => "configuration file");
1117
1118                      if Path_FD /= Invalid_FD then
1119                         declare
1120                            Temp_Dir : constant String :=
1121                                         Containing_Directory
1122                                           (Get_Name_String (Path_Name));
1123                         begin
1124                            GNAT.OS_Lib.Close (Path_FD);
1125                            Args (3) :=
1126                              new String'(Temp_Dir &
1127                                          Directory_Separator &
1128                                          Auto_Cgpr);
1129                            Delete_File (Get_Name_String (Path_Name));
1130                         end;
1131
1132                      else
1133                         --  We'll have an error message later on
1134
1135                         Args (3) := new String'(Obj_Dir & Auto_Cgpr);
1136                      end if;
1137                   end;
1138                end if;
1139             else
1140                Args (3) := Conf_File_Name;
1141             end if;
1142
1143             Arg_Last := 3;
1144
1145             if Selected_Target /= null and then
1146                Selected_Target.all /= ""
1147
1148             then
1149                Args (4) :=
1150                   new String'("--target=" & Selected_Target.all);
1151                Arg_Last := 4;
1152
1153             elsif Normalized_Hostname /= "" then
1154                if At_Least_One_Compiler_Command then
1155                   Args (4) := new String'("--target=all");
1156                else
1157                   Args (4) := new String'("--target=" & Normalized_Hostname);
1158                end if;
1159
1160                Arg_Last := 4;
1161             end if;
1162
1163             if not Verbose_Mode then
1164                Arg_Last := Arg_Last + 1;
1165                Args (Arg_Last) := new String'("-q");
1166             end if;
1167
1168             if Verbose_Mode then
1169                Write_Str (Gprconfig_Name);
1170
1171                for J in 1 .. Arg_Last loop
1172                   Write_Char (' ');
1173                   Write_Str (Args (J).all);
1174                end loop;
1175
1176                for J in Config_Switches'Range loop
1177                   Write_Char (' ');
1178                   Write_Str (Config_Switches (J).all);
1179                end loop;
1180
1181                for J in Db_Switches'Range loop
1182                   Write_Char (' ');
1183                   Write_Str (Db_Switches (J).all);
1184                end loop;
1185
1186                Write_Eol;
1187
1188             elsif not Quiet_Output then
1189
1190                --  Display no message if we are creating auto.cgpr, unless in
1191                --  verbose mode.
1192
1193                if Config_File_Name'Length > 0 or else Verbose_Mode then
1194                   Write_Str ("creating ");
1195                   Write_Str (Simple_Name (Args (3).all));
1196                   Write_Eol;
1197                end if;
1198             end if;
1199
1200             Spawn (Gprconfig_Path.all, Args (1 .. Arg_Last) &
1201                    Config_Switches.all & Db_Switches.all,
1202                    Success);
1203
1204             Free (Config_Switches);
1205
1206             Config_File_Path := Locate_Config_File (Args (3).all);
1207
1208             if Config_File_Path = null then
1209                Raise_Invalid_Config
1210                  ("could not create " & Args (3).all);
1211             end if;
1212
1213             for F in Args'Range loop
1214                Free (Args (F));
1215             end loop;
1216          end;
1217       end Do_Autoconf;
1218
1219       ---------------------
1220       -- Get_Db_Switches --
1221       ---------------------
1222
1223       function Get_Db_Switches return Argument_List_Access is
1224          Result : Argument_List_Access;
1225          Nmb_Arg : Natural;
1226       begin
1227          Nmb_Arg :=
1228            (2 * Db_Switch_Args.Last) + Boolean'Pos (not Load_Standard_Base);
1229          Result := new Argument_List (1 .. Nmb_Arg);
1230
1231          if Nmb_Arg /= 0 then
1232             for J in 1 .. Db_Switch_Args.Last loop
1233                Result (2 * J - 1) :=
1234                  new String'("--db");
1235                Result (2 * J) :=
1236                  new String'(Get_Name_String (Db_Switch_Args.Table (J)));
1237             end loop;
1238
1239             if not Load_Standard_Base then
1240                Result (Result'Last) := new String'("--db-");
1241             end if;
1242          end if;
1243
1244          return Result;
1245       end Get_Db_Switches;
1246
1247       -------------------------
1248       -- Get_Config_Switches --
1249       -------------------------
1250
1251       function Get_Config_Switches return Argument_List_Access is
1252
1253          package Language_Htable is new GNAT.HTable.Simple_HTable
1254            (Header_Num => Prj.Header_Num,
1255             Element    => Name_Id,
1256             No_Element => No_Name,
1257             Key        => Name_Id,
1258             Hash       => Prj.Hash,
1259             Equal      => "=");
1260          --  Hash table to keep the languages used in the project tree
1261
1262          IDE : constant Package_Id :=
1263                  Value_Of (Name_Ide, Project.Decl.Packages, Shared);
1264
1265          procedure Add_Config_Switches_For_Project
1266            (Project    : Project_Id;
1267             Tree       : Project_Tree_Ref;
1268             With_State : in out Integer);
1269          --  Add all --config switches for this project. This is also called
1270          --  for aggregate projects.
1271
1272          -------------------------------------
1273          -- Add_Config_Switches_For_Project --
1274          -------------------------------------
1275
1276          procedure Add_Config_Switches_For_Project
1277            (Project    : Project_Id;
1278             Tree       : Project_Tree_Ref;
1279             With_State : in out Integer)
1280          is
1281             pragma Unreferenced (With_State);
1282
1283             Shared : constant Shared_Project_Tree_Data_Access := Tree.Shared;
1284
1285             Variable      : Variable_Value;
1286             Check_Default : Boolean;
1287             Lang          : Name_Id;
1288             List          : String_List_Id;
1289             Elem          : String_Element;
1290
1291          begin
1292             if Might_Have_Sources (Project) then
1293                Variable :=
1294                  Value_Of (Name_Languages, Project.Decl.Attributes, Shared);
1295
1296                if Variable = Nil_Variable_Value or else Variable.Default then
1297
1298                   --  Languages is not declared. If it is not an extending
1299                   --  project, or if it extends a project with no Languages,
1300                   --  check for Default_Language.
1301
1302                   Check_Default := Project.Extends = No_Project;
1303
1304                   if not Check_Default then
1305                      Variable :=
1306                        Value_Of
1307                          (Name_Languages,
1308                           Project.Extends.Decl.Attributes,
1309                           Shared);
1310                      Check_Default :=
1311                        Variable /= Nil_Variable_Value
1312                          and then Variable.Values = Nil_String;
1313                   end if;
1314
1315                   if Check_Default then
1316                      Variable :=
1317                        Value_Of
1318                          (Name_Default_Language,
1319                           Project.Decl.Attributes,
1320                           Shared);
1321
1322                      if Variable /= Nil_Variable_Value
1323                        and then not Variable.Default
1324                      then
1325                         Get_Name_String (Variable.Value);
1326                         To_Lower (Name_Buffer (1 .. Name_Len));
1327                         Lang := Name_Find;
1328                         Language_Htable.Set (Lang, Lang);
1329
1330                      --  If no default language is declared, default to Ada
1331
1332                      else
1333                         Language_Htable.Set (Name_Ada, Name_Ada);
1334                      end if;
1335                   end if;
1336
1337                elsif Variable.Values /= Nil_String then
1338
1339                   --  Attribute Languages is declared with a non empty list:
1340                   --  put all the languages in Language_HTable.
1341
1342                   List := Variable.Values;
1343                   while List /= Nil_String loop
1344                      Elem := Shared.String_Elements.Table (List);
1345
1346                      Get_Name_String (Elem.Value);
1347                      To_Lower (Name_Buffer (1 .. Name_Len));
1348                      Lang := Name_Find;
1349                      Language_Htable.Set (Lang, Lang);
1350
1351                      List := Elem.Next;
1352                   end loop;
1353                end if;
1354             end if;
1355          end Add_Config_Switches_For_Project;
1356
1357          procedure For_Every_Imported_Project is new For_Every_Project_Imported
1358            (State => Integer, Action => Add_Config_Switches_For_Project);
1359          --  Document this procedure ???
1360
1361          --  Local variables
1362
1363          Name     : Name_Id;
1364          Count    : Natural;
1365          Result   : Argument_List_Access;
1366          Variable : Variable_Value;
1367          Dummy    : Integer := 0;
1368
1369       --  Start of processing for Get_Config_Switches
1370
1371       begin
1372          For_Every_Imported_Project
1373            (By                 => Project,
1374             Tree               => Project_Tree,
1375             With_State         => Dummy,
1376             Include_Aggregated => True);
1377
1378          Name  := Language_Htable.Get_First;
1379          Count := 0;
1380          while Name /= No_Name loop
1381             Count := Count + 1;
1382             Name := Language_Htable.Get_Next;
1383          end loop;
1384
1385          Result := new String_List (1 .. Count);
1386
1387          Count := 1;
1388          Name  := Language_Htable.Get_First;
1389          while Name /= No_Name loop
1390
1391             --  Check if IDE'Compiler_Command is declared for the language.
1392             --  If it is, use its value to invoke gprconfig.
1393
1394             Variable :=
1395               Value_Of
1396                 (Name,
1397                  Attribute_Or_Array_Name => Name_Compiler_Command,
1398                  In_Package              => IDE,
1399                  Shared                  => Shared,
1400                  Force_Lower_Case_Index  => True);
1401
1402             declare
1403                Config_Command : constant String :=
1404                                   "--config=" & Get_Name_String (Name);
1405
1406                Runtime_Name : constant String := Runtime_Name_For (Name);
1407
1408             begin
1409                --  In CodePeer mode, we do not take into account any compiler
1410                --  command from the package IDE.
1411
1412                if CodePeer_Mode
1413                  or else Variable = Nil_Variable_Value
1414                  or else Length_Of_Name (Variable.Value) = 0
1415                then
1416                   Result (Count) :=
1417                     new String'(Config_Command & ",," & Runtime_Name);
1418
1419                else
1420                   At_Least_One_Compiler_Command := True;
1421
1422                   declare
1423                      Compiler_Command : constant String :=
1424                                           Get_Name_String (Variable.Value);
1425
1426                   begin
1427                      if Is_Absolute_Path (Compiler_Command) then
1428                         Result (Count) :=
1429                           new String'
1430                             (Config_Command & ",," & Runtime_Name & ","
1431                              & Containing_Directory (Compiler_Command) & ","
1432                              & Simple_Name (Compiler_Command));
1433                      else
1434                         Result (Count) :=
1435                           new String'
1436                             (Config_Command & ",," & Runtime_Name & ",,"
1437                              & Compiler_Command);
1438                      end if;
1439                   end;
1440                end if;
1441             end;
1442
1443             Count := Count + 1;
1444             Name  := Language_Htable.Get_Next;
1445          end loop;
1446
1447          return Result;
1448       end Get_Config_Switches;
1449
1450       ------------------------
1451       -- Might_Have_Sources --
1452       ------------------------
1453
1454       function Might_Have_Sources (Project : Project_Id) return Boolean is
1455          Variable : Variable_Value;
1456
1457       begin
1458          Variable :=
1459            Value_Of (Name_Source_Dirs, Project.Decl.Attributes, Shared);
1460
1461          if Variable = Nil_Variable_Value
1462            or else Variable.Default
1463            or else Variable.Values /= Nil_String
1464          then
1465             Variable :=
1466               Value_Of (Name_Source_Files, Project.Decl.Attributes, Shared);
1467             return Variable = Nil_Variable_Value
1468               or else Variable.Default
1469               or else Variable.Values /= Nil_String;
1470
1471          else
1472             return False;
1473          end if;
1474       end Might_Have_Sources;
1475
1476       --  Local Variables
1477
1478       Success             : Boolean;
1479       Config_Project_Node : Project_Node_Id := Empty_Node;
1480
1481    --  Start of processing for Get_Or_Create_Configuration_File
1482
1483    begin
1484       pragma Assert (Prj.Env.Is_Initialized (Env.Project_Path));
1485
1486       Free (Config_File_Path);
1487       Config := No_Project;
1488
1489       Get_Project_Target;
1490       Get_Project_Runtimes;
1491       Check_Builder_Switches;
1492
1493       --  Do not attempt to find a configuration project file when
1494       --  Config_File_Name is No_Configuration_File.
1495
1496       if Config_File_Name = No_Configuration_File then
1497          Config_File_Path := null;
1498
1499       else
1500          if Conf_File_Name'Length > 0 then
1501             Config_File_Path := Locate_Config_File (Conf_File_Name.all);
1502          else
1503             Config_File_Path := Locate_Config_File (Default_File_Name);
1504          end if;
1505
1506          if Config_File_Path = null then
1507             if not Allow_Automatic_Generation
1508               and then Conf_File_Name'Length > 0
1509             then
1510                Raise_Invalid_Config
1511                  ("could not locate main configuration project "
1512                   & Conf_File_Name.all);
1513             end if;
1514          end if;
1515       end if;
1516
1517       Automatically_Generated :=
1518         Allow_Automatic_Generation and then Config_File_Path = null;
1519
1520       <<Process_Config_File>>
1521
1522       if Automatically_Generated then
1523
1524          --  This might raise an Invalid_Config exception
1525
1526          Do_Autoconf;
1527
1528       --  If the config file is not auto-generated, warn if there is any --RTS
1529       --  switch, but not when the config file is generated in memory.
1530
1531       elsif Warn_For_RTS
1532         and then RTS_Languages.Get_First /= No_Name
1533         and then Opt.Warning_Mode /= Opt.Suppress
1534         and then On_Load_Config = null
1535       then
1536          Write_Line
1537            ("warning: " &
1538               "runtimes are taken into account only in auto-configuration");
1539       end if;
1540
1541       --  Parse the configuration file
1542
1543       if Verbose_Mode and then Config_File_Path /= null then
1544          Write_Str  ("Checking configuration ");
1545          Write_Line (Config_File_Path.all);
1546       end if;
1547
1548       if Config_File_Path /= null then
1549          Prj.Part.Parse
1550            (In_Tree           => Project_Node_Tree,
1551             Project           => Config_Project_Node,
1552             Project_File_Name => Config_File_Path.all,
1553             Errout_Handling   => Prj.Part.Finalize_If_Error,
1554             Packages_To_Check => Packages_To_Check,
1555             Current_Directory => Current_Directory,
1556             Is_Config_File    => True,
1557             Env               => Env);
1558       else
1559          Config_Project_Node := Empty_Node;
1560       end if;
1561
1562       if On_Load_Config /= null then
1563          On_Load_Config
1564            (Config_File       => Config_Project_Node,
1565             Project_Node_Tree => Project_Node_Tree);
1566       end if;
1567
1568       if Config_Project_Node /= Empty_Node then
1569          Prj.Proc.Process_Project_Tree_Phase_1
1570            (In_Tree                => Project_Tree,
1571             Project                => Config,
1572             Packages_To_Check      => Packages_To_Check,
1573             Success                => Success,
1574             From_Project_Node      => Config_Project_Node,
1575             From_Project_Node_Tree => Project_Node_Tree,
1576             Env                    => Env,
1577             Reset_Tree             => False,
1578             On_New_Tree_Loaded     => null);
1579       end if;
1580
1581       if Config_Project_Node = Empty_Node or else Config = No_Project then
1582          Raise_Invalid_Config
1583            ("processing of configuration project """
1584             & Config_File_Path.all & """ failed");
1585       end if;
1586
1587       --  Check that the target of the configuration file is the one the user
1588       --  specified on the command line. We do not need to check that when in
1589       --  auto-conf mode, since the appropriate target was passed to gprconfig.
1590
1591       if not Automatically_Generated
1592         and then not
1593           Check_Target
1594             (Config, Autoconf_Specified, Project_Tree, Selected_Target.all)
1595       then
1596          Automatically_Generated := True;
1597          goto Process_Config_File;
1598       end if;
1599    end Get_Or_Create_Configuration_File;
1600
1601    ------------------------
1602    -- Locate_Config_File --
1603    ------------------------
1604
1605    function Locate_Config_File (Name : String) return String_Access is
1606       Prefix_Path : constant String := Executable_Prefix_Path;
1607    begin
1608       if Prefix_Path'Length /= 0 then
1609          return Locate_Regular_File
1610            (Name,
1611             "." & Path_Separator &
1612             Prefix_Path & "share" & Directory_Separator & "gpr");
1613       else
1614          return Locate_Regular_File (Name, ".");
1615       end if;
1616    end Locate_Config_File;
1617
1618    ------------------------------------
1619    -- Parse_Project_And_Apply_Config --
1620    ------------------------------------
1621
1622    procedure Parse_Project_And_Apply_Config
1623      (Main_Project               : out Prj.Project_Id;
1624       User_Project_Node          : out Prj.Tree.Project_Node_Id;
1625       Config_File_Name           : String := "";
1626       Autoconf_Specified         : Boolean;
1627       Project_File_Name          : String;
1628       Project_Tree               : Prj.Project_Tree_Ref;
1629       Project_Node_Tree          : Prj.Tree.Project_Node_Tree_Ref;
1630       Env                        : in out Prj.Tree.Environment;
1631       Packages_To_Check          : String_List_Access;
1632       Allow_Automatic_Generation : Boolean := True;
1633       Automatically_Generated    : out Boolean;
1634       Config_File_Path           : out String_Access;
1635       Target_Name                : String := "";
1636       Normalized_Hostname        : String;
1637       On_Load_Config             : Config_File_Hook := null;
1638       Implicit_Project           : Boolean := False;
1639       On_New_Tree_Loaded         : Prj.Proc.Tree_Loaded_Callback := null)
1640    is
1641       Success          : Boolean := False;
1642       Target_Try_Again : Boolean := True;
1643       Config_Try_Again : Boolean;
1644
1645       Finalization : Prj.Part.Errout_Mode := Prj.Part.Always_Finalize;
1646
1647       S : State := No_State;
1648
1649       Conf_File_Name : String_Access := new String'(Config_File_Name);
1650
1651       procedure Add_Directory (Dir : String);
1652       --  Add a directory at the end of the Project Path
1653
1654       Auto_Generated : Boolean;
1655
1656       -------------------
1657       -- Add_Directory --
1658       -------------------
1659
1660       procedure Add_Directory (Dir : String) is
1661       begin
1662          if Opt.Verbose_Mode then
1663             Write_Line ("   Adding directory """ & Dir & """");
1664          end if;
1665
1666          Prj.Env.Add_Directories (Env.Project_Path, Dir);
1667       end Add_Directory;
1668
1669    begin
1670       pragma Assert (Prj.Env.Is_Initialized (Env.Project_Path));
1671
1672       --  Start with ignoring missing withed projects
1673
1674       Set_Ignore_Missing_With (Env.Flags, True);
1675
1676       --  Note: If in fact the config file is automatically generated, then
1677       --  Automatically_Generated will be set to True after invocation of
1678       --  Process_Project_And_Apply_Config.
1679
1680       Automatically_Generated := False;
1681
1682       --  Record Target_Value and Target_Origin
1683
1684       if Target_Name = "" then
1685          Opt.Target_Value  := new String'(Normalized_Hostname);
1686          Opt.Target_Origin := Default;
1687       else
1688          Opt.Target_Value  := new String'(Target_Name);
1689          Opt.Target_Origin := Specified;
1690       end if;
1691
1692       <<Parse_Again>>
1693
1694       --  Parse the user project tree
1695
1696       Project_Node_Tree.Incomplete_With := False;
1697       Env.Flags.Incomplete_Withs := False;
1698       Prj.Initialize (Project_Tree);
1699
1700       Main_Project := No_Project;
1701
1702       Prj.Part.Parse
1703         (In_Tree           => Project_Node_Tree,
1704          Project           => User_Project_Node,
1705          Project_File_Name => Project_File_Name,
1706          Errout_Handling   => Finalization,
1707          Packages_To_Check => Packages_To_Check,
1708          Current_Directory => Current_Directory,
1709          Is_Config_File    => False,
1710          Env               => Env,
1711          Implicit_Project  => Implicit_Project);
1712
1713       Finalization := Prj.Part.Finalize_If_Error;
1714
1715       if User_Project_Node = Empty_Node then
1716          return;
1717       end if;
1718
1719       --  If --target was not specified on the command line, then do Phase 1 to
1720       --  check if attribute Target is declared in the main project.
1721
1722       if Opt.Target_Origin /= Specified then
1723          Main_Project := No_Project;
1724          Process_Project_Tree_Phase_1
1725            (In_Tree                => Project_Tree,
1726             Project                => Main_Project,
1727             Packages_To_Check      => Packages_To_Check,
1728             Success                => Success,
1729             From_Project_Node      => User_Project_Node,
1730             From_Project_Node_Tree => Project_Node_Tree,
1731             Env                    => Env,
1732             Reset_Tree             => True,
1733             On_New_Tree_Loaded     => On_New_Tree_Loaded);
1734
1735          if not Success then
1736             Main_Project := No_Project;
1737             return;
1738          end if;
1739
1740          declare
1741             Variable : constant Variable_Value :=
1742               Value_Of
1743                 (Name_Target,
1744                  Main_Project.Decl.Attributes,
1745                  Project_Tree.Shared);
1746          begin
1747             if Variable /= Nil_Variable_Value
1748               and then not Variable.Default
1749               and then
1750                 Get_Name_String (Variable.Value) /= Opt.Target_Value.all
1751             then
1752                if Target_Try_Again then
1753                   Opt.Target_Value :=
1754                     new String'(Get_Name_String (Variable.Value));
1755                   Target_Try_Again := False;
1756                   goto Parse_Again;
1757
1758                else
1759                   Fail_Program
1760                     (Project_Tree,
1761                      "inconsistent value of attribute Target");
1762                end if;
1763             end if;
1764          end;
1765       end if;
1766
1767       --  If there are missing withed projects, the projects will be parsed
1768       --  again after the project path is extended with directories rooted
1769       --  at the compiler roots.
1770
1771       Config_Try_Again := Project_Node_Tree.Incomplete_With;
1772
1773       Process_Project_And_Apply_Config
1774         (Main_Project               => Main_Project,
1775          User_Project_Node          => User_Project_Node,
1776          Config_File_Name           => Conf_File_Name.all,
1777          Autoconf_Specified         => Autoconf_Specified,
1778          Project_Tree               => Project_Tree,
1779          Project_Node_Tree          => Project_Node_Tree,
1780          Env                        => Env,
1781          Packages_To_Check          => Packages_To_Check,
1782          Allow_Automatic_Generation => Allow_Automatic_Generation,
1783          Automatically_Generated    => Auto_Generated,
1784          Config_File_Path           => Config_File_Path,
1785          Target_Name                => Target_Name,
1786          Normalized_Hostname        => Normalized_Hostname,
1787          On_Load_Config             => On_Load_Config,
1788          On_New_Tree_Loaded         => On_New_Tree_Loaded,
1789          Do_Phase_1                 => Opt.Target_Origin = Specified);
1790
1791       if Auto_Generated then
1792          Automatically_Generated := True;
1793       end if;
1794
1795       --  Exit if there was an error. Otherwise, if Config_Try_Again is True,
1796       --  update the project path and try again.
1797
1798       if Main_Project /= No_Project and then Config_Try_Again then
1799          Set_Ignore_Missing_With (Env.Flags, False);
1800
1801          if Config_File_Path /= null then
1802             Conf_File_Name := new String'(Config_File_Path.all);
1803          end if;
1804
1805          --  For the second time the project files are parsed, the warning for
1806          --  --RTS= being only taken into account in auto-configuration are
1807          --  suppressed, as we are no longer in auto-configuration.
1808
1809          Warn_For_RTS := False;
1810
1811          --  Add the default directories corresponding to the compilers
1812
1813          Update_Project_Path
1814            (By                 => Main_Project,
1815             Tree               => Project_Tree,
1816             With_State         => S,
1817             Include_Aggregated => True,
1818             Imported_First     => False);
1819
1820          declare
1821             Compiler_Root : Compiler_Root_Ptr;
1822             Prefix        : String_Access;
1823             Runtime_Root  : Runtime_Root_Ptr;
1824             Path_Value : constant String_Access := Getenv ("PATH");
1825
1826          begin
1827             if Opt.Verbose_Mode then
1828                Write_Line ("Setting the default project search directories");
1829
1830                if Prj.Current_Verbosity = High then
1831                   if Path_Value = null or else Path_Value'Length = 0 then
1832                      Write_Line ("No environment variable PATH");
1833
1834                   else
1835                      Write_Line ("PATH =");
1836                      Write_Line ("   " & Path_Value.all);
1837                   end if;
1838                end if;
1839             end if;
1840
1841             --  Reorder the compiler roots in the PATH order
1842
1843             if First_Compiler_Root /= null
1844               and then First_Compiler_Root.Next /= null
1845             then
1846                declare
1847                   Pred : Compiler_Root_Ptr;
1848                   First_New_Comp : Compiler_Root_Ptr := null;
1849                   New_Comp : Compiler_Root_Ptr := null;
1850                   First : Positive := Path_Value'First;
1851                   Last  : Positive;
1852                   Path_Last : Positive;
1853                begin
1854                   while First <= Path_Value'Last loop
1855                      Last := First;
1856
1857                      if Path_Value (First) /= Path_Separator then
1858                         while Last < Path_Value'Last
1859                           and then Path_Value (Last + 1) /= Path_Separator
1860                         loop
1861                            Last := Last + 1;
1862                         end loop;
1863
1864                         Path_Last := Last;
1865                         while Path_Last > First
1866                           and then
1867                             Path_Value (Path_Last) = Directory_Separator
1868                         loop
1869                            Path_Last := Path_Last - 1;
1870                         end loop;
1871
1872                         if Path_Last > First + 4
1873                           and then
1874                             Path_Value (Path_Last - 2 .. Path_Last) = "bin"
1875                           and then
1876                             Path_Value (Path_Last - 3) = Directory_Separator
1877                         then
1878                            Path_Last := Path_Last - 4;
1879                            Pred := null;
1880                            Compiler_Root := First_Compiler_Root;
1881                            while Compiler_Root /= null
1882                              and then Compiler_Root.Root.all /=
1883                                Path_Value (First .. Path_Last)
1884                            loop
1885                               Pred := Compiler_Root;
1886                               Compiler_Root := Compiler_Root.Next;
1887                            end loop;
1888
1889                            if Compiler_Root /= null then
1890                               if Pred = null then
1891                                  First_Compiler_Root :=
1892                                    First_Compiler_Root.Next;
1893                               else
1894                                  Pred.Next := Compiler_Root.Next;
1895                               end if;
1896
1897                               if First_New_Comp = null then
1898                                  First_New_Comp := Compiler_Root;
1899                               else
1900                                  New_Comp.Next := Compiler_Root;
1901                               end if;
1902
1903                               New_Comp := Compiler_Root;
1904                               New_Comp.Next := null;
1905                            end if;
1906                         end if;
1907                      end if;
1908
1909                      First := Last + 1;
1910                   end loop;
1911
1912                   if First_New_Comp /= null then
1913                      New_Comp.Next := First_Compiler_Root;
1914                      First_Compiler_Root := First_New_Comp;
1915                   end if;
1916                end;
1917             end if;
1918
1919             --  Now that the compiler roots are in a correct order, add the
1920             --  directories corresponding to these compiler roots in the
1921             --  project path.
1922
1923             Compiler_Root := First_Compiler_Root;
1924             while Compiler_Root /= null loop
1925                Prefix := Compiler_Root.Root;
1926
1927                Runtime_Root := Compiler_Root.Runtimes;
1928                while Runtime_Root /= null loop
1929                   Add_Directory
1930                     (Runtime_Root.Root.all &
1931                        Directory_Separator &
1932                        "lib" &
1933                        Directory_Separator &
1934                        "gnat");
1935                   Add_Directory
1936                     (Runtime_Root.Root.all &
1937                        Directory_Separator &
1938                        "share" &
1939                        Directory_Separator &
1940                        "gpr");
1941                   Runtime_Root := Runtime_Root.Next;
1942                end loop;
1943
1944                Add_Directory
1945                  (Prefix.all &
1946                     Directory_Separator &
1947                     Opt.Target_Value.all &
1948                     Directory_Separator &
1949                     "lib" &
1950                     Directory_Separator &
1951                     "gnat");
1952                Add_Directory
1953                  (Prefix.all &
1954                     Directory_Separator &
1955                     Opt.Target_Value.all &
1956                     Directory_Separator &
1957                     "share" &
1958                     Directory_Separator &
1959                     "gpr");
1960                Add_Directory
1961                  (Prefix.all &
1962                     Directory_Separator &
1963                     "share" &
1964                     Directory_Separator &
1965                     "gpr");
1966                Add_Directory
1967                  (Prefix.all &
1968                     Directory_Separator &
1969                     "lib" &
1970                     Directory_Separator &
1971                     "gnat");
1972                Compiler_Root := Compiler_Root.Next;
1973             end loop;
1974          end;
1975
1976          --  And parse again the project files. There will be no missing
1977          --  withed projects, as Ignore_Missing_With is set to False in
1978          --  the environment flags, so there is no risk of endless loop here.
1979
1980          goto Parse_Again;
1981       end if;
1982    end Parse_Project_And_Apply_Config;
1983
1984    --------------------------------------
1985    -- Process_Project_And_Apply_Config --
1986    --------------------------------------
1987
1988    procedure Process_Project_And_Apply_Config
1989      (Main_Project               : out Prj.Project_Id;
1990       User_Project_Node          : Prj.Tree.Project_Node_Id;
1991       Config_File_Name           : String := "";
1992       Autoconf_Specified         : Boolean;
1993       Project_Tree               : Prj.Project_Tree_Ref;
1994       Project_Node_Tree          : Prj.Tree.Project_Node_Tree_Ref;
1995       Env                        : in out Prj.Tree.Environment;
1996       Packages_To_Check          : String_List_Access;
1997       Allow_Automatic_Generation : Boolean := True;
1998       Automatically_Generated    : out Boolean;
1999       Config_File_Path           : out String_Access;
2000       Target_Name                : String := "";
2001       Normalized_Hostname        : String;
2002       On_Load_Config             : Config_File_Hook := null;
2003       Reset_Tree                 : Boolean := True;
2004       On_New_Tree_Loaded         : Prj.Proc.Tree_Loaded_Callback := null;
2005       Do_Phase_1                 : Boolean := True)
2006    is
2007       Shared              : constant Shared_Project_Tree_Data_Access :=
2008                               Project_Tree.Shared;
2009       Main_Config_Project : Project_Id;
2010       Success             : Boolean;
2011
2012       Conf_Project : Project_Id := No_Project;
2013       --  The object directory of this project is used to store the config
2014       --  project file in auto-configuration. Set by Check_Project below.
2015
2016       procedure Check_Project (Project : Project_Id);
2017       --  Look for a non aggregate project. If one is found, put its project Id
2018       --  in Conf_Project.
2019
2020       -------------------
2021       -- Check_Project --
2022       -------------------
2023
2024       procedure Check_Project (Project : Project_Id) is
2025       begin
2026          if Project.Qualifier = Aggregate
2027               or else
2028             Project.Qualifier = Aggregate_Library
2029          then
2030             declare
2031                List : Aggregated_Project_List := Project.Aggregated_Projects;
2032
2033             begin
2034                --  Look for a non aggregate project until one is found
2035
2036                while Conf_Project = No_Project and then List /= null loop
2037                   Check_Project (List.Project);
2038                   List := List.Next;
2039                end loop;
2040             end;
2041
2042          else
2043             Conf_Project := Project;
2044          end if;
2045       end Check_Project;
2046
2047    --  Start of processing for Process_Project_And_Apply_Config
2048
2049    begin
2050       Automatically_Generated := False;
2051
2052       if Do_Phase_1 then
2053          Main_Project := No_Project;
2054          Process_Project_Tree_Phase_1
2055            (In_Tree                => Project_Tree,
2056             Project                => Main_Project,
2057             Packages_To_Check      => Packages_To_Check,
2058             Success                => Success,
2059             From_Project_Node      => User_Project_Node,
2060             From_Project_Node_Tree => Project_Node_Tree,
2061             Env                    => Env,
2062             Reset_Tree             => Reset_Tree,
2063             On_New_Tree_Loaded     => On_New_Tree_Loaded);
2064
2065          if not Success then
2066             Main_Project := No_Project;
2067             return;
2068          end if;
2069       end if;
2070
2071       if Project_Tree.Source_Info_File_Name /= null then
2072          if not Is_Absolute_Path (Project_Tree.Source_Info_File_Name.all) then
2073             declare
2074                Obj_Dir : constant Variable_Value :=
2075                            Value_Of
2076                              (Name_Object_Dir,
2077                               Main_Project.Decl.Attributes,
2078                               Shared);
2079
2080             begin
2081                if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then
2082                   Get_Name_String (Main_Project.Directory.Display_Name);
2083
2084                else
2085                   if Is_Absolute_Path (Get_Name_String (Obj_Dir.Value)) then
2086                      Get_Name_String (Obj_Dir.Value);
2087
2088                   else
2089                      Name_Len := 0;
2090                      Add_Str_To_Name_Buffer
2091                        (Get_Name_String (Main_Project.Directory.Display_Name));
2092                      Add_Str_To_Name_Buffer (Get_Name_String (Obj_Dir.Value));
2093                   end if;
2094                end if;
2095
2096                Add_Char_To_Name_Buffer (Directory_Separator);
2097                Add_Str_To_Name_Buffer (Project_Tree.Source_Info_File_Name.all);
2098                Free (Project_Tree.Source_Info_File_Name);
2099                Project_Tree.Source_Info_File_Name :=
2100                  new String'(Name_Buffer (1 .. Name_Len));
2101             end;
2102          end if;
2103
2104          Read_Source_Info_File (Project_Tree);
2105       end if;
2106
2107       --  Get the first project that is not an aggregate project or an
2108       --  aggregate library project. The object directory of this project will
2109       --  be used to store the config project file in auto-configuration.
2110
2111       Check_Project (Main_Project);
2112
2113       --  Fail if there is only aggregate projects and aggregate library
2114       --  projects in the project tree.
2115
2116       if Conf_Project = No_Project then
2117          Raise_Invalid_Config ("there are no non-aggregate projects");
2118       end if;
2119
2120       --  Find configuration file
2121
2122       Get_Or_Create_Configuration_File
2123         (Config                     => Main_Config_Project,
2124          Project                    => Main_Project,
2125          Conf_Project               => Conf_Project,
2126          Project_Tree               => Project_Tree,
2127          Project_Node_Tree          => Project_Node_Tree,
2128          Env                        => Env,
2129          Allow_Automatic_Generation => Allow_Automatic_Generation,
2130          Config_File_Name           => Config_File_Name,
2131          Autoconf_Specified         => Autoconf_Specified,
2132          Target_Name                => Target_Name,
2133          Normalized_Hostname        => Normalized_Hostname,
2134          Packages_To_Check          => Packages_To_Check,
2135          Config_File_Path           => Config_File_Path,
2136          Automatically_Generated    => Automatically_Generated,
2137          On_Load_Config             => On_Load_Config);
2138
2139       Apply_Config_File (Main_Config_Project, Project_Tree);
2140
2141       --  Finish processing the user's project
2142
2143       Prj.Proc.Process_Project_Tree_Phase_2
2144         (In_Tree                => Project_Tree,
2145          Project                => Main_Project,
2146          Success                => Success,
2147          From_Project_Node      => User_Project_Node,
2148          From_Project_Node_Tree => Project_Node_Tree,
2149          Env                    => Env);
2150
2151       if Success then
2152          if Project_Tree.Source_Info_File_Name /= null
2153            and then not Project_Tree.Source_Info_File_Exists
2154          then
2155             Write_Source_Info_File (Project_Tree);
2156          end if;
2157
2158       else
2159          Main_Project := No_Project;
2160       end if;
2161    end Process_Project_And_Apply_Config;
2162
2163    --------------------------
2164    -- Raise_Invalid_Config --
2165    --------------------------
2166
2167    procedure Raise_Invalid_Config (Msg : String) is
2168    begin
2169       Raise_Exception (Invalid_Config'Identity, Msg);
2170    end Raise_Invalid_Config;
2171
2172    ----------------------
2173    -- Runtime_Name_For --
2174    ----------------------
2175
2176    function Runtime_Name_For (Language : Name_Id) return String is
2177    begin
2178       if RTS_Languages.Get (Language) /= No_Name then
2179          return Get_Name_String (RTS_Languages.Get (Language));
2180       else
2181          return "";
2182       end if;
2183    end Runtime_Name_For;
2184
2185    --------------------------
2186    -- Runtime_Name_Set_For --
2187    --------------------------
2188
2189    function Runtime_Name_Set_For (Language : Name_Id) return Boolean is
2190    begin
2191       return RTS_Languages.Get (Language) /= No_Name;
2192    end Runtime_Name_Set_For;
2193
2194    ---------------------
2195    -- Set_Runtime_For --
2196    ---------------------
2197
2198    procedure Set_Runtime_For (Language : Name_Id; RTS_Name : String) is
2199    begin
2200       Name_Len := RTS_Name'Length;
2201       Name_Buffer (1 .. Name_Len) := RTS_Name;
2202       RTS_Languages.Set (Language, Name_Find);
2203    end Set_Runtime_For;
2204
2205    ----------------------------
2206    -- Look_For_Project_Paths --
2207    ----------------------------
2208
2209    procedure Look_For_Project_Paths
2210      (Project    : Project_Id;
2211       Tree       : Project_Tree_Ref;
2212       With_State : in out State)
2213    is
2214       Lang_Id       : Language_Ptr;
2215       Compiler_Root : Compiler_Root_Ptr;
2216       Runtime_Root  : Runtime_Root_Ptr;
2217       Comp_Driver   : String_Access;
2218       Comp_Dir      : String_Access;
2219       Prefix   : String_Access;
2220
2221       pragma Unreferenced (Tree);
2222
2223    begin
2224       With_State := No_State;
2225
2226       Lang_Id := Project.Languages;
2227       while Lang_Id /= No_Language_Index loop
2228          if Lang_Id.Config.Compiler_Driver /= No_File then
2229             Comp_Driver :=
2230               new String'
2231                 (Get_Name_String (Lang_Id.Config.Compiler_Driver));
2232
2233             --  Get the absolute path of the compiler driver
2234
2235             if not Is_Absolute_Path (Comp_Driver.all) then
2236                Comp_Driver := Locate_Exec_On_Path (Comp_Driver.all);
2237             end if;
2238
2239             if Comp_Driver /= null and then Comp_Driver'Length > 0 then
2240                Comp_Dir :=
2241                  new String'
2242                    (Containing_Directory (Comp_Driver.all));
2243
2244                --  Consider only the compiler drivers that are in "bin"
2245                --  subdirectories.
2246
2247                if Simple_Name (Comp_Dir.all) = "bin" then
2248                   Prefix :=
2249                     new String'(Containing_Directory (Comp_Dir.all));
2250
2251                   --  Check if the compiler root is already in the list. If it
2252                   --  is not, add it to the list.
2253
2254                   Compiler_Root := First_Compiler_Root;
2255                   while Compiler_Root /= null loop
2256                      exit when Prefix.all = Compiler_Root.Root.all;
2257                      Compiler_Root := Compiler_Root.Next;
2258                   end loop;
2259
2260                   if Compiler_Root = null then
2261                      First_Compiler_Root :=
2262                        new Compiler_Root_Data'
2263                          (Root => Prefix,
2264                           Runtimes => null,
2265                           Next => First_Compiler_Root);
2266                      Compiler_Root := First_Compiler_Root;
2267                   end if;
2268
2269                   --  If there is a runtime for this compiler, check if it is
2270                   --  recorded with the compiler root. If it is not, record
2271                   --  the runtime.
2272
2273                   declare
2274                      Runtime : constant String :=
2275                                  Runtime_Name_For (Lang_Id.Name);
2276                      Root    : String_Access;
2277
2278                   begin
2279                      if Runtime'Length > 0 then
2280                         if Is_Absolute_Path (Runtime) then
2281                            Root := new String'(Runtime);
2282
2283                         else
2284                            Root :=
2285                              new String'
2286                                (Prefix.all &
2287                                   Directory_Separator &
2288                                   Opt.Target_Value.all &
2289                                   Directory_Separator &
2290                                   Runtime);
2291                         end if;
2292
2293                         Runtime_Root := Compiler_Root.Runtimes;
2294                         while Runtime_Root /= null loop
2295                            exit when Root.all = Runtime_Root.Root.all;
2296                            Runtime_Root := Runtime_Root.Next;
2297                         end loop;
2298
2299                         if Runtime_Root = null then
2300                            Compiler_Root.Runtimes :=
2301                              new Runtime_Root_Data'
2302                                (Root => Root,
2303                                 Next => Compiler_Root.Runtimes);
2304                         end if;
2305                      end if;
2306                   end;
2307                end if;
2308             end if;
2309          end if;
2310
2311          Lang_Id := Lang_Id.Next;
2312       end loop;
2313    end Look_For_Project_Paths;
2314 end Prj.Conf;