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