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-2009, 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 2,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with Ada.Directories;  use Ada.Directories;
  28 with GNAT.HTable;      use GNAT.HTable;
  29 with Makeutl;          use Makeutl;
  30 with Opt;              use Opt;
  31 with Osint;            use Osint;
  32 with Output;           use Output;
  33 with Prj.Err;          use Prj.Err;
  34 with Prj.Part;
  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 Sinput.P;
  40 with Snames;           use Snames;
  41 with System.Case_Util; use System.Case_Util;
  42 with System;
  43
  44 package body Prj.Conf is
  45
  46    Auto_Cgpr : constant String := "auto.cgpr";
  47
  48    Default_Name : constant String := "default.cgpr";
  49    --  Default configuration file that will be used if found
  50
  51    Config_Project_Env_Var : constant String := "GPR_CONFIG";
  52    --  Name of the environment variable that provides the name of the
  53    --  configuration file to use.
  54
  55    Gprconfig_Name : constant String := "gprconfig";
  56
  57    package RTS_Languages is new GNAT.HTable.Simple_HTable
  58      (Header_Num => Prj.Header_Num,
  59       Element    => Name_Id,
  60       No_Element => No_Name,
  61       Key        => Name_Id,
  62       Hash       => Prj.Hash,
  63       Equal      => "=");
  64    --  Stores the runtime names for the various languages. This is in general
  65    --  set from a --RTS command line option.
  66
  67    procedure Add_Attributes
  68      (Project_Tree : Project_Tree_Ref;
  69       Conf_Decl    : Declarations;
  70       User_Decl    : in out Declarations);
  71    --  Process the attributes in the config declarations.
  72    --  For single string values, if the attribute is not declared in the user
  73    --  declarations, declare it with the value in the config declarations.
  74    --  For string list values, prepend the value in the user declarations with
  75    --  the value in the config declarations.
  76
  77    function Locate_Config_File (Name : String) return String_Access;
  78    --  Search for Name in the config files directory. Return full path if
  79    --  found, or null otherwise
  80
  81    function Check_Target
  82      (Config_File        : Prj.Project_Id;
  83       Autoconf_Specified : Boolean;
  84       Project_Tree       : Prj.Project_Tree_Ref;
  85       Target             : String := "") return Boolean;
  86    --  Check that the config file's target matches Target. Target should be
  87    --  set to the empty string when the user did not specify a target. If the
  88    --  target in the configuration file is invalid, this function will call
  89    --  Osint.Fail to report a fatal error message and stop the program.
  90    --  Autoconf_Specified should be set to True if the user has used
  91    --  autoconf.
  92
  93    --------------------
  94    -- Add_Attributes --
  95    --------------------
  96
  97    procedure Add_Attributes
  98      (Project_Tree : Project_Tree_Ref;
  99       Conf_Decl    : Declarations;
 100       User_Decl    : in out Declarations)
 101    is
 102       Conf_Attr_Id       : Variable_Id;
 103       Conf_Attr          : Variable;
 104       Conf_Array_Id      : Array_Id;
 105       Conf_Array         : Array_Data;
 106       Conf_Array_Elem_Id : Array_Element_Id;
 107       Conf_Array_Elem    : Array_Element;
 108       Conf_List          : String_List_Id;
 109       Conf_List_Elem     : String_Element;
 110
 111       User_Attr_Id       : Variable_Id;
 112       User_Attr          : Variable;
 113       User_Array_Id      : Array_Id;
 114       User_Array         : Array_Data;
 115       User_Array_Elem_Id : Array_Element_Id;
 116       User_Array_Elem    : Array_Element;
 117
 118    begin
 119       Conf_Attr_Id := Conf_Decl.Attributes;
 120       User_Attr_Id := User_Decl.Attributes;
 121       while Conf_Attr_Id /= No_Variable loop
 122          Conf_Attr :=
 123            Project_Tree.Variable_Elements.Table (Conf_Attr_Id);
 124          User_Attr :=
 125            Project_Tree.Variable_Elements.Table (User_Attr_Id);
 126
 127          if not Conf_Attr.Value.Default then
 128             if User_Attr.Value.Default then
 129
 130                --  No attribute declared in user project file: just copy the
 131                --  value of the configuration attribute.
 132
 133                User_Attr.Value := Conf_Attr.Value;
 134                Project_Tree.Variable_Elements.Table (User_Attr_Id) :=
 135                  User_Attr;
 136
 137             elsif User_Attr.Value.Kind = List
 138               and then Conf_Attr.Value.Values /= Nil_String
 139             then
 140                --  List attribute declared in both the user project and the
 141                --  configuration project: prepend the user list with the
 142                --  configuration list.
 143
 144                declare
 145                   Conf_List : String_List_Id := Conf_Attr.Value.Values;
 146                   Conf_Elem : String_Element;
 147                   User_List : constant String_List_Id :=
 148                                 User_Attr.Value.Values;
 149                   New_List : String_List_Id;
 150                   New_Elem : String_Element;
 151
 152                begin
 153                   --  Create new list
 154
 155                   String_Element_Table.Increment_Last
 156                     (Project_Tree.String_Elements);
 157                   New_List := String_Element_Table.Last
 158                     (Project_Tree.String_Elements);
 159
 160                   --  Value of attribute is new list
 161
 162                   User_Attr.Value.Values := New_List;
 163                   Project_Tree.Variable_Elements.Table (User_Attr_Id) :=
 164                     User_Attr;
 165
 166                   loop
 167
 168                      --  Get each element of configuration list
 169
 170                      Conf_Elem :=
 171                        Project_Tree.String_Elements.Table (Conf_List);
 172                      New_Elem := Conf_Elem;
 173                      Conf_List := Conf_Elem.Next;
 174
 175                      if Conf_List = Nil_String then
 176
 177                         --  If it is the last element in the list, connect to
 178                         --  first element of user list, and we are done.
 179
 180                         New_Elem.Next := User_List;
 181                         Project_Tree.String_Elements.Table
 182                           (New_List) := New_Elem;
 183                         exit;
 184
 185                      else
 186                         --  If it is not the last element in the list, add to
 187                         --  new list.
 188
 189                         String_Element_Table.Increment_Last
 190                           (Project_Tree.String_Elements);
 191                         New_Elem.Next :=
 192                           String_Element_Table.Last
 193                             (Project_Tree.String_Elements);
 194                         Project_Tree.String_Elements.Table
 195                           (New_List) := New_Elem;
 196                         New_List := New_Elem.Next;
 197                      end if;
 198                   end loop;
 199                end;
 200             end if;
 201          end if;
 202
 203          Conf_Attr_Id := Conf_Attr.Next;
 204          User_Attr_Id := User_Attr.Next;
 205       end loop;
 206
 207       Conf_Array_Id := Conf_Decl.Arrays;
 208       while Conf_Array_Id /= No_Array loop
 209          Conf_Array := Project_Tree.Arrays.Table (Conf_Array_Id);
 210
 211          User_Array_Id := User_Decl.Arrays;
 212          while User_Array_Id /= No_Array loop
 213             User_Array := Project_Tree.Arrays.Table (User_Array_Id);
 214             exit when User_Array.Name = Conf_Array.Name;
 215             User_Array_Id := User_Array.Next;
 216          end loop;
 217
 218          --  If this associative array does not exist in the user project file,
 219          --  do a shallow copy of the full associative array.
 220
 221          if User_Array_Id = No_Array then
 222             Array_Table.Increment_Last (Project_Tree.Arrays);
 223             User_Array := Conf_Array;
 224             User_Array.Next := User_Decl.Arrays;
 225             User_Decl.Arrays := Array_Table.Last (Project_Tree.Arrays);
 226             Project_Tree.Arrays.Table (User_Decl.Arrays) := User_Array;
 227
 228          else
 229             --  Otherwise, check each array element
 230
 231             Conf_Array_Elem_Id := Conf_Array.Value;
 232             while Conf_Array_Elem_Id /= No_Array_Element loop
 233                Conf_Array_Elem :=
 234                  Project_Tree.Array_Elements.Table (Conf_Array_Elem_Id);
 235
 236                User_Array_Elem_Id := User_Array.Value;
 237                while User_Array_Elem_Id /= No_Array_Element loop
 238                   User_Array_Elem :=
 239                     Project_Tree.Array_Elements.Table (User_Array_Elem_Id);
 240                   exit when User_Array_Elem.Index = Conf_Array_Elem.Index;
 241                   User_Array_Elem_Id := User_Array_Elem.Next;
 242                end loop;
 243
 244                --  If the array element does not exist in the user array,
 245                --  insert a shallow copy of the conf array element in the
 246                --  user array.
 247
 248                if User_Array_Elem_Id = No_Array_Element then
 249                   Array_Element_Table.Increment_Last
 250                     (Project_Tree.Array_Elements);
 251                   User_Array_Elem := Conf_Array_Elem;
 252                   User_Array_Elem.Next := User_Array.Value;
 253                   User_Array.Value :=
 254                     Array_Element_Table.Last (Project_Tree.Array_Elements);
 255                   Project_Tree.Array_Elements.Table (User_Array.Value) :=
 256                     User_Array_Elem;
 257                   Project_Tree.Arrays.Table (User_Array_Id) := User_Array;
 258
 259                --  Otherwise, if the value is a string list, prepend the
 260                --  user array element with the conf array element value.
 261
 262                elsif Conf_Array_Elem.Value.Kind = List then
 263                   Conf_List := Conf_Array_Elem.Value.Values;
 264
 265                   if Conf_List /= Nil_String then
 266                      declare
 267                         Link     : constant String_List_Id :=
 268                                      User_Array_Elem.Value.Values;
 269                         Previous : String_List_Id := Nil_String;
 270                         Next     : String_List_Id;
 271
 272                      begin
 273                         loop
 274                            Conf_List_Elem :=
 275                              Project_Tree.String_Elements.Table
 276                                (Conf_List);
 277                            String_Element_Table.Increment_Last
 278                              (Project_Tree.String_Elements);
 279                            Next :=
 280                              String_Element_Table.Last
 281                                (Project_Tree.String_Elements);
 282                            Project_Tree.String_Elements.Table (Next) :=
 283                              Conf_List_Elem;
 284
 285                            if Previous = Nil_String then
 286                               User_Array_Elem.Value.Values := Next;
 287                               Project_Tree.Array_Elements.Table
 288                                 (User_Array_Elem_Id) := User_Array_Elem;
 289
 290                            else
 291                               Project_Tree.String_Elements.Table
 292                                 (Previous).Next := Next;
 293                            end if;
 294
 295                            Previous := Next;
 296
 297                            Conf_List := Conf_List_Elem.Next;
 298
 299                            if Conf_List = Nil_String then
 300                               Project_Tree.String_Elements.Table
 301                                 (Previous).Next := Link;
 302                               exit;
 303                            end if;
 304                         end loop;
 305                      end;
 306                   end if;
 307                end if;
 308
 309                Conf_Array_Elem_Id := Conf_Array_Elem.Next;
 310             end loop;
 311          end if;
 312
 313          Conf_Array_Id := Conf_Array.Next;
 314       end loop;
 315    end Add_Attributes;
 316
 317    ------------------------
 318    -- Locate_Config_File --
 319    ------------------------
 320
 321    function Locate_Config_File (Name : String) return String_Access is
 322       Prefix_Path : constant String := Executable_Prefix_Path;
 323    begin
 324       if Prefix_Path'Length /= 0 then
 325          return Locate_Regular_File
 326            (Name,
 327             "." & Path_Separator &
 328             Prefix_Path & "share" & Directory_Separator & "gpr");
 329       else
 330          return Locate_Regular_File (Name, ".");
 331       end if;
 332    end Locate_Config_File;
 333
 334    ------------------
 335    -- Check_Target --
 336    ------------------
 337
 338    function Check_Target
 339      (Config_File  : Project_Id;
 340       Autoconf_Specified : Boolean;
 341       Project_Tree : Prj.Project_Tree_Ref;
 342       Target       : String := "") return Boolean
 343    is
 344       Variable : constant Variable_Value :=
 345                    Value_Of
 346                      (Name_Target, Config_File.Decl.Attributes, Project_Tree);
 347       Tgt_Name : Name_Id := No_Name;
 348       OK       : Boolean;
 349
 350    begin
 351       if Variable /= Nil_Variable_Value and then not Variable.Default then
 352          Tgt_Name := Variable.Value;
 353       end if;
 354
 355       if Target = "" then
 356          OK := not Autoconf_Specified or Tgt_Name = No_Name;
 357       else
 358          OK := Tgt_Name /= No_Name
 359                  and then Target = Get_Name_String (Tgt_Name);
 360       end if;
 361
 362       if not OK then
 363          if Autoconf_Specified then
 364             if Verbose_Mode then
 365                Write_Line ("inconsistent targets, performing autoconf");
 366             end if;
 367
 368             return False;
 369
 370          else
 371             if Tgt_Name /= No_Name then
 372                Osint.Fail ("invalid target name """ &
 373                            Get_Name_String (Tgt_Name) &
 374                            """ in configuration");
 375
 376             else
 377                Osint.Fail ("no target specified in configuration file");
 378             end if;
 379          end if;
 380       end if;
 381
 382       return True;
 383    end Check_Target;
 384
 385    --------------------------------------
 386    -- Get_Or_Create_Configuration_File --
 387    --------------------------------------
 388
 389    procedure Get_Or_Create_Configuration_File
 390      (Project                    : Project_Id;
 391       Project_Tree               : Project_Tree_Ref;
 392       Project_Node_Tree          : Prj.Tree.Project_Node_Tree_Ref;
 393       Allow_Automatic_Generation : Boolean;
 394       Config_File_Name           : String := "";
 395       Autoconf_Specified         : Boolean;
 396       Target_Name                : String := "";
 397       Normalized_Hostname        : String;
 398       Packages_To_Check          : String_List_Access := null;
 399       Config                     : out Prj.Project_Id;
 400       Config_File_Path           : out String_Access;
 401       Automatically_Generated    : out Boolean)
 402    is
 403       function Default_File_Name return String;
 404       --  Return the name of the default config file that should be tested
 405
 406       procedure Do_Autoconf;
 407       --  Generate a new config file through gprconfig
 408
 409       function Get_Config_Switches return Argument_List_Access;
 410       --  Return the --config switches to use for gprconfig
 411
 412       function Might_Have_Sources (Project : Project_Id) return Boolean;
 413       --  True if the specified project might have sources (ie the user has not
 414       --  explicitly specified it. We haven't checked the file system, nor do
 415       --  we need to at this stage.
 416
 417       -----------------------
 418       -- Default_File_Name --
 419       -----------------------
 420
 421       function Default_File_Name return String is
 422          Ada_RTS : constant String := Runtime_Name_For (Name_Ada);
 423          Tmp     : String_Access;
 424
 425       begin
 426          if Target_Name /= "" then
 427             if Ada_RTS /= "" then
 428                return Target_Name & '-' & Ada_RTS
 429                  & Config_Project_File_Extension;
 430             else
 431                return Target_Name & Config_Project_File_Extension;
 432             end if;
 433
 434          elsif Ada_RTS /= "" then
 435             return Ada_RTS & Config_Project_File_Extension;
 436
 437          else
 438             Tmp := Getenv (Config_Project_Env_Var);
 439
 440             declare
 441                T : constant String := Tmp.all;
 442             begin
 443                Free (Tmp);
 444
 445                if T'Length = 0 then
 446                   return Default_Name;
 447                else
 448                   return T;
 449                end if;
 450             end;
 451          end if;
 452       end Default_File_Name;
 453
 454       ------------------------
 455       -- Might_Have_Sources --
 456       ------------------------
 457
 458       function Might_Have_Sources (Project : Project_Id) return Boolean is
 459          Variable : Variable_Value;
 460
 461       begin
 462          Variable :=
 463            Value_Of
 464              (Name_Source_Dirs,
 465               Project.Decl.Attributes,
 466               Project_Tree);
 467
 468          if Variable = Nil_Variable_Value
 469            or else Variable.Default
 470            or else Variable.Values /= Nil_String
 471          then
 472             Variable :=
 473               Value_Of
 474                 (Name_Source_Files,
 475                  Project.Decl.Attributes,
 476                  Project_Tree);
 477             return Variable = Nil_Variable_Value
 478               or else Variable.Default
 479               or else Variable.Values /= Nil_String;
 480
 481          else
 482             return False;
 483          end if;
 484       end Might_Have_Sources;
 485
 486       -------------------------
 487       -- Get_Config_Switches --
 488       -------------------------
 489
 490       function Get_Config_Switches return Argument_List_Access is
 491          package Language_Htable is new GNAT.HTable.Simple_HTable
 492            (Header_Num => Prj.Header_Num,
 493             Element    => Name_Id,
 494             No_Element => No_Name,
 495             Key        => Name_Id,
 496             Hash       => Prj.Hash,
 497             Equal      => "=");
 498          --  Hash table to keep the languages used in the project tree
 499
 500          IDE : constant Package_Id :=
 501                  Value_Of
 502                    (Name_Ide,
 503                     Project.Decl.Packages,
 504                     Project_Tree);
 505
 506          Prj_Iter : Project_List;
 507          List     : String_List_Id;
 508          Elem     : String_Element;
 509          Lang     : Name_Id;
 510          Variable : Variable_Value;
 511          Name     : Name_Id;
 512          Count    : Natural;
 513          Result   : Argument_List_Access;
 514
 515       begin
 516          Prj_Iter := Project_Tree.Projects;
 517          while Prj_Iter /= null loop
 518             if Might_Have_Sources (Prj_Iter.Project) then
 519                Variable :=
 520                  Value_Of
 521                    (Name_Languages,
 522                     Prj_Iter.Project.Decl.Attributes,
 523                     Project_Tree);
 524
 525                if Variable = Nil_Variable_Value
 526                  or else Variable.Default
 527                then
 528                   --  Languages is not declared. If it is not an extending
 529                   --  project, check for Default_Language
 530
 531                   if Prj_Iter.Project.Extends = No_Project then
 532                      Variable :=
 533                        Value_Of
 534                          (Name_Default_Language,
 535                           Prj_Iter.Project.Decl.Attributes,
 536                           Project_Tree);
 537
 538                      if Variable /= Nil_Variable_Value
 539                        and then not Variable.Default
 540                      then
 541                         Get_Name_String (Variable.Value);
 542                         To_Lower (Name_Buffer (1 .. Name_Len));
 543                         Lang := Name_Find;
 544                         Language_Htable.Set (Lang, Lang);
 545
 546                      else
 547                         --  If no language is declared, default to Ada
 548
 549                         Language_Htable.Set (Name_Ada, Name_Ada);
 550                      end if;
 551                   end if;
 552
 553                elsif Variable.Values /= Nil_String then
 554
 555                   --  Attribute Languages is declared with a non empty
 556                   --  list: put all the languages in Language_HTable.
 557
 558                   List := Variable.Values;
 559                   while List /= Nil_String loop
 560                      Elem := Project_Tree.String_Elements.Table (List);
 561
 562                      Get_Name_String (Elem.Value);
 563                      To_Lower (Name_Buffer (1 .. Name_Len));
 564                      Lang := Name_Find;
 565                      Language_Htable.Set (Lang, Lang);
 566
 567                      List := Elem.Next;
 568                   end loop;
 569                end if;
 570             end if;
 571
 572             Prj_Iter := Prj_Iter.Next;
 573          end loop;
 574
 575          Name  := Language_Htable.Get_First;
 576          Count := 0;
 577          while Name /= No_Name loop
 578             Count := Count + 1;
 579             Name := Language_Htable.Get_Next;
 580          end loop;
 581
 582          Result := new String_List (1 .. Count);
 583
 584          Count := 1;
 585          Name  := Language_Htable.Get_First;
 586          while Name /= No_Name loop
 587             --  Check if IDE'Compiler_Command is declared for the language.
 588             --  If it is, use its value to invoke gprconfig.
 589
 590             Variable :=
 591               Value_Of
 592                 (Name,
 593                  Attribute_Or_Array_Name => Name_Compiler_Command,
 594                  In_Package              => IDE,
 595                  In_Tree                 => Project_Tree,
 596                  Force_Lower_Case_Index  => True);
 597
 598             declare
 599                Config_Command : constant String :=
 600                  "--config=" & Get_Name_String (Name);
 601
 602                Runtime_Name   : constant String :=
 603                  Runtime_Name_For (Name);
 604
 605             begin
 606                if Variable = Nil_Variable_Value
 607                  or else Length_Of_Name (Variable.Value) = 0
 608                then
 609                   Result (Count) :=
 610                     new String'(Config_Command & ",," & Runtime_Name);
 611
 612                else
 613                   declare
 614                      Compiler_Command : constant String :=
 615                        Get_Name_String (Variable.Value);
 616
 617                   begin
 618                      if Is_Absolute_Path (Compiler_Command) then
 619                         Result (Count) :=
 620                           new String'
 621                             (Config_Command & ",," & Runtime_Name & "," &
 622                              Containing_Directory (Compiler_Command) & "," &
 623                              Simple_Name (Compiler_Command));
 624                      else
 625                         Result (Count) :=
 626                           new String'
 627                             (Config_Command & ",," & Runtime_Name & ",," &
 628                              Compiler_Command);
 629                      end if;
 630                   end;
 631                end if;
 632             end;
 633
 634             Count := Count + 1;
 635             Name  := Language_Htable.Get_Next;
 636          end loop;
 637
 638          return Result;
 639       end Get_Config_Switches;
 640
 641       -----------------
 642       -- Do_Autoconf --
 643       -----------------
 644
 645       procedure Do_Autoconf is
 646          Obj_Dir : constant Variable_Value :=
 647                      Value_Of
 648                        (Name_Object_Dir,
 649                         Project.Decl.Attributes,
 650                         Project_Tree);
 651
 652          Gprconfig_Path  : String_Access;
 653          Success         : Boolean;
 654
 655       begin
 656          Gprconfig_Path := Locate_Exec_On_Path (Gprconfig_Name);
 657
 658          if Gprconfig_Path = null then
 659             Fail ("could not locate gprconfig for auto-configuration");
 660          end if;
 661
 662          --  First, find the object directory of the user's project
 663
 664          if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then
 665             Get_Name_String (Project.Directory.Name);
 666
 667          else
 668             if Is_Absolute_Path (Get_Name_String (Obj_Dir.Value)) then
 669                Get_Name_String (Obj_Dir.Value);
 670
 671             else
 672                Name_Len := 0;
 673                Add_Str_To_Name_Buffer
 674                  (Get_Name_String (Project.Directory.Name));
 675                Add_Char_To_Name_Buffer (Directory_Separator);
 676                Add_Str_To_Name_Buffer (Get_Name_String (Obj_Dir.Value));
 677             end if;
 678          end if;
 679
 680          if Subdirs /= null then
 681             Add_Char_To_Name_Buffer (Directory_Separator);
 682             Add_Str_To_Name_Buffer (Subdirs.all);
 683          end if;
 684
 685          for J in 1 .. Name_Len loop
 686             if Name_Buffer (J) = '/' then
 687                Name_Buffer (J) := Directory_Separator;
 688             end if;
 689          end loop;
 690
 691          declare
 692             Obj_Dir  : constant String := Name_Buffer (1 .. Name_Len);
 693             Switches : Argument_List_Access := Get_Config_Switches;
 694             Args     : Argument_List (1 .. 5);
 695             Arg_Last : Positive;
 696
 697          begin
 698             --  Check if the object directory exists. If Setup_Projects is True
 699             --  (-p) and directory does not exist, attempt to create it.
 700             --  Otherwise, if directory does not exist, fail without calling
 701             --  gprconfig.
 702
 703             if not Is_Directory (Obj_Dir)
 704               and then (Setup_Projects or Subdirs /= null)
 705             then
 706                begin
 707                   Create_Path (Obj_Dir);
 708
 709                   if not Quiet_Output then
 710                      Write_Str ("object directory """);
 711                      Write_Str (Obj_Dir);
 712                      Write_Line (""" created");
 713                   end if;
 714
 715                exception
 716                   when others =>
 717                      Fail ("could not create object directory " & Obj_Dir);
 718                end;
 719             end if;
 720
 721             if not Is_Directory (Obj_Dir) then
 722                Fail ("object directory " & Obj_Dir & " does not exist");
 723             end if;
 724
 725             --  Invoke gprconfig
 726
 727             Args (1) := new String'("--batch");
 728             Args (2) := new String'("-o");
 729
 730             --  If no config file was specified, set the auto.cgpr one
 731
 732             if Config_File_Name = "" then
 733                Args (3) := new String'
 734                  (Obj_Dir & Directory_Separator & Auto_Cgpr);
 735             else
 736                Args (3) := new String'(Config_File_Name);
 737             end if;
 738
 739             if Target_Name = "" then
 740                Args (4) := new String'("--target=" & Normalized_Hostname);
 741             else
 742                Args (4) := new String'("--target=" & Target_Name);
 743             end if;
 744
 745             Arg_Last := 4;
 746
 747             if not Verbose_Mode then
 748                Arg_Last := Arg_Last + 1;
 749                Args (Arg_Last) := new String'("-q");
 750             end if;
 751
 752             if Verbose_Mode then
 753                Write_Str (Gprconfig_Name);
 754
 755                for J in 1 .. Arg_Last loop
 756                   Write_Char (' ');
 757                   Write_Str (Args (J).all);
 758                end loop;
 759
 760                for J in Switches'Range loop
 761                   Write_Char (' ');
 762                   Write_Str (Switches (J).all);
 763                end loop;
 764
 765                Write_Eol;
 766
 767             elsif not Quiet_Output then
 768                Write_Str ("creating ");
 769                Write_Str (Simple_Name (Args (3).all));
 770                Write_Eol;
 771             end if;
 772
 773             Spawn (Gprconfig_Path.all, Args (1 .. Arg_Last) & Switches.all,
 774                    Success);
 775
 776             Free (Switches);
 777
 778             Config_File_Path := Locate_Config_File (Args (3).all);
 779
 780             if Config_File_Path = null then
 781                Fail ("could not create " & Args (3).all);
 782             end if;
 783
 784             for F in Args'Range loop
 785                Free (Args (F));
 786             end loop;
 787          end;
 788       end Do_Autoconf;
 789
 790       Success             : Boolean;
 791       Config_Project_Node : Project_Node_Id := Empty_Node;
 792
 793    begin
 794       Free (Config_File_Path);
 795
 796       if Config_File_Name /= "" then
 797          Config_File_Path := Locate_Config_File (Config_File_Name);
 798       else
 799          Config_File_Path := Locate_Config_File (Default_File_Name);
 800       end if;
 801
 802       if Config_File_Path = null then
 803          if (not Allow_Automatic_Generation) and then
 804             Config_File_Name /= ""
 805          then
 806             Osint.Fail
 807               ("could not locate main configuration project " &
 808                Config_File_Name);
 809          end if;
 810       end if;
 811
 812       Automatically_Generated :=
 813         Allow_Automatic_Generation and then Config_File_Path = null;
 814
 815       <<Process_Config_File>>
 816
 817       if Automatically_Generated then
 818          Do_Autoconf;
 819       end if;
 820
 821       --  Parse the configuration file
 822
 823       if Verbose_Mode then
 824          Write_Str  ("Checking configuration ");
 825          Write_Line (Config_File_Path.all);
 826       end if;
 827
 828       Prj.Part.Parse
 829         (In_Tree                => Project_Node_Tree,
 830          Project                => Config_Project_Node,
 831          Project_File_Name      => Config_File_Path.all,
 832          Always_Errout_Finalize => False,
 833          Packages_To_Check      => Packages_To_Check,
 834          Current_Directory      => Current_Directory,
 835          Is_Config_File         => True);
 836
 837       if Config_Project_Node /= Empty_Node then
 838          Prj.Proc.Process_Project_Tree_Phase_1
 839            (In_Tree                => Project_Tree,
 840             Project                => Config,
 841             Success                => Success,
 842             From_Project_Node      => Config_Project_Node,
 843             From_Project_Node_Tree => Project_Node_Tree,
 844             Report_Error           => null,
 845             Reset_Tree             => False);
 846       end if;
 847
 848       if Config_Project_Node = Empty_Node
 849         or else Config = No_Project
 850       then
 851          Osint.Fail
 852            ("processing of configuration project """ &
 853             Config_File_Path.all & """ failed");
 854       end if;
 855
 856       --  Check that the target of the configuration file is the one the user
 857       --  specified on the command line. We do not need to check that when in
 858       --  auto-conf mode, since the appropriate target was passed to gprconfig.
 859
 860       if not Automatically_Generated
 861         and not Check_Target
 862           (Config, Autoconf_Specified, Project_Tree, Target_Name)
 863       then
 864          Automatically_Generated := True;
 865          goto Process_Config_File;
 866       end if;
 867    end Get_Or_Create_Configuration_File;
 868
 869    ------------------------------------
 870    -- Parse_Project_And_Apply_Config --
 871    ------------------------------------
 872
 873    procedure Parse_Project_And_Apply_Config
 874      (Main_Project               : out Prj.Project_Id;
 875       User_Project_Node          : out Prj.Tree.Project_Node_Id;
 876       Config_File_Name           : String := "";
 877       Autoconf_Specified         : Boolean;
 878       Project_File_Name          : String;
 879       Project_Tree               : Prj.Project_Tree_Ref;
 880       Project_Node_Tree          : Prj.Tree.Project_Node_Tree_Ref;
 881       Packages_To_Check          : String_List_Access;
 882       Allow_Automatic_Generation : Boolean := True;
 883       Automatically_Generated    : out Boolean;
 884       Config_File_Path           : out String_Access;
 885       Target_Name                : String := "";
 886       Normalized_Hostname        : String;
 887       On_Load_Config             : Config_File_Hook := null)
 888    is
 889       Main_Config_Project : Project_Id;
 890       Success : Boolean;
 891
 892    begin
 893       --  Parse the user project tree
 894
 895       Prj.Initialize (Project_Tree);
 896       Prj.Tree.Initialize (Project_Node_Tree);
 897
 898       Main_Project := No_Project;
 899       Automatically_Generated := False;
 900
 901       Prj.Part.Parse
 902         (In_Tree                => Project_Node_Tree,
 903          Project                => User_Project_Node,
 904          Project_File_Name      => Project_File_Name,
 905          Always_Errout_Finalize => False,
 906          Packages_To_Check      => Packages_To_Check,
 907          Current_Directory      => Current_Directory,
 908          Is_Config_File         => False);
 909
 910       if User_Project_Node = Empty_Node then
 911          User_Project_Node := Empty_Node;
 912          return;
 913       end if;
 914
 915       Process_Project_Tree_Phase_1
 916         (In_Tree                => Project_Tree,
 917          Project                => Main_Project,
 918          Success                => Success,
 919          From_Project_Node      => User_Project_Node,
 920          From_Project_Node_Tree => Project_Node_Tree,
 921          Report_Error           => null);
 922
 923       if not Success then
 924          Main_Project := No_Project;
 925          return;
 926       end if;
 927
 928       --  Find configuration file
 929
 930       Get_Or_Create_Configuration_File
 931         (Config                     => Main_Config_Project,
 932          Project                    => Main_Project,
 933          Project_Tree               => Project_Tree,
 934          Project_Node_Tree          => Project_Node_Tree,
 935          Allow_Automatic_Generation => Allow_Automatic_Generation,
 936          Config_File_Name           => Config_File_Name,
 937          Autoconf_Specified         => Autoconf_Specified,
 938          Target_Name                => Target_Name,
 939          Normalized_Hostname        => Normalized_Hostname,
 940          Packages_To_Check          => Packages_To_Check,
 941          Config_File_Path           => Config_File_Path,
 942          Automatically_Generated    => Automatically_Generated);
 943
 944       if On_Load_Config /= null then
 945          On_Load_Config
 946            (Config_File  => Main_Config_Project,
 947             Project_Tree => Project_Tree);
 948       end if;
 949
 950       Apply_Config_File (Main_Config_Project, Project_Tree);
 951
 952       --  Finish processing the user's project
 953
 954       Sinput.P.Reset_First;
 955
 956       Prj.Proc.Process_Project_Tree_Phase_2
 957         (In_Tree                => Project_Tree,
 958          Project                => Main_Project,
 959          Success                => Success,
 960          From_Project_Node      => User_Project_Node,
 961          From_Project_Node_Tree => Project_Node_Tree,
 962          Report_Error           => null,
 963          Current_Dir            => Current_Directory,
 964          When_No_Sources        => Warning,
 965          Is_Config_File         => False);
 966
 967       if not Success then
 968          Prj.Err.Finalize;
 969          Osint.Fail ("""" & Project_File_Name & """ processing failed");
 970       end if;
 971    end Parse_Project_And_Apply_Config;
 972
 973    -----------------------
 974    -- Apply_Config_File --
 975    -----------------------
 976
 977    procedure Apply_Config_File
 978      (Config_File  : Prj.Project_Id;
 979       Project_Tree : Prj.Project_Tree_Ref)
 980    is
 981       Conf_Decl    : constant Declarations := Config_File.Decl;
 982       Conf_Pack_Id : Package_Id;
 983       Conf_Pack    : Package_Element;
 984
 985       User_Decl    : Declarations;
 986       User_Pack_Id : Package_Id;
 987       User_Pack    : Package_Element;
 988       Proj         : Project_List;
 989
 990    begin
 991       Proj := Project_Tree.Projects;
 992       while Proj /= null loop
 993          if Proj.Project /= Config_File then
 994             User_Decl := Proj.Project.Decl;
 995             Add_Attributes
 996               (Project_Tree => Project_Tree,
 997                Conf_Decl    => Conf_Decl,
 998                User_Decl    => User_Decl);
 999
1000             Conf_Pack_Id := Conf_Decl.Packages;
1001             while Conf_Pack_Id /= No_Package loop
1002                Conf_Pack := Project_Tree.Packages.Table (Conf_Pack_Id);
1003
1004                User_Pack_Id := User_Decl.Packages;
1005                while User_Pack_Id /= No_Package loop
1006                   User_Pack := Project_Tree.Packages.Table (User_Pack_Id);
1007                   exit when User_Pack.Name = Conf_Pack.Name;
1008                   User_Pack_Id := User_Pack.Next;
1009                end loop;
1010
1011                if User_Pack_Id = No_Package then
1012                   Package_Table.Increment_Last (Project_Tree.Packages);
1013                   User_Pack := Conf_Pack;
1014                   User_Pack.Next := User_Decl.Packages;
1015                   User_Decl.Packages :=
1016                     Package_Table.Last (Project_Tree.Packages);
1017                   Project_Tree.Packages.Table (User_Decl.Packages) :=
1018                     User_Pack;
1019
1020                else
1021                   Add_Attributes
1022                     (Project_Tree => Project_Tree,
1023                      Conf_Decl    => Conf_Pack.Decl,
1024                      User_Decl    => Project_Tree.Packages.Table
1025                        (User_Pack_Id).Decl);
1026                end if;
1027
1028                Conf_Pack_Id := Conf_Pack.Next;
1029             end loop;
1030
1031             Proj.Project.Decl := User_Decl;
1032          end if;
1033
1034          Proj := Proj.Next;
1035       end loop;
1036    end Apply_Config_File;
1037
1038    ---------------------
1039    -- Set_Runtime_For --
1040    ---------------------
1041
1042    procedure Set_Runtime_For (Language : Name_Id; RTS_Name : String) is
1043    begin
1044       Name_Len := RTS_Name'Length;
1045       Name_Buffer (1 .. Name_Len) := RTS_Name;
1046       RTS_Languages.Set (Language, Name_Find);
1047    end Set_Runtime_For;
1048
1049    ----------------------
1050    -- Runtime_Name_For --
1051    ----------------------
1052
1053    function Runtime_Name_For (Language : Name_Id) return String is
1054    begin
1055       if RTS_Languages.Get (Language) /= No_Name then
1056          return Get_Name_String (RTS_Languages.Get (Language));
1057       else
1058          return "";
1059       end if;
1060    end Runtime_Name_For;
1061
1062 end Prj.Conf;