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