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-2011, 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 Hostparm;
  27 with Makeutl;  use Makeutl;
  28 with MLib.Tgt;
  29 with Opt;      use Opt;
  30 with Output;   use Output;
  31 with Prj.Env;
  32 with Prj.Err;
  33 with Prj.Part;
  34 with Prj.PP;
  35 with Prj.Proc; use Prj.Proc;
  36 with Prj.Tree; use Prj.Tree;
  37 with Prj.Util; use Prj.Util;
  38 with Prj;      use Prj;
  39 with Snames;   use Snames;
  40
  41 with Ada.Directories; use Ada.Directories;
  42 with Ada.Exceptions;  use Ada.Exceptions;
  43
  44 with GNAT.Case_Util; use GNAT.Case_Util;
  45 with GNAT.HTable;    use GNAT.HTable;
  46
  47 package body Prj.Conf is
  48
  49    Auto_Cgpr : constant String := "auto.cgpr";
  50
  51    Default_Name : constant String := "default.cgpr";
  52    --  Default configuration file that will be used if found
  53
  54    Config_Project_Env_Var : constant String := "GPR_CONFIG";
  55    --  Name of the environment variable that provides the name of the
  56    --  configuration file to use.
  57
  58    Gprconfig_Name : constant String := "gprconfig";
  59
  60    package RTS_Languages is new GNAT.HTable.Simple_HTable
  61      (Header_Num => Prj.Header_Num,
  62       Element    => Name_Id,
  63       No_Element => No_Name,
  64       Key        => Name_Id,
  65       Hash       => Prj.Hash,
  66       Equal      => "=");
  67    --  Stores the runtime names for the various languages. This is in general
  68    --  set from a --RTS command line option.
  69
  70    -----------------------
  71    -- Local_Subprograms --
  72    -----------------------
  73
  74    procedure Add_Attributes
  75      (Project_Tree : Project_Tree_Ref;
  76       Conf_Decl    : Declarations;
  77       User_Decl    : in out Declarations);
  78    --  Process the attributes in the config declarations.
  79    --  For single string values, if the attribute is not declared in the user
  80    --  declarations, declare it with the value in the config declarations.
  81    --  For string list values, prepend the value in the user declarations with
  82    --  the value in the config declarations.
  83
  84    function Check_Target
  85      (Config_File        : Prj.Project_Id;
  86       Autoconf_Specified : Boolean;
  87       Project_Tree       : Prj.Project_Tree_Ref;
  88       Target             : String := "") return Boolean;
  89    --  Check that the config file's target matches Target.
  90    --  Target should be set to the empty string when the user did not specify
  91    --  a target. If the target in the configuration file is invalid, this
  92    --  function will raise Invalid_Config with an appropriate message.
  93    --  Autoconf_Specified should be set to True if the user has used
  94    --  autoconf.
  95
  96    function Locate_Config_File (Name : String) return String_Access;
  97    --  Search for Name in the config files directory. Return full path if
  98    --  found, or null otherwise.
  99
 100    procedure Raise_Invalid_Config (Msg : String);
 101    pragma No_Return (Raise_Invalid_Config);
 102    --  Raises exception Invalid_Config with given message
 103
 104    procedure Apply_Config_File
 105      (Config_File  : Prj.Project_Id;
 106       Project_Tree : Prj.Project_Tree_Ref);
 107    --  Apply the configuration file settings to all the projects in the
 108    --  project tree. The Project_Tree must have been parsed first, and
 109    --  processed through the first phase so that all its projects are known.
 110    --
 111    --  Currently, this will add new attributes and packages in the various
 112    --  projects, so that when the second phase of the processing is performed
 113    --  these attributes are automatically taken into account.
 114
 115    --------------------
 116    -- Add_Attributes --
 117    --------------------
 118
 119    procedure Add_Attributes
 120      (Project_Tree : Project_Tree_Ref;
 121       Conf_Decl    : Declarations;
 122       User_Decl    : in out Declarations)
 123    is
 124       Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
 125       Conf_Attr_Id       : Variable_Id;
 126       Conf_Attr          : Variable;
 127       Conf_Array_Id      : Array_Id;
 128       Conf_Array         : Array_Data;
 129       Conf_Array_Elem_Id : Array_Element_Id;
 130       Conf_Array_Elem    : Array_Element;
 131       Conf_List          : String_List_Id;
 132       Conf_List_Elem     : String_Element;
 133
 134       User_Attr_Id       : Variable_Id;
 135       User_Attr          : Variable;
 136       User_Array_Id      : Array_Id;
 137       User_Array         : Array_Data;
 138       User_Array_Elem_Id : Array_Element_Id;
 139       User_Array_Elem    : Array_Element;
 140
 141    begin
 142       Conf_Attr_Id := Conf_Decl.Attributes;
 143       User_Attr_Id := User_Decl.Attributes;
 144       while Conf_Attr_Id /= No_Variable loop
 145          Conf_Attr := Shared.Variable_Elements.Table (Conf_Attr_Id);
 146          User_Attr := Shared.Variable_Elements.Table (User_Attr_Id);
 147
 148          if not Conf_Attr.Value.Default then
 149             if User_Attr.Value.Default then
 150
 151                --  No attribute declared in user project file: just copy the
 152                --  value of the configuration attribute.
 153
 154                User_Attr.Value := Conf_Attr.Value;
 155                Shared.Variable_Elements.Table (User_Attr_Id) := User_Attr;
 156
 157             elsif User_Attr.Value.Kind = List
 158               and then Conf_Attr.Value.Values /= Nil_String
 159             then
 160                --  List attribute declared in both the user project and the
 161                --  configuration project: prepend the user list with the
 162                --  configuration list.
 163
 164                declare
 165                   User_List : constant String_List_Id :=
 166                                 User_Attr.Value.Values;
 167                   Conf_List : String_List_Id := Conf_Attr.Value.Values;
 168                   Conf_Elem : String_Element;
 169                   New_List  : String_List_Id;
 170                   New_Elem  : String_Element;
 171
 172                begin
 173                   --  Create new list
 174
 175                   String_Element_Table.Increment_Last
 176                     (Shared.String_Elements);
 177                   New_List :=
 178                     String_Element_Table.Last (Shared.String_Elements);
 179
 180                   --  Value of attribute is new list
 181
 182                   User_Attr.Value.Values := New_List;
 183                   Shared.Variable_Elements.Table (User_Attr_Id) := User_Attr;
 184
 185                   loop
 186                      --  Get each element of configuration list
 187
 188                      Conf_Elem := Shared.String_Elements.Table (Conf_List);
 189                      New_Elem  := Conf_Elem;
 190                      Conf_List := Conf_Elem.Next;
 191
 192                      if Conf_List = Nil_String then
 193
 194                         --  If it is the last element in the list, connect to
 195                         --  first element of user list, and we are done.
 196
 197                         New_Elem.Next := User_List;
 198                         Shared.String_Elements.Table (New_List) := New_Elem;
 199                         exit;
 200
 201                      else
 202                         --  If it is not the last element in the list, add to
 203                         --  new list.
 204
 205                         String_Element_Table.Increment_Last
 206                           (Shared.String_Elements);
 207                         New_Elem.Next :=
 208                           String_Element_Table.Last (Shared.String_Elements);
 209                         Shared.String_Elements.Table (New_List) := New_Elem;
 210                         New_List := New_Elem.Next;
 211                      end if;
 212                   end loop;
 213                end;
 214             end if;
 215          end if;
 216
 217          Conf_Attr_Id := Conf_Attr.Next;
 218          User_Attr_Id := User_Attr.Next;
 219       end loop;
 220
 221       Conf_Array_Id := Conf_Decl.Arrays;
 222       while Conf_Array_Id /= No_Array loop
 223          Conf_Array := Shared.Arrays.Table (Conf_Array_Id);
 224
 225          User_Array_Id := User_Decl.Arrays;
 226          while User_Array_Id /= No_Array loop
 227             User_Array := Shared.Arrays.Table (User_Array_Id);
 228             exit when User_Array.Name = Conf_Array.Name;
 229             User_Array_Id := User_Array.Next;
 230          end loop;
 231
 232          --  If this associative array does not exist in the user project file,
 233          --  do a shallow copy of the full associative array.
 234
 235          if User_Array_Id = No_Array then
 236             Array_Table.Increment_Last (Shared.Arrays);
 237             User_Array := Conf_Array;
 238             User_Array.Next := User_Decl.Arrays;
 239             User_Decl.Arrays := Array_Table.Last (Shared.Arrays);
 240             Shared.Arrays.Table (User_Decl.Arrays) := User_Array;
 241
 242          --  Otherwise, check each array element
 243
 244          else
 245             Conf_Array_Elem_Id := Conf_Array.Value;
 246             while Conf_Array_Elem_Id /= No_Array_Element loop
 247                Conf_Array_Elem :=
 248                  Shared.Array_Elements.Table (Conf_Array_Elem_Id);
 249
 250                User_Array_Elem_Id := User_Array.Value;
 251                while User_Array_Elem_Id /= No_Array_Element loop
 252                   User_Array_Elem :=
 253                     Shared.Array_Elements.Table (User_Array_Elem_Id);
 254                   exit when User_Array_Elem.Index = Conf_Array_Elem.Index;
 255                   User_Array_Elem_Id := User_Array_Elem.Next;
 256                end loop;
 257
 258                --  If the array element doesn't exist in the user array, insert
 259                --  a shallow copy of the conf array element in the user array.
 260
 261                if User_Array_Elem_Id = No_Array_Element then
 262                   Array_Element_Table.Increment_Last (Shared.Array_Elements);
 263                   User_Array_Elem := Conf_Array_Elem;
 264                   User_Array_Elem.Next := User_Array.Value;
 265                   User_Array.Value :=
 266                     Array_Element_Table.Last (Shared.Array_Elements);
 267                   Shared.Array_Elements.Table (User_Array.Value) :=
 268                     User_Array_Elem;
 269                   Shared.Arrays.Table (User_Array_Id) := User_Array;
 270
 271                --  Otherwise, if the value is a string list, prepend the conf
 272                --  array element value to the array element.
 273
 274                elsif Conf_Array_Elem.Value.Kind = List then
 275                   Conf_List := Conf_Array_Elem.Value.Values;
 276
 277                   if Conf_List /= Nil_String then
 278                      declare
 279                         Link     : constant String_List_Id :=
 280                                      User_Array_Elem.Value.Values;
 281                         Previous : String_List_Id := Nil_String;
 282                         Next     : String_List_Id;
 283
 284                      begin
 285                         loop
 286                            Conf_List_Elem :=
 287                              Shared.String_Elements.Table (Conf_List);
 288                            String_Element_Table.Increment_Last
 289                              (Shared.String_Elements);
 290                            Next :=
 291                              String_Element_Table.Last
 292                                (Shared.String_Elements);
 293                            Shared.String_Elements.Table (Next) :=
 294                              Conf_List_Elem;
 295
 296                            if Previous = Nil_String then
 297                               User_Array_Elem.Value.Values := Next;
 298                               Shared.Array_Elements.Table
 299                                 (User_Array_Elem_Id) := User_Array_Elem;
 300
 301                            else
 302                               Shared.String_Elements.Table
 303                                 (Previous).Next := Next;
 304                            end if;
 305
 306                            Previous := Next;
 307
 308                            Conf_List := Conf_List_Elem.Next;
 309
 310                            if Conf_List = Nil_String then
 311                               Shared.String_Elements.Table (Previous).Next :=
 312                                 Link;
 313                               exit;
 314                            end if;
 315                         end loop;
 316                      end;
 317                   end if;
 318                end if;
 319
 320                Conf_Array_Elem_Id := Conf_Array_Elem.Next;
 321             end loop;
 322          end if;
 323
 324          Conf_Array_Id := Conf_Array.Next;
 325       end loop;
 326    end Add_Attributes;
 327
 328    ------------------------------------
 329    -- Add_Default_GNAT_Naming_Scheme --
 330    ------------------------------------
 331
 332    procedure Add_Default_GNAT_Naming_Scheme
 333      (Config_File  : in out Project_Node_Id;
 334       Project_Tree : Project_Node_Tree_Ref)
 335    is
 336       procedure Create_Attribute
 337         (Name  : Name_Id;
 338          Value : String;
 339          Index : String := "";
 340          Pkg   : Project_Node_Id := Empty_Node);
 341
 342       ----------------------
 343       -- Create_Attribute --
 344       ----------------------
 345
 346       procedure Create_Attribute
 347         (Name  : Name_Id;
 348          Value : String;
 349          Index : String := "";
 350          Pkg   : Project_Node_Id := Empty_Node)
 351       is
 352          Attr : Project_Node_Id;
 353          pragma Unreferenced (Attr);
 354
 355          Expr   : Name_Id         := No_Name;
 356          Val    : Name_Id         := No_Name;
 357          Parent : Project_Node_Id := Config_File;
 358
 359       begin
 360          if Index /= "" then
 361             Name_Len := Index'Length;
 362             Name_Buffer (1 .. Name_Len) := Index;
 363             Val := Name_Find;
 364          end if;
 365
 366          if Pkg /= Empty_Node then
 367             Parent := Pkg;
 368          end if;
 369
 370          Name_Len := Value'Length;
 371          Name_Buffer (1 .. Name_Len) := Value;
 372          Expr := Name_Find;
 373
 374          Attr := Create_Attribute
 375            (Tree       => Project_Tree,
 376             Prj_Or_Pkg => Parent,
 377             Name       => Name,
 378             Index_Name => Val,
 379             Kind       => Prj.Single,
 380             Value      => Create_Literal_String (Expr, Project_Tree));
 381       end Create_Attribute;
 382
 383       --  Local variables
 384
 385       Name     : Name_Id;
 386       Naming   : Project_Node_Id;
 387       Compiler : Project_Node_Id;
 388
 389    --  Start of processing for Add_Default_GNAT_Naming_Scheme
 390
 391    begin
 392       if Config_File = Empty_Node then
 393
 394          --  Create a dummy config file is none was found
 395
 396          Name_Len := Auto_Cgpr'Length;
 397          Name_Buffer (1 .. Name_Len) := Auto_Cgpr;
 398          Name := Name_Find;
 399
 400          --  An invalid project name to avoid conflicts with user-created ones
 401
 402          Name_Len := 5;
 403          Name_Buffer (1 .. Name_Len) := "_auto";
 404
 405          Config_File :=
 406            Create_Project
 407              (In_Tree        => Project_Tree,
 408               Name           => Name_Find,
 409               Full_Path      => Path_Name_Type (Name),
 410               Is_Config_File => True);
 411
 412          --  Setup library support
 413
 414          case MLib.Tgt.Support_For_Libraries is
 415             when None =>
 416                null;
 417
 418             when Static_Only =>
 419                Create_Attribute (Name_Library_Support, "static_only");
 420
 421             when Full =>
 422                Create_Attribute (Name_Library_Support, "full");
 423          end case;
 424
 425          if MLib.Tgt.Standalone_Library_Auto_Init_Is_Supported then
 426             Create_Attribute (Name_Library_Auto_Init_Supported, "true");
 427          else
 428             Create_Attribute (Name_Library_Auto_Init_Supported, "false");
 429          end if;
 430
 431          --  Setup Ada support (Ada is the default language here, since this
 432          --  is only called when no config file existed initially, ie for
 433          --  gnatmake).
 434
 435          Create_Attribute (Name_Default_Language, "ada");
 436
 437          Compiler := Create_Package (Project_Tree, Config_File, "compiler");
 438          Create_Attribute
 439            (Name_Driver, "gcc", "ada", Pkg => Compiler);
 440          Create_Attribute
 441            (Name_Language_Kind, "unit_based", "ada", Pkg => Compiler);
 442          Create_Attribute
 443            (Name_Dependency_Kind, "ALI_File", "ada", Pkg => Compiler);
 444
 445          Naming := Create_Package (Project_Tree, Config_File, "naming");
 446          Create_Attribute (Name_Spec_Suffix, ".ads", "ada",     Pkg => Naming);
 447          Create_Attribute (Name_Separate_Suffix, ".adb", "ada", Pkg => Naming);
 448          Create_Attribute (Name_Body_Suffix, ".adb", "ada",     Pkg => Naming);
 449          Create_Attribute (Name_Dot_Replacement, "-",           Pkg => Naming);
 450          Create_Attribute (Name_Casing,          "lowercase",   Pkg => Naming);
 451
 452          if Current_Verbosity = High then
 453             Write_Line ("Automatically generated (in-memory) config file");
 454             Prj.PP.Pretty_Print
 455               (Project                => Config_File,
 456                In_Tree                => Project_Tree,
 457                Backward_Compatibility => False);
 458          end if;
 459       end if;
 460    end Add_Default_GNAT_Naming_Scheme;
 461
 462    -----------------------
 463    -- Apply_Config_File --
 464    -----------------------
 465
 466    procedure Apply_Config_File
 467      (Config_File  : Prj.Project_Id;
 468       Project_Tree : Prj.Project_Tree_Ref)
 469    is
 470       Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
 471
 472       Conf_Decl    : constant Declarations := Config_File.Decl;
 473       Conf_Pack_Id : Package_Id;
 474       Conf_Pack    : Package_Element;
 475
 476       User_Decl    : Declarations;
 477       User_Pack_Id : Package_Id;
 478       User_Pack    : Package_Element;
 479       Proj         : Project_List;
 480
 481    begin
 482       Debug_Output ("Applying config file to a project tree");
 483
 484       Proj := Project_Tree.Projects;
 485       while Proj /= null loop
 486          if Proj.Project /= Config_File then
 487             User_Decl := Proj.Project.Decl;
 488             Add_Attributes
 489               (Project_Tree      => Project_Tree,
 490                Conf_Decl         => Conf_Decl,
 491                User_Decl         => User_Decl);
 492
 493             Conf_Pack_Id := Conf_Decl.Packages;
 494             while Conf_Pack_Id /= No_Package loop
 495                Conf_Pack := Shared.Packages.Table (Conf_Pack_Id);
 496
 497                User_Pack_Id := User_Decl.Packages;
 498                while User_Pack_Id /= No_Package loop
 499                   User_Pack := Shared.Packages.Table (User_Pack_Id);
 500                   exit when User_Pack.Name = Conf_Pack.Name;
 501                   User_Pack_Id := User_Pack.Next;
 502                end loop;
 503
 504                if User_Pack_Id = No_Package then
 505                   Package_Table.Increment_Last (Shared.Packages);
 506                   User_Pack := Conf_Pack;
 507                   User_Pack.Next := User_Decl.Packages;
 508                   User_Decl.Packages := Package_Table.Last (Shared.Packages);
 509                   Shared.Packages.Table (User_Decl.Packages) := User_Pack;
 510
 511                else
 512                   Add_Attributes
 513                     (Project_Tree => Project_Tree,
 514                      Conf_Decl    => Conf_Pack.Decl,
 515                      User_Decl    => Shared.Packages.Table
 516                                        (User_Pack_Id).Decl);
 517                end if;
 518
 519                Conf_Pack_Id := Conf_Pack.Next;
 520             end loop;
 521
 522             Proj.Project.Decl := User_Decl;
 523
 524             --  For aggregate projects, we need to apply the config to all
 525             --  their aggregated trees as well.
 526
 527             if Proj.Project.Qualifier in Aggregate_Project then
 528                declare
 529                   List : Aggregated_Project_List;
 530                begin
 531                   List := Proj.Project.Aggregated_Projects;
 532                   while List /= null loop
 533                      Debug_Output
 534                        ("Recursively apply config to aggregated tree",
 535                         List.Project.Name);
 536                      Apply_Config_File
 537                        (Config_File, Project_Tree => List.Tree);
 538                      List := List.Next;
 539                   end loop;
 540                end;
 541             end if;
 542          end if;
 543
 544          Proj := Proj.Next;
 545       end loop;
 546    end Apply_Config_File;
 547
 548    ------------------
 549    -- Check_Target --
 550    ------------------
 551
 552    function Check_Target
 553      (Config_File        : Project_Id;
 554       Autoconf_Specified : Boolean;
 555       Project_Tree       : Prj.Project_Tree_Ref;
 556       Target             : String := "") return Boolean
 557    is
 558       Shared   : constant Shared_Project_Tree_Data_Access :=
 559                    Project_Tree.Shared;
 560       Variable : constant Variable_Value :=
 561                    Value_Of
 562                      (Name_Target, Config_File.Decl.Attributes, Shared);
 563       Tgt_Name : Name_Id := No_Name;
 564       OK       : Boolean;
 565
 566    begin
 567       if Variable /= Nil_Variable_Value and then not Variable.Default then
 568          Tgt_Name := Variable.Value;
 569       end if;
 570
 571       if Target = "" then
 572          OK := not Autoconf_Specified or else Tgt_Name = No_Name;
 573       else
 574          OK := Tgt_Name /= No_Name
 575                  and then Target = Get_Name_String (Tgt_Name);
 576       end if;
 577
 578       if not OK then
 579          if Autoconf_Specified then
 580             if Verbose_Mode then
 581                Write_Line ("inconsistent targets, performing autoconf");
 582             end if;
 583
 584             return False;
 585
 586          else
 587             if Tgt_Name /= No_Name then
 588                Raise_Invalid_Config
 589                  ("invalid target name """
 590                   & Get_Name_String (Tgt_Name) & """ in configuration");
 591             else
 592                Raise_Invalid_Config
 593                  ("no target specified in configuration file");
 594             end if;
 595          end if;
 596       end if;
 597
 598       return True;
 599    end Check_Target;
 600
 601    --------------------------------------
 602    -- Get_Or_Create_Configuration_File --
 603    --------------------------------------
 604
 605    procedure Get_Or_Create_Configuration_File
 606      (Project                    : Project_Id;
 607       Project_Tree               : Project_Tree_Ref;
 608       Project_Node_Tree          : Prj.Tree.Project_Node_Tree_Ref;
 609       Env                        : in out Prj.Tree.Environment;
 610       Allow_Automatic_Generation : Boolean;
 611       Config_File_Name           : String := "";
 612       Autoconf_Specified         : Boolean;
 613       Target_Name                : String := "";
 614       Normalized_Hostname        : String;
 615       Packages_To_Check          : String_List_Access := null;
 616       Config                     : out Prj.Project_Id;
 617       Config_File_Path           : out String_Access;
 618       Automatically_Generated    : out Boolean;
 619       On_Load_Config             : Config_File_Hook := null)
 620    is
 621       Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
 622
 623       At_Least_One_Compiler_Command : Boolean := False;
 624       --  Set to True if at least one attribute Ide'Compiler_Command is
 625       --  specified for one language of the system.
 626
 627       function Default_File_Name return String;
 628       --  Return the name of the default config file that should be tested
 629
 630       procedure Do_Autoconf;
 631       --  Generate a new config file through gprconfig. In case of error, this
 632       --  raises the Invalid_Config exception with an appropriate message
 633
 634       function Get_Config_Switches return Argument_List_Access;
 635       --  Return the --config switches to use for gprconfig
 636
 637       function Might_Have_Sources (Project : Project_Id) return Boolean;
 638       --  True if the specified project might have sources (ie the user has not
 639       --  explicitly specified it. We haven't checked the file system, nor do
 640       --  we need to at this stage.
 641
 642       -----------------------
 643       -- Default_File_Name --
 644       -----------------------
 645
 646       function Default_File_Name return String is
 647          Ada_RTS : constant String := Runtime_Name_For (Name_Ada);
 648          Tmp     : String_Access;
 649
 650       begin
 651          if Target_Name /= "" then
 652             if Ada_RTS /= "" then
 653                return Target_Name & '-' & Ada_RTS
 654                  & Config_Project_File_Extension;
 655             else
 656                return Target_Name & Config_Project_File_Extension;
 657             end if;
 658
 659          elsif Ada_RTS /= "" then
 660             return Ada_RTS & Config_Project_File_Extension;
 661
 662          else
 663             Tmp := Getenv (Config_Project_Env_Var);
 664
 665             declare
 666                T : constant String := Tmp.all;
 667
 668             begin
 669                Free (Tmp);
 670
 671                if T'Length = 0 then
 672                   return Default_Name;
 673                else
 674                   return T;
 675                end if;
 676             end;
 677          end if;
 678       end Default_File_Name;
 679
 680       ------------------------
 681       -- Might_Have_Sources --
 682       ------------------------
 683
 684       function Might_Have_Sources (Project : Project_Id) return Boolean is
 685          Variable : Variable_Value;
 686
 687       begin
 688          Variable :=
 689            Value_Of
 690              (Name_Source_Dirs,
 691               Project.Decl.Attributes,
 692               Shared);
 693
 694          if Variable = Nil_Variable_Value
 695            or else Variable.Default
 696            or else Variable.Values /= Nil_String
 697          then
 698             Variable :=
 699               Value_Of
 700                 (Name_Source_Files,
 701                  Project.Decl.Attributes,
 702                  Shared);
 703             return Variable = Nil_Variable_Value
 704               or else Variable.Default
 705               or else Variable.Values /= Nil_String;
 706
 707          else
 708             return False;
 709          end if;
 710       end Might_Have_Sources;
 711
 712       -------------------------
 713       -- Get_Config_Switches --
 714       -------------------------
 715
 716       function Get_Config_Switches return Argument_List_Access is
 717
 718          package Language_Htable is new GNAT.HTable.Simple_HTable
 719            (Header_Num => Prj.Header_Num,
 720             Element    => Name_Id,
 721             No_Element => No_Name,
 722             Key        => Name_Id,
 723             Hash       => Prj.Hash,
 724             Equal      => "=");
 725          --  Hash table to keep the languages used in the project tree
 726
 727          IDE : constant Package_Id :=
 728                  Value_Of (Name_Ide, Project.Decl.Packages, Shared);
 729
 730          procedure Add_Config_Switches_For_Project
 731            (Project          : Project_Id;
 732             Tree             : Project_Tree_Ref;
 733             In_Aggregate_Lib : Boolean;
 734             With_State       : in out Integer);
 735          --  Add all --config switches for this project. This is also called
 736          --  for aggregate projects.
 737
 738          -------------------------------------
 739          -- Add_Config_Switches_For_Project --
 740          -------------------------------------
 741
 742          procedure Add_Config_Switches_For_Project
 743            (Project          : Project_Id;
 744             Tree             : Project_Tree_Ref;
 745             In_Aggregate_Lib : Boolean;
 746             With_State       : in out Integer)
 747          is
 748             pragma Unreferenced (With_State, In_Aggregate_Lib);
 749
 750             Shared : constant Shared_Project_Tree_Data_Access := Tree.Shared;
 751
 752             Variable      : Variable_Value;
 753             Check_Default : Boolean;
 754             Lang          : Name_Id;
 755             List          : String_List_Id;
 756             Elem          : String_Element;
 757
 758          begin
 759             if Might_Have_Sources (Project) then
 760                Variable :=
 761                  Value_Of (Name_Languages, Project.Decl.Attributes, Shared);
 762
 763                if Variable = Nil_Variable_Value or else Variable.Default then
 764
 765                   --  Languages is not declared. If it is not an extending
 766                   --  project, or if it extends a project with no Languages,
 767                   --  check for Default_Language.
 768
 769                   Check_Default := Project.Extends = No_Project;
 770
 771                   if not Check_Default then
 772                      Variable :=
 773                        Value_Of
 774                          (Name_Languages,
 775                           Project.Extends.Decl.Attributes,
 776                           Shared);
 777                      Check_Default :=
 778                        Variable /= Nil_Variable_Value
 779                          and then Variable.Values = Nil_String;
 780                   end if;
 781
 782                   if Check_Default then
 783                      Variable :=
 784                        Value_Of
 785                          (Name_Default_Language,
 786                           Project.Decl.Attributes,
 787                           Shared);
 788
 789                      if Variable /= Nil_Variable_Value
 790                        and then not Variable.Default
 791                      then
 792                         Get_Name_String (Variable.Value);
 793                         To_Lower (Name_Buffer (1 .. Name_Len));
 794                         Lang := Name_Find;
 795                         Language_Htable.Set (Lang, Lang);
 796
 797                      --  If no default language is declared, default to Ada
 798
 799                      else
 800                         Language_Htable.Set (Name_Ada, Name_Ada);
 801                      end if;
 802                   end if;
 803
 804                elsif Variable.Values /= Nil_String then
 805
 806                   --  Attribute Languages is declared with a non empty list:
 807                   --  put all the languages in Language_HTable.
 808
 809                   List := Variable.Values;
 810                   while List /= Nil_String loop
 811                      Elem := Shared.String_Elements.Table (List);
 812
 813                      Get_Name_String (Elem.Value);
 814                      To_Lower (Name_Buffer (1 .. Name_Len));
 815                      Lang := Name_Find;
 816                      Language_Htable.Set (Lang, Lang);
 817
 818                      List := Elem.Next;
 819                   end loop;
 820                end if;
 821             end if;
 822          end Add_Config_Switches_For_Project;
 823
 824          procedure For_Every_Imported_Project is new For_Every_Project_Imported
 825            (State => Integer, Action => Add_Config_Switches_For_Project);
 826          --  Document this procedure ???
 827
 828          --  Local variables
 829
 830          Name     : Name_Id;
 831          Count    : Natural;
 832          Result   : Argument_List_Access;
 833          Variable : Variable_Value;
 834          Dummy    : Integer := 0;
 835
 836       --  Start of processing for Get_Config_Switches
 837
 838       begin
 839          For_Every_Imported_Project
 840            (By                 => Project,
 841             Tree               => Project_Tree,
 842             With_State         => Dummy,
 843             Include_Aggregated => True);
 844
 845          Name  := Language_Htable.Get_First;
 846          Count := 0;
 847          while Name /= No_Name loop
 848             Count := Count + 1;
 849             Name := Language_Htable.Get_Next;
 850          end loop;
 851
 852          Result := new String_List (1 .. Count);
 853
 854          Count := 1;
 855          Name  := Language_Htable.Get_First;
 856          while Name /= No_Name loop
 857
 858             --  Check if IDE'Compiler_Command is declared for the language.
 859             --  If it is, use its value to invoke gprconfig.
 860
 861             Variable :=
 862               Value_Of
 863                 (Name,
 864                  Attribute_Or_Array_Name => Name_Compiler_Command,
 865                  In_Package              => IDE,
 866                  Shared                  => Shared,
 867                  Force_Lower_Case_Index  => True);
 868
 869             declare
 870                Config_Command : constant String :=
 871                                   "--config=" & Get_Name_String (Name);
 872
 873                Runtime_Name   : constant String :=
 874                                   Runtime_Name_For (Name);
 875
 876             begin
 877                if Variable = Nil_Variable_Value
 878                  or else Length_Of_Name (Variable.Value) = 0
 879                then
 880                   Result (Count) :=
 881                     new String'(Config_Command & ",," & Runtime_Name);
 882
 883                else
 884                   At_Least_One_Compiler_Command := True;
 885
 886                   declare
 887                      Compiler_Command : constant String :=
 888                                           Get_Name_String (Variable.Value);
 889
 890                   begin
 891                      if Is_Absolute_Path (Compiler_Command) then
 892                         Result (Count) :=
 893                           new String'
 894                             (Config_Command & ",," & Runtime_Name & "," &
 895                              Containing_Directory (Compiler_Command) & "," &
 896                              Simple_Name (Compiler_Command));
 897                      else
 898                         Result (Count) :=
 899                           new String'
 900                             (Config_Command & ",," & Runtime_Name & ",," &
 901                              Compiler_Command);
 902                      end if;
 903                   end;
 904                end if;
 905             end;
 906
 907             Count := Count + 1;
 908             Name  := Language_Htable.Get_Next;
 909          end loop;
 910
 911          return Result;
 912       end Get_Config_Switches;
 913
 914       -----------------
 915       -- Do_Autoconf --
 916       -----------------
 917
 918       procedure Do_Autoconf is
 919          Obj_Dir : constant Variable_Value :=
 920                      Value_Of
 921                        (Name_Object_Dir,
 922                         Project.Decl.Attributes,
 923                         Shared);
 924
 925          Gprconfig_Path  : String_Access;
 926          Success         : Boolean;
 927
 928       begin
 929          Gprconfig_Path := Locate_Exec_On_Path (Gprconfig_Name);
 930
 931          if Gprconfig_Path = null then
 932             Raise_Invalid_Config
 933               ("could not locate gprconfig for auto-configuration");
 934          end if;
 935
 936          --  First, find the object directory of the user's project
 937
 938          if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then
 939             Get_Name_String (Project.Directory.Display_Name);
 940
 941          else
 942             if Is_Absolute_Path (Get_Name_String (Obj_Dir.Value)) then
 943                Get_Name_String (Obj_Dir.Value);
 944
 945             else
 946                Name_Len := 0;
 947                Add_Str_To_Name_Buffer
 948                  (Get_Name_String (Project.Directory.Display_Name));
 949                Add_Str_To_Name_Buffer (Get_Name_String (Obj_Dir.Value));
 950             end if;
 951          end if;
 952
 953          if Subdirs /= null then
 954             Add_Char_To_Name_Buffer (Directory_Separator);
 955             Add_Str_To_Name_Buffer (Subdirs.all);
 956          end if;
 957
 958          for J in 1 .. Name_Len loop
 959             if Name_Buffer (J) = '/' then
 960                Name_Buffer (J) := Directory_Separator;
 961             end if;
 962          end loop;
 963
 964          --  Make sure that Obj_Dir ends with a directory separator
 965
 966          if Name_Buffer (Name_Len) /= Directory_Separator then
 967             Name_Len := Name_Len + 1;
 968             Name_Buffer (Name_Len) := Directory_Separator;
 969          end if;
 970
 971          declare
 972             Obj_Dir         : constant String := Name_Buffer (1 .. Name_Len);
 973             Config_Switches : Argument_List_Access;
 974             Args            : Argument_List (1 .. 5);
 975             Arg_Last        : Positive;
 976             Obj_Dir_Exists  : Boolean := True;
 977
 978          begin
 979             --  Check if the object directory exists. If Setup_Projects is True
 980             --  (-p) and directory does not exist, attempt to create it.
 981             --  Otherwise, if directory does not exist, fail without calling
 982             --  gprconfig.
 983
 984             if not Is_Directory (Obj_Dir)
 985               and then (Setup_Projects or else Subdirs /= null)
 986             then
 987                begin
 988                   Create_Path (Obj_Dir);
 989
 990                   if not Quiet_Output then
 991                      Write_Str ("object directory """);
 992                      Write_Str (Obj_Dir);
 993                      Write_Line (""" created");
 994                   end if;
 995
 996                exception
 997                   when others =>
 998                      Raise_Invalid_Config
 999                        ("could not create object directory " & Obj_Dir);
1000                end;
1001             end if;
1002
1003             if not Is_Directory (Obj_Dir) then
1004                case Env.Flags.Require_Obj_Dirs is
1005                   when Error =>
1006                      Raise_Invalid_Config
1007                        ("object directory " & Obj_Dir & " does not exist");
1008
1009                   when Warning =>
1010                      Prj.Err.Error_Msg
1011                        (Env.Flags,
1012                         "?object directory " & Obj_Dir & " does not exist");
1013                      Obj_Dir_Exists := False;
1014
1015                   when Silent =>
1016                      null;
1017                end case;
1018             end if;
1019
1020             --  If no switch --RTS have been specified on the command line,
1021             --  look for --RTS switches in the Builder switches.
1022
1023             if RTS_Languages.Get_First = No_Name then
1024                declare
1025                   Builder : constant Package_Id :=
1026                               Value_Of
1027                                 (Name_Builder, Project.Decl.Packages, Shared);
1028                   Switch_Array_Id : Array_Element_Id;
1029
1030                   procedure Check_RTS_Switches;
1031                   --  Take into account eventual switches --RTS in
1032                   --  Switch_Array_Id.
1033
1034                   ------------------------
1035                   -- Check_RTS_SWitches --
1036                   ------------------------
1037
1038                   procedure Check_RTS_Switches is
1039                      Switch_Array : Array_Element;
1040                      Switch_List  : String_List_Id := Nil_String;
1041                      Switch       : String_Element;
1042                      Lang         : Name_Id;
1043                      Lang_Last    : Positive;
1044
1045                   begin
1046                      while Switch_Array_Id /= No_Array_Element loop
1047                         Switch_Array :=
1048                           Shared.Array_Elements.Table (Switch_Array_Id);
1049
1050                         Switch_List := Switch_Array.Value.Values;
1051                         while Switch_List /= Nil_String loop
1052                            Switch :=
1053                              Shared.String_Elements.Table (Switch_List);
1054
1055                            if Switch.Value /= No_Name then
1056                               Get_Name_String (Switch.Value);
1057
1058                               if Name_Len >= 7 and then
1059                                 Name_Buffer (1 .. 5) = "--RTS"
1060                               then
1061                                  if Name_Buffer (6) = '=' then
1062                                     if not Runtime_Name_Set_For (Name_Ada) then
1063                                        Set_Runtime_For
1064                                          (Name_Ada,
1065                                           Name_Buffer (7 .. Name_Len));
1066                                     end if;
1067
1068                                  elsif Name_Len > 7 and then
1069                                    Name_Buffer (6) = ':' and then
1070                                    Name_Buffer (7) /= '='
1071                                  then
1072                                     Lang_Last := 7;
1073                                     while Lang_Last < Name_Len and then
1074                                       Name_Buffer (Lang_Last + 1) /= '='
1075                                     loop
1076                                        Lang_Last := Lang_Last + 1;
1077                                     end loop;
1078
1079                                     if Name_Buffer (Lang_Last + 1) = '=' then
1080                                        declare
1081                                           RTS : constant String :=
1082                                                   Name_Buffer (Lang_Last + 2 ..
1083                                                                Name_Len);
1084                                        begin
1085                                           Name_Buffer (1 .. Lang_Last - 6) :=
1086                                             Name_Buffer (7 .. Lang_Last);
1087                                           Name_Len := Lang_Last - 6;
1088                                           To_Lower
1089                                             (Name_Buffer (1 .. Name_Len));
1090                                           Lang := Name_Find;
1091
1092                                           if not
1093                                             Runtime_Name_Set_For (Lang)
1094                                           then
1095                                              Set_Runtime_For (Lang, RTS);
1096                                           end if;
1097                                        end;
1098                                     end if;
1099                                  end if;
1100                               end if;
1101                            end if;
1102
1103                            Switch_List := Switch.Next;
1104                         end loop;
1105
1106                         Switch_Array_Id := Switch_Array.Next;
1107                      end loop;
1108                   end Check_RTS_Switches;
1109
1110                begin
1111                   if Builder /= No_Package then
1112                      Switch_Array_Id :=
1113                        Value_Of
1114                          (Name      => Name_Switches,
1115                           In_Arrays =>
1116                             Shared.Packages.Table (Builder).Decl.Arrays,
1117                           Shared    => Shared);
1118                      Check_RTS_Switches;
1119
1120                      Switch_Array_Id :=
1121                        Value_Of
1122                          (Name      => Name_Default_Switches,
1123                           In_Arrays =>
1124                             Shared.Packages.Table (Builder).Decl.Arrays,
1125                           Shared    => Shared);
1126                      Check_RTS_Switches;
1127                   end if;
1128                end;
1129             end if;
1130
1131             --  Get the config switches. This should be done only now, as some
1132             --  runtimes may have been found if the Builder switches.
1133
1134             Config_Switches := Get_Config_Switches;
1135
1136             --  Invoke gprconfig
1137
1138             Args (1) := new String'("--batch");
1139             Args (2) := new String'("-o");
1140
1141             --  If no config file was specified, set the auto.cgpr one
1142
1143             if Config_File_Name = "" then
1144                if Obj_Dir_Exists then
1145                   Args (3) := new String'(Obj_Dir & Auto_Cgpr);
1146
1147                else
1148                   declare
1149                      Path_FD   : File_Descriptor;
1150                      Path_Name : Path_Name_Type;
1151
1152                   begin
1153                      Prj.Env.Create_Temp_File
1154                        (Shared    => Project_Tree.Shared,
1155                         Path_FD   => Path_FD,
1156                         Path_Name => Path_Name,
1157                         File_Use  => "configuration file");
1158
1159                      if Path_FD /= Invalid_FD then
1160                         declare
1161                            Temp_Dir : constant String :=
1162                                         Containing_Directory
1163                                           (Get_Name_String (Path_Name));
1164                         begin
1165                            GNAT.OS_Lib.Close (Path_FD);
1166                            Args (3) :=
1167                              new String'(Temp_Dir &
1168                                          Directory_Separator &
1169                                          Auto_Cgpr);
1170                            Delete_File (Get_Name_String (Path_Name));
1171                         end;
1172
1173                      else
1174                         --  We'll have an error message later on
1175
1176                         Args (3) := new String'(Obj_Dir & Auto_Cgpr);
1177                      end if;
1178                   end;
1179                end if;
1180             else
1181                Args (3) := new String'(Config_File_Name);
1182             end if;
1183
1184             if Normalized_Hostname = "" then
1185                Arg_Last := 3;
1186             else
1187                if Target_Name = "" then
1188                   if At_Least_One_Compiler_Command then
1189                      Args (4) := new String'("--target=all");
1190
1191                   else
1192                      Args (4) :=
1193                        new String'("--target=" & Normalized_Hostname);
1194                   end if;
1195
1196                else
1197                   Args (4) := new String'("--target=" & Target_Name);
1198                end if;
1199
1200                Arg_Last := 4;
1201             end if;
1202
1203             if not Verbose_Mode then
1204                Arg_Last := Arg_Last + 1;
1205                Args (Arg_Last) := new String'("-q");
1206             end if;
1207
1208             if Verbose_Mode then
1209                Write_Str (Gprconfig_Name);
1210
1211                for J in 1 .. Arg_Last loop
1212                   Write_Char (' ');
1213                   Write_Str (Args (J).all);
1214                end loop;
1215
1216                for J in Config_Switches'Range loop
1217                   Write_Char (' ');
1218                   Write_Str (Config_Switches (J).all);
1219                end loop;
1220
1221                Write_Eol;
1222
1223             elsif not Quiet_Output then
1224                --  Display no message if we are creating auto.cgpr, unless in
1225                --  verbose mode
1226
1227                if Config_File_Name /= ""
1228                  or else Verbose_Mode
1229                then
1230                   Write_Str ("creating ");
1231                   Write_Str (Simple_Name (Args (3).all));
1232                   Write_Eol;
1233                end if;
1234             end if;
1235
1236             Spawn (Gprconfig_Path.all, Args (1 .. Arg_Last) &
1237                    Config_Switches.all,
1238                    Success);
1239
1240             Free (Config_Switches);
1241
1242             Config_File_Path := Locate_Config_File (Args (3).all);
1243
1244             if Config_File_Path = null then
1245                Raise_Invalid_Config
1246                  ("could not create " & Args (3).all);
1247             end if;
1248
1249             for F in Args'Range loop
1250                Free (Args (F));
1251             end loop;
1252          end;
1253       end Do_Autoconf;
1254
1255       Success             : Boolean;
1256       Config_Project_Node : Project_Node_Id := Empty_Node;
1257
1258    begin
1259       pragma Assert (Prj.Env.Is_Initialized (Env.Project_Path));
1260
1261       Free (Config_File_Path);
1262       Config := No_Project;
1263
1264       if Config_File_Name /= "" then
1265          Config_File_Path := Locate_Config_File (Config_File_Name);
1266       else
1267          Config_File_Path := Locate_Config_File (Default_File_Name);
1268       end if;
1269
1270       if Config_File_Path = null then
1271          if (not Allow_Automatic_Generation)
1272            and then Config_File_Name /= ""
1273          then
1274             Raise_Invalid_Config
1275               ("could not locate main configuration project "
1276                & Config_File_Name);
1277          end if;
1278       end if;
1279
1280       Automatically_Generated :=
1281         Allow_Automatic_Generation and then Config_File_Path = null;
1282
1283       <<Process_Config_File>>
1284
1285       if Automatically_Generated then
1286          if Hostparm.OpenVMS then
1287
1288             --  There is no gprconfig on VMS
1289
1290             Raise_Invalid_Config
1291               ("could not locate any configuration project file");
1292
1293          else
1294             --  This might raise an Invalid_Config exception
1295
1296             Do_Autoconf;
1297          end if;
1298
1299       --  If the config file is not auto-generated, warn if there is any --RTS
1300       --  switch on the command line.
1301
1302       elsif RTS_Languages.Get_First /= No_Name
1303         and then Opt.Warning_Mode /= Opt.Suppress
1304       then
1305          Write_Line
1306            ("warning: --RTS is taken into account only in auto-configuration");
1307       end if;
1308
1309       --  Parse the configuration file
1310
1311       if Verbose_Mode and then Config_File_Path /= null then
1312          Write_Str  ("Checking configuration ");
1313          Write_Line (Config_File_Path.all);
1314       end if;
1315
1316       if On_Load_Config /= null then
1317          On_Load_Config
1318            (Config_File       => Config_Project_Node,
1319             Project_Node_Tree => Project_Node_Tree);
1320
1321       elsif Config_File_Path /= null then
1322          Prj.Part.Parse
1323            (In_Tree           => Project_Node_Tree,
1324             Project           => Config_Project_Node,
1325             Project_File_Name => Config_File_Path.all,
1326             Errout_Handling   => Prj.Part.Finalize_If_Error,
1327             Packages_To_Check => Packages_To_Check,
1328             Current_Directory => Current_Directory,
1329             Is_Config_File    => True,
1330             Env               => Env);
1331       else
1332          Config_Project_Node := Empty_Node;
1333       end if;
1334
1335       if Config_Project_Node /= Empty_Node then
1336          Prj.Proc.Process_Project_Tree_Phase_1
1337            (In_Tree                => Project_Tree,
1338             Project                => Config,
1339             Packages_To_Check      => Packages_To_Check,
1340             Success                => Success,
1341             From_Project_Node      => Config_Project_Node,
1342             From_Project_Node_Tree => Project_Node_Tree,
1343             Env                    => Env,
1344             Reset_Tree             => False);
1345       end if;
1346
1347       if Config_Project_Node = Empty_Node
1348         or else Config = No_Project
1349       then
1350          Raise_Invalid_Config
1351            ("processing of configuration project """
1352             & Config_File_Path.all & """ failed");
1353       end if;
1354
1355       --  Check that the target of the configuration file is the one the user
1356       --  specified on the command line. We do not need to check that when in
1357       --  auto-conf mode, since the appropriate target was passed to gprconfig.
1358
1359       if not Automatically_Generated
1360         and then not
1361           Check_Target (Config, Autoconf_Specified, Project_Tree, Target_Name)
1362       then
1363          Automatically_Generated := True;
1364          goto Process_Config_File;
1365       end if;
1366    end Get_Or_Create_Configuration_File;
1367
1368    ------------------------
1369    -- Locate_Config_File --
1370    ------------------------
1371
1372    function Locate_Config_File (Name : String) return String_Access is
1373       Prefix_Path : constant String := Executable_Prefix_Path;
1374    begin
1375       if Prefix_Path'Length /= 0 then
1376          return Locate_Regular_File
1377            (Name,
1378             "." & Path_Separator &
1379             Prefix_Path & "share" & Directory_Separator & "gpr");
1380       else
1381          return Locate_Regular_File (Name, ".");
1382       end if;
1383    end Locate_Config_File;
1384
1385    ------------------------------------
1386    -- Parse_Project_And_Apply_Config --
1387    ------------------------------------
1388
1389    procedure Parse_Project_And_Apply_Config
1390      (Main_Project               : out Prj.Project_Id;
1391       User_Project_Node          : out Prj.Tree.Project_Node_Id;
1392       Config_File_Name           : String := "";
1393       Autoconf_Specified         : Boolean;
1394       Project_File_Name          : String;
1395       Project_Tree               : Prj.Project_Tree_Ref;
1396       Project_Node_Tree          : Prj.Tree.Project_Node_Tree_Ref;
1397       Env                        : in out Prj.Tree.Environment;
1398       Packages_To_Check          : String_List_Access;
1399       Allow_Automatic_Generation : Boolean := True;
1400       Automatically_Generated    : out Boolean;
1401       Config_File_Path           : out String_Access;
1402       Target_Name                : String := "";
1403       Normalized_Hostname        : String;
1404       On_Load_Config             : Config_File_Hook := null)
1405    is
1406    begin
1407       pragma Assert (Prj.Env.Is_Initialized (Env.Project_Path));
1408
1409       --  Parse the user project tree
1410
1411       Prj.Initialize (Project_Tree);
1412
1413       Main_Project := No_Project;
1414       Automatically_Generated := False;
1415
1416       Prj.Part.Parse
1417         (In_Tree           => Project_Node_Tree,
1418          Project           => User_Project_Node,
1419          Project_File_Name => Project_File_Name,
1420          Errout_Handling   => Prj.Part.Finalize_If_Error,
1421          Packages_To_Check => Packages_To_Check,
1422          Current_Directory => Current_Directory,
1423          Is_Config_File    => False,
1424          Env               => Env);
1425
1426       if User_Project_Node = Empty_Node then
1427          User_Project_Node := Empty_Node;
1428          return;
1429       end if;
1430
1431       Process_Project_And_Apply_Config
1432         (Main_Project               => Main_Project,
1433          User_Project_Node          => User_Project_Node,
1434          Config_File_Name           => Config_File_Name,
1435          Autoconf_Specified         => Autoconf_Specified,
1436          Project_Tree               => Project_Tree,
1437          Project_Node_Tree          => Project_Node_Tree,
1438          Env                        => Env,
1439          Packages_To_Check          => Packages_To_Check,
1440          Allow_Automatic_Generation => Allow_Automatic_Generation,
1441          Automatically_Generated    => Automatically_Generated,
1442          Config_File_Path           => Config_File_Path,
1443          Target_Name                => Target_Name,
1444          Normalized_Hostname        => Normalized_Hostname,
1445          On_Load_Config             => On_Load_Config);
1446    end Parse_Project_And_Apply_Config;
1447
1448    --------------------------------------
1449    -- Process_Project_And_Apply_Config --
1450    --------------------------------------
1451
1452    procedure Process_Project_And_Apply_Config
1453      (Main_Project               : out Prj.Project_Id;
1454       User_Project_Node          : Prj.Tree.Project_Node_Id;
1455       Config_File_Name           : String := "";
1456       Autoconf_Specified         : Boolean;
1457       Project_Tree               : Prj.Project_Tree_Ref;
1458       Project_Node_Tree          : Prj.Tree.Project_Node_Tree_Ref;
1459       Env                        : in out Prj.Tree.Environment;
1460       Packages_To_Check          : String_List_Access;
1461       Allow_Automatic_Generation : Boolean := True;
1462       Automatically_Generated    : out Boolean;
1463       Config_File_Path           : out String_Access;
1464       Target_Name                : String := "";
1465       Normalized_Hostname        : String;
1466       On_Load_Config             : Config_File_Hook := null;
1467       Reset_Tree                 : Boolean := True)
1468    is
1469       Shared              : constant Shared_Project_Tree_Data_Access :=
1470                               Project_Tree.Shared;
1471       Main_Config_Project : Project_Id;
1472       Success             : Boolean;
1473
1474    begin
1475       Main_Project := No_Project;
1476       Automatically_Generated := False;
1477
1478       Process_Project_Tree_Phase_1
1479         (In_Tree                => Project_Tree,
1480          Project                => Main_Project,
1481          Packages_To_Check      => Packages_To_Check,
1482          Success                => Success,
1483          From_Project_Node      => User_Project_Node,
1484          From_Project_Node_Tree => Project_Node_Tree,
1485          Env                    => Env,
1486          Reset_Tree             => Reset_Tree);
1487
1488       if not Success then
1489          Main_Project := No_Project;
1490          return;
1491       end if;
1492
1493       if Project_Tree.Source_Info_File_Name /= null then
1494          if not Is_Absolute_Path (Project_Tree.Source_Info_File_Name.all) then
1495             declare
1496                Obj_Dir : constant Variable_Value :=
1497                            Value_Of
1498                              (Name_Object_Dir,
1499                               Main_Project.Decl.Attributes,
1500                               Shared);
1501
1502             begin
1503                if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then
1504                   Get_Name_String (Main_Project.Directory.Display_Name);
1505
1506                else
1507                   if Is_Absolute_Path (Get_Name_String (Obj_Dir.Value)) then
1508                      Get_Name_String (Obj_Dir.Value);
1509
1510                   else
1511                      Name_Len := 0;
1512                      Add_Str_To_Name_Buffer
1513                        (Get_Name_String (Main_Project.Directory.Display_Name));
1514                      Add_Str_To_Name_Buffer (Get_Name_String (Obj_Dir.Value));
1515                   end if;
1516                end if;
1517
1518                Add_Char_To_Name_Buffer (Directory_Separator);
1519                Add_Str_To_Name_Buffer (Project_Tree.Source_Info_File_Name.all);
1520                Free (Project_Tree.Source_Info_File_Name);
1521                Project_Tree.Source_Info_File_Name :=
1522                  new String'(Name_Buffer (1 .. Name_Len));
1523             end;
1524          end if;
1525
1526          Read_Source_Info_File (Project_Tree);
1527       end if;
1528
1529       --  Find configuration file
1530
1531       Get_Or_Create_Configuration_File
1532         (Config                     => Main_Config_Project,
1533          Project                    => Main_Project,
1534          Project_Tree               => Project_Tree,
1535          Project_Node_Tree          => Project_Node_Tree,
1536          Env                        => Env,
1537          Allow_Automatic_Generation => Allow_Automatic_Generation,
1538          Config_File_Name           => Config_File_Name,
1539          Autoconf_Specified         => Autoconf_Specified,
1540          Target_Name                => Target_Name,
1541          Normalized_Hostname        => Normalized_Hostname,
1542          Packages_To_Check          => Packages_To_Check,
1543          Config_File_Path           => Config_File_Path,
1544          Automatically_Generated    => Automatically_Generated,
1545          On_Load_Config             => On_Load_Config);
1546
1547       Apply_Config_File (Main_Config_Project, Project_Tree);
1548
1549       --  Finish processing the user's project
1550
1551       Prj.Proc.Process_Project_Tree_Phase_2
1552         (In_Tree                => Project_Tree,
1553          Project                => Main_Project,
1554          Success                => Success,
1555          From_Project_Node      => User_Project_Node,
1556          From_Project_Node_Tree => Project_Node_Tree,
1557          Env                    => Env);
1558
1559       if Success then
1560          if Project_Tree.Source_Info_File_Name /= null
1561            and then not Project_Tree.Source_Info_File_Exists
1562          then
1563             Write_Source_Info_File (Project_Tree);
1564          end if;
1565
1566       else
1567          Main_Project := No_Project;
1568       end if;
1569    end Process_Project_And_Apply_Config;
1570
1571    --------------------------
1572    -- Raise_Invalid_Config --
1573    --------------------------
1574
1575    procedure Raise_Invalid_Config (Msg : String) is
1576    begin
1577       Raise_Exception (Invalid_Config'Identity, Msg);
1578    end Raise_Invalid_Config;
1579
1580    ----------------------
1581    -- Runtime_Name_For --
1582    ----------------------
1583
1584    function Runtime_Name_For (Language : Name_Id) return String is
1585    begin
1586       if RTS_Languages.Get (Language) /= No_Name then
1587          return Get_Name_String (RTS_Languages.Get (Language));
1588       else
1589          return "";
1590       end if;
1591    end Runtime_Name_For;
1592
1593    --------------------------
1594    -- Runtime_Name_Set_For --
1595    --------------------------
1596
1597    function Runtime_Name_Set_For (Language : Name_Id) return Boolean is
1598    begin
1599       return RTS_Languages.Get (Language) /= No_Name;
1600    end Runtime_Name_Set_For;
1601
1602    ---------------------
1603    -- Set_Runtime_For --
1604    ---------------------
1605
1606    procedure Set_Runtime_For (Language : Name_Id; RTS_Name : String) is
1607    begin
1608       Name_Len := RTS_Name'Length;
1609       Name_Buffer (1 .. Name_Len) := RTS_Name;
1610       RTS_Languages.Set (Language, Name_Find);
1611    end Set_Runtime_For;
1612
1613 end Prj.Conf;