1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- P R J . P R O C -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2001-2015, Free Software Foundation, Inc. -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- 17-- for more details. You should have received a copy of the GNU General -- 18-- Public License distributed with GNAT; see file COPYING3. If not, go to -- 19-- http://www.gnu.org/licenses for a complete copy of the license. -- 20-- -- 21-- GNAT was originally developed by the GNAT team at New York University. -- 22-- Extensive contributions were provided by Ada Core Technologies Inc. -- 23-- -- 24------------------------------------------------------------------------------ 25 26with Atree; use Atree; 27with Err_Vars; use Err_Vars; 28with Opt; use Opt; 29with Osint; use Osint; 30with Output; use Output; 31with Prj.Attr; use Prj.Attr; 32with Prj.Env; 33with Prj.Err; use Prj.Err; 34with Prj.Ext; use Prj.Ext; 35with Prj.Nmsc; use Prj.Nmsc; 36with Prj.Part; 37with Prj.Util; 38with Snames; 39 40with Ada.Containers.Vectors; 41with Ada.Strings.Fixed; use Ada.Strings.Fixed; 42 43with GNAT.Case_Util; use GNAT.Case_Util; 44with GNAT.HTable; 45 46package body Prj.Proc is 47 48 package Processed_Projects is new GNAT.HTable.Simple_HTable 49 (Header_Num => Header_Num, 50 Element => Project_Id, 51 No_Element => No_Project, 52 Key => Name_Id, 53 Hash => Hash, 54 Equal => "="); 55 -- This hash table contains all processed projects 56 57 package Unit_Htable is new GNAT.HTable.Simple_HTable 58 (Header_Num => Header_Num, 59 Element => Source_Id, 60 No_Element => No_Source, 61 Key => Name_Id, 62 Hash => Hash, 63 Equal => "="); 64 -- This hash table contains all processed projects 65 66 package Runtime_Defaults is new GNAT.HTable.Simple_HTable 67 (Header_Num => Prj.Header_Num, 68 Element => Name_Id, 69 No_Element => No_Name, 70 Key => Name_Id, 71 Hash => Prj.Hash, 72 Equal => "="); 73 -- Stores the default values of 'Runtime names for the various languages 74 75 procedure Add (To_Exp : in out Name_Id; Str : Name_Id); 76 -- Concatenate two strings and returns another string if both 77 -- arguments are not null string. 78 79 -- In the following procedures, we are expected to guess the meaning of 80 -- the parameters from their names, this is never a good idea, comments 81 -- should be added precisely defining every formal ??? 82 83 procedure Add_Attributes 84 (Project : Project_Id; 85 Project_Name : Name_Id; 86 Project_Dir : Name_Id; 87 Shared : Shared_Project_Tree_Data_Access; 88 Decl : in out Declarations; 89 First : Attribute_Node_Id; 90 Project_Level : Boolean); 91 -- Add all attributes, starting with First, with their default values to 92 -- the package or project with declarations Decl. 93 94 procedure Check 95 (In_Tree : Project_Tree_Ref; 96 Project : Project_Id; 97 Node_Tree : Prj.Tree.Project_Node_Tree_Ref; 98 Flags : Processing_Flags); 99 -- Set all projects to not checked, then call Recursive_Check for the 100 -- main project Project. Project is set to No_Project if errors occurred. 101 -- Current_Dir is for optimization purposes, avoiding extra system calls. 102 -- If Allow_Duplicate_Basenames, then files with the same base names are 103 -- authorized within a project for source-based languages (never for unit 104 -- based languages) 105 106 procedure Copy_Package_Declarations 107 (From : Declarations; 108 To : in out Declarations; 109 New_Loc : Source_Ptr; 110 Restricted : Boolean; 111 Shared : Shared_Project_Tree_Data_Access); 112 -- Copy a package declaration From to To for a renamed package. Change the 113 -- locations of all the attributes to New_Loc. When Restricted is 114 -- True, do not copy attributes Body, Spec, Implementation, Specification 115 -- and Linker_Options. 116 117 function Expression 118 (Project : Project_Id; 119 Shared : Shared_Project_Tree_Data_Access; 120 From_Project_Node : Project_Node_Id; 121 From_Project_Node_Tree : Project_Node_Tree_Ref; 122 Env : Prj.Tree.Environment; 123 Pkg : Package_Id; 124 First_Term : Project_Node_Id; 125 Kind : Variable_Kind) return Variable_Value; 126 -- From N_Expression project node From_Project_Node, compute the value 127 -- of an expression and return it as a Variable_Value. 128 129 function Imported_Or_Extended_Project_From 130 (Project : Project_Id; 131 With_Name : Name_Id; 132 No_Extending : Boolean := False) return Project_Id; 133 -- Find an imported or extended project of Project whose name is With_Name. 134 -- When No_Extending is True, do not look for extending projects, returns 135 -- the exact project whose name is With_Name. 136 137 function Package_From 138 (Project : Project_Id; 139 Shared : Shared_Project_Tree_Data_Access; 140 With_Name : Name_Id) return Package_Id; 141 -- Find the package of Project whose name is With_Name 142 143 procedure Process_Declarative_Items 144 (Project : Project_Id; 145 In_Tree : Project_Tree_Ref; 146 From_Project_Node : Project_Node_Id; 147 Node_Tree : Project_Node_Tree_Ref; 148 Env : Prj.Tree.Environment; 149 Pkg : Package_Id; 150 Item : Project_Node_Id; 151 Child_Env : in out Prj.Tree.Environment); 152 -- Process declarative items starting with From_Project_Node, and put them 153 -- in declarations Decl. This is a recursive procedure; it calls itself for 154 -- a package declaration or a case construction. 155 -- 156 -- Child_Env is the modified environment after seeing declarations like 157 -- "for External(...) use" or "for Project_Path use" in aggregate projects. 158 -- It should have been initialized first. 159 160 procedure Recursive_Process 161 (In_Tree : Project_Tree_Ref; 162 Project : out Project_Id; 163 Packages_To_Check : String_List_Access; 164 From_Project_Node : Project_Node_Id; 165 From_Project_Node_Tree : Project_Node_Tree_Ref; 166 Env : in out Prj.Tree.Environment; 167 Extended_By : Project_Id; 168 From_Encapsulated_Lib : Boolean; 169 On_New_Tree_Loaded : Tree_Loaded_Callback := null); 170 -- Process project with node From_Project_Node in the tree. Do nothing if 171 -- From_Project_Node is Empty_Node. If project has already been processed, 172 -- simply return its project id. Otherwise create a new project id, mark it 173 -- as processed, call itself recursively for all imported projects and a 174 -- extended project, if any. Then process the declarative items of the 175 -- project. 176 -- 177 -- Is_Root_Project should be true only for the project that the user 178 -- explicitly loaded. In the context of aggregate projects, only that 179 -- project is allowed to modify the environment that will be used to load 180 -- projects (Child_Env). 181 -- 182 -- From_Encapsulated_Lib is true if we are parsing a project from 183 -- encapsulated library dependencies. 184 -- 185 -- If specified, On_New_Tree_Loaded is called after each aggregated project 186 -- has been processed succesfully. 187 188 function Get_Attribute_Index 189 (Tree : Project_Node_Tree_Ref; 190 Attr : Project_Node_Id; 191 Index : Name_Id) return Name_Id; 192 -- Copy the index of the attribute into Name_Buffer, converting to lower 193 -- case if the attribute is case-insensitive. 194 195 --------- 196 -- Add -- 197 --------- 198 199 procedure Add (To_Exp : in out Name_Id; Str : Name_Id) is 200 begin 201 if To_Exp = No_Name or else To_Exp = Empty_String then 202 203 -- To_Exp is nil or empty. The result is Str 204 205 To_Exp := Str; 206 207 -- If Str is nil, then do not change To_Ext 208 209 elsif Str /= No_Name and then Str /= Empty_String then 210 declare 211 S : constant String := Get_Name_String (Str); 212 begin 213 Get_Name_String (To_Exp); 214 Add_Str_To_Name_Buffer (S); 215 To_Exp := Name_Find; 216 end; 217 end if; 218 end Add; 219 220 -------------------- 221 -- Add_Attributes -- 222 -------------------- 223 224 procedure Add_Attributes 225 (Project : Project_Id; 226 Project_Name : Name_Id; 227 Project_Dir : Name_Id; 228 Shared : Shared_Project_Tree_Data_Access; 229 Decl : in out Declarations; 230 First : Attribute_Node_Id; 231 Project_Level : Boolean) 232 is 233 The_Attribute : Attribute_Node_Id := First; 234 235 begin 236 while The_Attribute /= Empty_Attribute loop 237 if Attribute_Kind_Of (The_Attribute) = Single then 238 declare 239 New_Attribute : Variable_Value; 240 241 begin 242 case Variable_Kind_Of (The_Attribute) is 243 244 -- Undefined should not happen 245 246 when Undefined => 247 pragma Assert 248 (False, "attribute with an undefined kind"); 249 raise Program_Error; 250 251 -- Single attributes have a default value of empty string 252 253 when Single => 254 New_Attribute := 255 (Project => Project, 256 Kind => Single, 257 Location => No_Location, 258 Default => True, 259 Value => Empty_String, 260 Index => 0); 261 262 -- Special cases of <project>'Name and 263 -- <project>'Project_Dir. 264 265 if Project_Level then 266 if Attribute_Name_Of (The_Attribute) = 267 Snames.Name_Name 268 then 269 New_Attribute.Value := Project_Name; 270 271 elsif Attribute_Name_Of (The_Attribute) = 272 Snames.Name_Project_Dir 273 then 274 New_Attribute.Value := Project_Dir; 275 end if; 276 end if; 277 278 -- List attributes have a default value of nil list 279 280 when List => 281 New_Attribute := 282 (Project => Project, 283 Kind => List, 284 Location => No_Location, 285 Default => True, 286 Values => Nil_String); 287 288 end case; 289 290 Variable_Element_Table.Increment_Last 291 (Shared.Variable_Elements); 292 Shared.Variable_Elements.Table 293 (Variable_Element_Table.Last (Shared.Variable_Elements)) := 294 (Next => Decl.Attributes, 295 Name => Attribute_Name_Of (The_Attribute), 296 Value => New_Attribute); 297 Decl.Attributes := 298 Variable_Element_Table.Last 299 (Shared.Variable_Elements); 300 end; 301 end if; 302 303 The_Attribute := Next_Attribute (After => The_Attribute); 304 end loop; 305 end Add_Attributes; 306 307 ----------- 308 -- Check -- 309 ----------- 310 311 procedure Check 312 (In_Tree : Project_Tree_Ref; 313 Project : Project_Id; 314 Node_Tree : Prj.Tree.Project_Node_Tree_Ref; 315 Flags : Processing_Flags) 316 is 317 begin 318 Process_Naming_Scheme (In_Tree, Project, Node_Tree, Flags); 319 320 -- Set the Other_Part field for the units 321 322 declare 323 Source1 : Source_Id; 324 Name : Name_Id; 325 Source2 : Source_Id; 326 Iter : Source_Iterator; 327 328 begin 329 Unit_Htable.Reset; 330 331 Iter := For_Each_Source (In_Tree); 332 loop 333 Source1 := Prj.Element (Iter); 334 exit when Source1 = No_Source; 335 336 if Source1.Unit /= No_Unit_Index then 337 Name := Source1.Unit.Name; 338 Source2 := Unit_Htable.Get (Name); 339 340 if Source2 = No_Source then 341 Unit_Htable.Set (K => Name, E => Source1); 342 else 343 Unit_Htable.Remove (Name); 344 end if; 345 end if; 346 347 Next (Iter); 348 end loop; 349 end; 350 end Check; 351 352 ------------------------------- 353 -- Copy_Package_Declarations -- 354 ------------------------------- 355 356 procedure Copy_Package_Declarations 357 (From : Declarations; 358 To : in out Declarations; 359 New_Loc : Source_Ptr; 360 Restricted : Boolean; 361 Shared : Shared_Project_Tree_Data_Access) 362 is 363 V1 : Variable_Id; 364 V2 : Variable_Id := No_Variable; 365 Var : Variable; 366 A1 : Array_Id; 367 A2 : Array_Id := No_Array; 368 Arr : Array_Data; 369 E1 : Array_Element_Id; 370 E2 : Array_Element_Id := No_Array_Element; 371 Elm : Array_Element; 372 373 begin 374 -- To avoid references in error messages to attribute declarations in 375 -- an original package that has been renamed, copy all the attribute 376 -- declarations of the package and change all locations to New_Loc, 377 -- the location of the renamed package. 378 379 -- First single attributes 380 381 V1 := From.Attributes; 382 while V1 /= No_Variable loop 383 384 -- Copy the attribute 385 386 Var := Shared.Variable_Elements.Table (V1); 387 V1 := Var.Next; 388 389 -- Do not copy the value of attribute Linker_Options if Restricted 390 391 if Restricted and then Var.Name = Snames.Name_Linker_Options then 392 Var.Value.Values := Nil_String; 393 end if; 394 395 -- Remove the Next component 396 397 Var.Next := No_Variable; 398 399 -- Change the location to New_Loc 400 401 Var.Value.Location := New_Loc; 402 Variable_Element_Table.Increment_Last (Shared.Variable_Elements); 403 404 -- Put in new declaration 405 406 if To.Attributes = No_Variable then 407 To.Attributes := 408 Variable_Element_Table.Last (Shared.Variable_Elements); 409 else 410 Shared.Variable_Elements.Table (V2).Next := 411 Variable_Element_Table.Last (Shared.Variable_Elements); 412 end if; 413 414 V2 := Variable_Element_Table.Last (Shared.Variable_Elements); 415 Shared.Variable_Elements.Table (V2) := Var; 416 end loop; 417 418 -- Then the associated array attributes 419 420 A1 := From.Arrays; 421 while A1 /= No_Array loop 422 Arr := Shared.Arrays.Table (A1); 423 A1 := Arr.Next; 424 425 -- Remove the Next component 426 427 Arr.Next := No_Array; 428 Array_Table.Increment_Last (Shared.Arrays); 429 430 -- Create new Array declaration 431 432 if To.Arrays = No_Array then 433 To.Arrays := Array_Table.Last (Shared.Arrays); 434 else 435 Shared.Arrays.Table (A2).Next := 436 Array_Table.Last (Shared.Arrays); 437 end if; 438 439 A2 := Array_Table.Last (Shared.Arrays); 440 441 -- Don't store the array as its first element has not been set yet 442 443 -- Copy the array elements of the array 444 445 E1 := Arr.Value; 446 Arr.Value := No_Array_Element; 447 while E1 /= No_Array_Element loop 448 449 -- Copy the array element 450 451 Elm := Shared.Array_Elements.Table (E1); 452 E1 := Elm.Next; 453 454 -- Remove the Next component 455 456 Elm.Next := No_Array_Element; 457 458 Elm.Restricted := Restricted; 459 460 -- Change the location 461 462 Elm.Value.Location := New_Loc; 463 Array_Element_Table.Increment_Last (Shared.Array_Elements); 464 465 -- Create new array element 466 467 if Arr.Value = No_Array_Element then 468 Arr.Value := Array_Element_Table.Last (Shared.Array_Elements); 469 else 470 Shared.Array_Elements.Table (E2).Next := 471 Array_Element_Table.Last (Shared.Array_Elements); 472 end if; 473 474 E2 := Array_Element_Table.Last (Shared.Array_Elements); 475 Shared.Array_Elements.Table (E2) := Elm; 476 end loop; 477 478 -- Finally, store the new array 479 480 Shared.Arrays.Table (A2) := Arr; 481 end loop; 482 end Copy_Package_Declarations; 483 484 ------------------------- 485 -- Get_Attribute_Index -- 486 ------------------------- 487 488 function Get_Attribute_Index 489 (Tree : Project_Node_Tree_Ref; 490 Attr : Project_Node_Id; 491 Index : Name_Id) return Name_Id 492 is 493 begin 494 if Index = All_Other_Names 495 or else not Case_Insensitive (Attr, Tree) 496 then 497 return Index; 498 end if; 499 500 Get_Name_String (Index); 501 To_Lower (Name_Buffer (1 .. Name_Len)); 502 return Name_Find; 503 end Get_Attribute_Index; 504 505 ---------------- 506 -- Expression -- 507 ---------------- 508 509 function Expression 510 (Project : Project_Id; 511 Shared : Shared_Project_Tree_Data_Access; 512 From_Project_Node : Project_Node_Id; 513 From_Project_Node_Tree : Project_Node_Tree_Ref; 514 Env : Prj.Tree.Environment; 515 Pkg : Package_Id; 516 First_Term : Project_Node_Id; 517 Kind : Variable_Kind) return Variable_Value 518 is 519 The_Term : Project_Node_Id; 520 -- The term in the expression list 521 522 The_Current_Term : Project_Node_Id := Empty_Node; 523 -- The current term node id 524 525 Result : Variable_Value (Kind => Kind); 526 -- The returned result 527 528 Last : String_List_Id := Nil_String; 529 -- Reference to the last string elements in Result, when Kind is List 530 531 Current_Term_Kind : Project_Node_Kind; 532 533 begin 534 Result.Project := Project; 535 Result.Location := Location_Of (First_Term, From_Project_Node_Tree); 536 537 -- Process each term of the expression, starting with First_Term 538 539 The_Term := First_Term; 540 while Present (The_Term) loop 541 The_Current_Term := Current_Term (The_Term, From_Project_Node_Tree); 542 543 if The_Current_Term /= Empty_Node then 544 Current_Term_Kind := 545 Kind_Of (The_Current_Term, From_Project_Node_Tree); 546 547 case Current_Term_Kind is 548 549 when N_Literal_String => 550 case Kind is 551 when Undefined => 552 553 -- Should never happen 554 555 pragma Assert (False, "Undefined expression kind"); 556 raise Program_Error; 557 558 when Single => 559 Add (Result.Value, 560 String_Value_Of 561 (The_Current_Term, From_Project_Node_Tree)); 562 Result.Index := 563 Source_Index_Of 564 (The_Current_Term, From_Project_Node_Tree); 565 566 when List => 567 568 String_Element_Table.Increment_Last 569 (Shared.String_Elements); 570 571 if Last = Nil_String then 572 573 -- This can happen in an expression like () & "toto" 574 575 Result.Values := String_Element_Table.Last 576 (Shared.String_Elements); 577 578 else 579 Shared.String_Elements.Table 580 (Last).Next := String_Element_Table.Last 581 (Shared.String_Elements); 582 end if; 583 584 Last := String_Element_Table.Last 585 (Shared.String_Elements); 586 587 Shared.String_Elements.Table (Last) := 588 (Value => String_Value_Of 589 (The_Current_Term, 590 From_Project_Node_Tree), 591 Index => Source_Index_Of 592 (The_Current_Term, 593 From_Project_Node_Tree), 594 Display_Value => No_Name, 595 Location => Location_Of 596 (The_Current_Term, 597 From_Project_Node_Tree), 598 Flag => False, 599 Next => Nil_String); 600 end case; 601 602 when N_Literal_String_List => 603 declare 604 String_Node : Project_Node_Id := 605 First_Expression_In_List 606 (The_Current_Term, 607 From_Project_Node_Tree); 608 609 Value : Variable_Value; 610 611 begin 612 if Present (String_Node) then 613 614 -- If String_Node is nil, it is an empty list, there is 615 -- nothing to do. 616 617 Value := Expression 618 (Project => Project, 619 Shared => Shared, 620 From_Project_Node => From_Project_Node, 621 From_Project_Node_Tree => From_Project_Node_Tree, 622 Env => Env, 623 Pkg => Pkg, 624 First_Term => 625 Tree.First_Term 626 (String_Node, From_Project_Node_Tree), 627 Kind => Single); 628 String_Element_Table.Increment_Last 629 (Shared.String_Elements); 630 631 if Result.Values = Nil_String then 632 633 -- This literal string list is the first term in a 634 -- string list expression 635 636 Result.Values := 637 String_Element_Table.Last 638 (Shared.String_Elements); 639 640 else 641 Shared.String_Elements.Table (Last).Next := 642 String_Element_Table.Last (Shared.String_Elements); 643 end if; 644 645 Last := 646 String_Element_Table.Last (Shared.String_Elements); 647 648 Shared.String_Elements.Table (Last) := 649 (Value => Value.Value, 650 Display_Value => No_Name, 651 Location => Value.Location, 652 Flag => False, 653 Next => Nil_String, 654 Index => Value.Index); 655 656 loop 657 -- Add the other element of the literal string list 658 -- one after the other. 659 660 String_Node := 661 Next_Expression_In_List 662 (String_Node, From_Project_Node_Tree); 663 664 exit when No (String_Node); 665 666 Value := 667 Expression 668 (Project => Project, 669 Shared => Shared, 670 From_Project_Node => From_Project_Node, 671 From_Project_Node_Tree => From_Project_Node_Tree, 672 Env => Env, 673 Pkg => Pkg, 674 First_Term => 675 Tree.First_Term 676 (String_Node, From_Project_Node_Tree), 677 Kind => Single); 678 679 String_Element_Table.Increment_Last 680 (Shared.String_Elements); 681 Shared.String_Elements.Table (Last).Next := 682 String_Element_Table.Last (Shared.String_Elements); 683 Last := String_Element_Table.Last 684 (Shared.String_Elements); 685 Shared.String_Elements.Table (Last) := 686 (Value => Value.Value, 687 Display_Value => No_Name, 688 Location => Value.Location, 689 Flag => False, 690 Next => Nil_String, 691 Index => Value.Index); 692 end loop; 693 end if; 694 end; 695 696 when N_Variable_Reference | N_Attribute_Reference => 697 declare 698 The_Project : Project_Id := Project; 699 The_Package : Package_Id := Pkg; 700 The_Name : Name_Id := No_Name; 701 The_Variable_Id : Variable_Id := No_Variable; 702 The_Variable : Variable_Value; 703 Term_Project : constant Project_Node_Id := 704 Project_Node_Of 705 (The_Current_Term, 706 From_Project_Node_Tree); 707 Term_Package : constant Project_Node_Id := 708 Package_Node_Of 709 (The_Current_Term, 710 From_Project_Node_Tree); 711 Index : Name_Id := No_Name; 712 713 begin 714 <<Object_Dir_Restart>> 715 The_Project := Project; 716 The_Package := Pkg; 717 The_Name := No_Name; 718 The_Variable_Id := No_Variable; 719 Index := No_Name; 720 721 if Present (Term_Project) 722 and then Term_Project /= From_Project_Node 723 then 724 -- This variable or attribute comes from another project 725 726 The_Name := 727 Name_Of (Term_Project, From_Project_Node_Tree); 728 The_Project := Imported_Or_Extended_Project_From 729 (Project => Project, 730 With_Name => The_Name, 731 No_Extending => True); 732 end if; 733 734 if Present (Term_Package) then 735 736 -- This is an attribute of a package 737 738 The_Name := 739 Name_Of (Term_Package, From_Project_Node_Tree); 740 741 The_Package := The_Project.Decl.Packages; 742 while The_Package /= No_Package 743 and then Shared.Packages.Table (The_Package).Name /= 744 The_Name 745 loop 746 The_Package := 747 Shared.Packages.Table (The_Package).Next; 748 end loop; 749 750 pragma Assert 751 (The_Package /= No_Package, "package not found."); 752 753 elsif Kind_Of (The_Current_Term, From_Project_Node_Tree) = 754 N_Attribute_Reference 755 then 756 The_Package := No_Package; 757 end if; 758 759 The_Name := 760 Name_Of (The_Current_Term, From_Project_Node_Tree); 761 762 if Current_Term_Kind = N_Attribute_Reference then 763 Index := 764 Associative_Array_Index_Of 765 (The_Current_Term, From_Project_Node_Tree); 766 end if; 767 768 -- If it is not an associative array attribute 769 770 if Index = No_Name then 771 772 -- It is not an associative array attribute 773 774 if The_Package /= No_Package then 775 776 -- First, if there is a package, look into the package 777 778 if Current_Term_Kind = N_Variable_Reference then 779 The_Variable_Id := 780 Shared.Packages.Table 781 (The_Package).Decl.Variables; 782 else 783 The_Variable_Id := 784 Shared.Packages.Table 785 (The_Package).Decl.Attributes; 786 end if; 787 788 while The_Variable_Id /= No_Variable 789 and then Shared.Variable_Elements.Table 790 (The_Variable_Id).Name /= The_Name 791 loop 792 The_Variable_Id := 793 Shared.Variable_Elements.Table 794 (The_Variable_Id).Next; 795 end loop; 796 797 end if; 798 799 if The_Variable_Id = No_Variable then 800 801 -- If we have not found it, look into the project 802 803 if Current_Term_Kind = N_Variable_Reference then 804 The_Variable_Id := The_Project.Decl.Variables; 805 else 806 The_Variable_Id := The_Project.Decl.Attributes; 807 end if; 808 809 while The_Variable_Id /= No_Variable 810 and then Shared.Variable_Elements.Table 811 (The_Variable_Id).Name /= The_Name 812 loop 813 The_Variable_Id := 814 Shared.Variable_Elements.Table 815 (The_Variable_Id).Next; 816 end loop; 817 818 end if; 819 820 if From_Project_Node_Tree.Incomplete_With then 821 if The_Variable_Id = No_Variable then 822 The_Variable := Nil_Variable_Value; 823 else 824 The_Variable := 825 Shared.Variable_Elements.Table 826 (The_Variable_Id).Value; 827 end if; 828 829 else 830 pragma Assert (The_Variable_Id /= No_Variable, 831 "variable or attribute not found"); 832 833 The_Variable := 834 Shared.Variable_Elements.Table 835 (The_Variable_Id).Value; 836 end if; 837 838 else 839 840 -- It is an associative array attribute 841 842 declare 843 The_Array : Array_Id := No_Array; 844 The_Element : Array_Element_Id := No_Array_Element; 845 Array_Index : Name_Id := No_Name; 846 847 begin 848 if The_Package /= No_Package then 849 The_Array := 850 Shared.Packages.Table (The_Package).Decl.Arrays; 851 else 852 The_Array := The_Project.Decl.Arrays; 853 end if; 854 855 while The_Array /= No_Array 856 and then Shared.Arrays.Table (The_Array).Name /= 857 The_Name 858 loop 859 The_Array := Shared.Arrays.Table (The_Array).Next; 860 end loop; 861 862 if The_Array /= No_Array then 863 The_Element := 864 Shared.Arrays.Table (The_Array).Value; 865 Array_Index := 866 Get_Attribute_Index 867 (From_Project_Node_Tree, 868 The_Current_Term, 869 Index); 870 871 while The_Element /= No_Array_Element 872 and then Shared.Array_Elements.Table 873 (The_Element).Index /= Array_Index 874 loop 875 The_Element := 876 Shared.Array_Elements.Table (The_Element).Next; 877 end loop; 878 879 end if; 880 881 if The_Element /= No_Array_Element then 882 The_Variable := 883 Shared.Array_Elements.Table (The_Element).Value; 884 885 else 886 if Expression_Kind_Of 887 (The_Current_Term, From_Project_Node_Tree) = 888 List 889 then 890 The_Variable := 891 (Project => Project, 892 Kind => List, 893 Location => No_Location, 894 Default => True, 895 Values => Nil_String); 896 else 897 The_Variable := 898 (Project => Project, 899 Kind => Single, 900 Location => No_Location, 901 Default => True, 902 Value => Empty_String, 903 Index => 0); 904 end if; 905 end if; 906 end; 907 end if; 908 909 -- Check the defaults 910 911 if Current_Term_Kind = N_Attribute_Reference then 912 declare 913 The_Default : constant Attribute_Default_Value := 914 Default_Of 915 (The_Current_Term, From_Project_Node_Tree); 916 917 begin 918 -- Check the special value for 'Target when specified 919 920 if The_Default = Target_Value 921 and then Opt.Target_Origin = Specified 922 then 923 Name_Len := 0; 924 Add_Str_To_Name_Buffer (Opt.Target_Value.all); 925 The_Variable.Value := Name_Find; 926 927 -- Check the defaults 928 929 elsif The_Variable.Default then 930 case The_Variable.Kind is 931 932 when Undefined => 933 null; 934 935 when Single => 936 case The_Default is 937 when Read_Only_Value => 938 null; 939 940 when Empty_Value => 941 The_Variable.Value := Empty_String; 942 943 when Dot_Value => 944 The_Variable.Value := Dot_String; 945 946 when Object_Dir_Value => 947 From_Project_Node_Tree.Project_Nodes.Table 948 (The_Current_Term).Name := 949 Snames.Name_Object_Dir; 950 From_Project_Node_Tree.Project_Nodes.Table 951 (The_Current_Term).Default := 952 Dot_Value; 953 goto Object_Dir_Restart; 954 955 when Target_Value => 956 if Opt.Target_Value = null then 957 The_Variable.Value := Empty_String; 958 959 else 960 Name_Len := 0; 961 Add_Str_To_Name_Buffer 962 (Opt.Target_Value.all); 963 The_Variable.Value := Name_Find; 964 end if; 965 966 when Runtime_Value => 967 Get_Name_String (Index); 968 To_Lower (Name_Buffer (1 .. Name_Len)); 969 The_Variable.Value := 970 Runtime_Defaults.Get (Name_Find); 971 if The_Variable.Value = No_Name then 972 The_Variable.Value := Empty_String; 973 end if; 974 975 end case; 976 977 when List => 978 case The_Default is 979 when Read_Only_Value => 980 null; 981 982 when Empty_Value => 983 The_Variable.Values := Nil_String; 984 985 when Dot_Value => 986 The_Variable.Values := 987 Shared.Dot_String_List; 988 989 when Object_Dir_Value | 990 Target_Value | 991 Runtime_Value => 992 null; 993 end case; 994 end case; 995 end if; 996 end; 997 end if; 998 999 case Kind is 1000 when Undefined => 1001 1002 -- Should never happen 1003 1004 pragma Assert (False, "undefined expression kind"); 1005 null; 1006 1007 when Single => 1008 case The_Variable.Kind is 1009 1010 when Undefined => 1011 null; 1012 1013 when Single => 1014 Add (Result.Value, The_Variable.Value); 1015 1016 when List => 1017 1018 -- Should never happen 1019 1020 pragma Assert 1021 (False, 1022 "list cannot appear in single " & 1023 "string expression"); 1024 null; 1025 end case; 1026 1027 when List => 1028 case The_Variable.Kind is 1029 1030 when Undefined => 1031 null; 1032 1033 when Single => 1034 String_Element_Table.Increment_Last 1035 (Shared.String_Elements); 1036 1037 if Last = Nil_String then 1038 1039 -- This can happen in an expression such as 1040 -- () & Var 1041 1042 Result.Values := 1043 String_Element_Table.Last 1044 (Shared.String_Elements); 1045 1046 else 1047 Shared.String_Elements.Table (Last).Next := 1048 String_Element_Table.Last 1049 (Shared.String_Elements); 1050 end if; 1051 1052 Last := 1053 String_Element_Table.Last 1054 (Shared.String_Elements); 1055 1056 Shared.String_Elements.Table (Last) := 1057 (Value => The_Variable.Value, 1058 Display_Value => No_Name, 1059 Location => Location_Of 1060 (The_Current_Term, 1061 From_Project_Node_Tree), 1062 Flag => False, 1063 Next => Nil_String, 1064 Index => 0); 1065 1066 when List => 1067 1068 declare 1069 The_List : String_List_Id := 1070 The_Variable.Values; 1071 1072 begin 1073 while The_List /= Nil_String loop 1074 String_Element_Table.Increment_Last 1075 (Shared.String_Elements); 1076 1077 if Last = Nil_String then 1078 Result.Values := 1079 String_Element_Table.Last 1080 (Shared.String_Elements); 1081 1082 else 1083 Shared. 1084 String_Elements.Table (Last).Next := 1085 String_Element_Table.Last 1086 (Shared.String_Elements); 1087 1088 end if; 1089 1090 Last := 1091 String_Element_Table.Last 1092 (Shared.String_Elements); 1093 1094 Shared.String_Elements.Table 1095 (Last) := 1096 (Value => 1097 Shared.String_Elements.Table 1098 (The_List).Value, 1099 Display_Value => No_Name, 1100 Location => 1101 Location_Of 1102 (The_Current_Term, 1103 From_Project_Node_Tree), 1104 Flag => False, 1105 Next => Nil_String, 1106 Index => 0); 1107 1108 The_List := Shared.String_Elements.Table 1109 (The_List).Next; 1110 end loop; 1111 end; 1112 end case; 1113 end case; 1114 end; 1115 1116 when N_External_Value => 1117 Get_Name_String 1118 (String_Value_Of 1119 (External_Reference_Of 1120 (The_Current_Term, From_Project_Node_Tree), 1121 From_Project_Node_Tree)); 1122 1123 declare 1124 Name : constant Name_Id := Name_Find; 1125 Default : Name_Id := No_Name; 1126 Value : Name_Id := No_Name; 1127 Ext_List : Boolean := False; 1128 Str_List : String_List_Access := null; 1129 Def_Var : Variable_Value; 1130 1131 Default_Node : constant Project_Node_Id := 1132 External_Default_Of 1133 (The_Current_Term, 1134 From_Project_Node_Tree); 1135 1136 begin 1137 -- If there is a default value for the external reference, 1138 -- get its value. 1139 1140 if Present (Default_Node) then 1141 Def_Var := Expression 1142 (Project => Project, 1143 Shared => Shared, 1144 From_Project_Node => From_Project_Node, 1145 From_Project_Node_Tree => From_Project_Node_Tree, 1146 Env => Env, 1147 Pkg => Pkg, 1148 First_Term => 1149 Tree.First_Term 1150 (Default_Node, From_Project_Node_Tree), 1151 Kind => Single); 1152 1153 if Def_Var /= Nil_Variable_Value then 1154 Default := Def_Var.Value; 1155 end if; 1156 end if; 1157 1158 Ext_List := Expression_Kind_Of 1159 (The_Current_Term, 1160 From_Project_Node_Tree) = List; 1161 1162 if Ext_List then 1163 Value := Prj.Ext.Value_Of (Env.External, Name, No_Name); 1164 1165 if Value /= No_Name then 1166 declare 1167 Sep : constant String := 1168 Get_Name_String (Default); 1169 First : Positive := 1; 1170 Lst : Natural; 1171 Done : Boolean := False; 1172 Nmb : Natural; 1173 1174 begin 1175 Get_Name_String (Value); 1176 1177 if Name_Len = 0 1178 or else Sep'Length = 0 1179 or else Name_Buffer (1 .. Name_Len) = Sep 1180 then 1181 Done := True; 1182 end if; 1183 1184 if not Done and then Name_Len < Sep'Length then 1185 Str_List := 1186 new String_List' 1187 (1 => new String' 1188 (Name_Buffer (1 .. Name_Len))); 1189 Done := True; 1190 end if; 1191 1192 if not Done then 1193 if Name_Buffer (1 .. Sep'Length) = Sep then 1194 First := Sep'Length + 1; 1195 end if; 1196 1197 if Name_Len - First + 1 >= Sep'Length 1198 and then 1199 Name_Buffer (Name_Len - Sep'Length + 1 .. 1200 Name_Len) = Sep 1201 then 1202 Name_Len := Name_Len - Sep'Length; 1203 end if; 1204 1205 if Name_Len = 0 then 1206 Str_List := 1207 new String_List'(1 => new String'("")); 1208 Done := True; 1209 end if; 1210 end if; 1211 1212 if not Done then 1213 1214 -- Count the number of strings 1215 1216 declare 1217 Saved : constant Positive := First; 1218 1219 begin 1220 Nmb := 1; 1221 loop 1222 Lst := 1223 Index 1224 (Source => 1225 Name_Buffer (First .. Name_Len), 1226 Pattern => Sep); 1227 exit when Lst = 0; 1228 Nmb := Nmb + 1; 1229 First := Lst + Sep'Length; 1230 end loop; 1231 1232 First := Saved; 1233 end; 1234 1235 Str_List := new String_List (1 .. Nmb); 1236 1237 -- Populate the string list 1238 1239 Nmb := 1; 1240 loop 1241 Lst := 1242 Index 1243 (Source => 1244 Name_Buffer (First .. Name_Len), 1245 Pattern => Sep); 1246 1247 if Lst = 0 then 1248 Str_List (Nmb) := 1249 new String' 1250 (Name_Buffer (First .. Name_Len)); 1251 exit; 1252 1253 else 1254 Str_List (Nmb) := 1255 new String' 1256 (Name_Buffer (First .. Lst - 1)); 1257 Nmb := Nmb + 1; 1258 First := Lst + Sep'Length; 1259 end if; 1260 end loop; 1261 end if; 1262 end; 1263 end if; 1264 1265 else 1266 -- Get the value 1267 1268 Value := Prj.Ext.Value_Of (Env.External, Name, Default); 1269 1270 if Value = No_Name then 1271 if not Quiet_Output then 1272 Error_Msg 1273 (Env.Flags, "?undefined external reference", 1274 Location_Of 1275 (The_Current_Term, From_Project_Node_Tree), 1276 Project); 1277 end if; 1278 1279 Value := Empty_String; 1280 end if; 1281 end if; 1282 1283 case Kind is 1284 1285 when Undefined => 1286 null; 1287 1288 when Single => 1289 if Ext_List then 1290 null; -- error 1291 1292 else 1293 Add (Result.Value, Value); 1294 end if; 1295 1296 when List => 1297 if not Ext_List or else Str_List /= null then 1298 String_Element_Table.Increment_Last 1299 (Shared.String_Elements); 1300 1301 if Last = Nil_String then 1302 Result.Values := 1303 String_Element_Table.Last 1304 (Shared.String_Elements); 1305 1306 else 1307 Shared.String_Elements.Table (Last).Next 1308 := String_Element_Table.Last 1309 (Shared.String_Elements); 1310 end if; 1311 1312 Last := String_Element_Table.Last 1313 (Shared.String_Elements); 1314 1315 if Ext_List then 1316 for Ind in Str_List'Range loop 1317 Name_Len := 0; 1318 Add_Str_To_Name_Buffer (Str_List (Ind).all); 1319 Value := Name_Find; 1320 Shared.String_Elements.Table (Last) := 1321 (Value => Value, 1322 Display_Value => No_Name, 1323 Location => 1324 Location_Of 1325 (The_Current_Term, 1326 From_Project_Node_Tree), 1327 Flag => False, 1328 Next => Nil_String, 1329 Index => 0); 1330 1331 if Ind /= Str_List'Last then 1332 String_Element_Table.Increment_Last 1333 (Shared.String_Elements); 1334 Shared.String_Elements.Table (Last).Next := 1335 String_Element_Table.Last 1336 (Shared.String_Elements); 1337 Last := String_Element_Table.Last 1338 (Shared.String_Elements); 1339 end if; 1340 end loop; 1341 1342 else 1343 Shared.String_Elements.Table (Last) := 1344 (Value => Value, 1345 Display_Value => No_Name, 1346 Location => 1347 Location_Of 1348 (The_Current_Term, 1349 From_Project_Node_Tree), 1350 Flag => False, 1351 Next => Nil_String, 1352 Index => 0); 1353 end if; 1354 end if; 1355 end case; 1356 end; 1357 1358 when others => 1359 1360 -- Should never happen 1361 1362 pragma Assert 1363 (False, 1364 "illegal node kind in an expression"); 1365 raise Program_Error; 1366 1367 end case; 1368 end if; 1369 1370 The_Term := Next_Term (The_Term, From_Project_Node_Tree); 1371 end loop; 1372 1373 return Result; 1374 end Expression; 1375 1376 --------------------------------------- 1377 -- Imported_Or_Extended_Project_From -- 1378 --------------------------------------- 1379 1380 function Imported_Or_Extended_Project_From 1381 (Project : Project_Id; 1382 With_Name : Name_Id; 1383 No_Extending : Boolean := False) return Project_Id 1384 is 1385 List : Project_List; 1386 Result : Project_Id; 1387 Temp_Result : Project_Id; 1388 1389 begin 1390 -- First check if it is the name of an extended project 1391 1392 Result := Project.Extends; 1393 while Result /= No_Project loop 1394 if Result.Name = With_Name then 1395 return Result; 1396 else 1397 Result := Result.Extends; 1398 end if; 1399 end loop; 1400 1401 -- Then check the name of each imported project 1402 1403 Temp_Result := No_Project; 1404 List := Project.Imported_Projects; 1405 while List /= null loop 1406 Result := List.Project; 1407 1408 -- If the project is directly imported, then returns its ID 1409 1410 if Result.Name = With_Name then 1411 return Result; 1412 end if; 1413 1414 -- If a project extending the project is imported, then keep this 1415 -- extending project as a possibility. It will be the returned ID 1416 -- if the project is not imported directly. 1417 1418 declare 1419 Proj : Project_Id; 1420 1421 begin 1422 Proj := Result.Extends; 1423 while Proj /= No_Project loop 1424 if Proj.Name = With_Name then 1425 if No_Extending then 1426 Temp_Result := Proj; 1427 else 1428 Temp_Result := Result; 1429 end if; 1430 1431 exit; 1432 end if; 1433 1434 Proj := Proj.Extends; 1435 end loop; 1436 end; 1437 1438 List := List.Next; 1439 end loop; 1440 1441 pragma Assert (Temp_Result /= No_Project, "project not found"); 1442 return Temp_Result; 1443 end Imported_Or_Extended_Project_From; 1444 1445 ------------------ 1446 -- Package_From -- 1447 ------------------ 1448 1449 function Package_From 1450 (Project : Project_Id; 1451 Shared : Shared_Project_Tree_Data_Access; 1452 With_Name : Name_Id) return Package_Id 1453 is 1454 Result : Package_Id := Project.Decl.Packages; 1455 1456 begin 1457 -- Check the name of each existing package of Project 1458 1459 while Result /= No_Package 1460 and then Shared.Packages.Table (Result).Name /= With_Name 1461 loop 1462 Result := Shared.Packages.Table (Result).Next; 1463 end loop; 1464 1465 if Result = No_Package then 1466 1467 -- Should never happen 1468 1469 Write_Line 1470 ("package """ & Get_Name_String (With_Name) & """ not found"); 1471 raise Program_Error; 1472 1473 else 1474 return Result; 1475 end if; 1476 end Package_From; 1477 1478 ------------- 1479 -- Process -- 1480 ------------- 1481 1482 procedure Process 1483 (In_Tree : Project_Tree_Ref; 1484 Project : out Project_Id; 1485 Packages_To_Check : String_List_Access; 1486 Success : out Boolean; 1487 From_Project_Node : Project_Node_Id; 1488 From_Project_Node_Tree : Project_Node_Tree_Ref; 1489 Env : in out Prj.Tree.Environment; 1490 Reset_Tree : Boolean := True; 1491 On_New_Tree_Loaded : Tree_Loaded_Callback := null) 1492 is 1493 begin 1494 Process_Project_Tree_Phase_1 1495 (In_Tree => In_Tree, 1496 Project => Project, 1497 Success => Success, 1498 From_Project_Node => From_Project_Node, 1499 From_Project_Node_Tree => From_Project_Node_Tree, 1500 Env => Env, 1501 Packages_To_Check => Packages_To_Check, 1502 Reset_Tree => Reset_Tree, 1503 On_New_Tree_Loaded => On_New_Tree_Loaded); 1504 1505 if Project_Qualifier_Of 1506 (From_Project_Node, From_Project_Node_Tree) /= Configuration 1507 then 1508 Process_Project_Tree_Phase_2 1509 (In_Tree => In_Tree, 1510 Project => Project, 1511 Success => Success, 1512 From_Project_Node => From_Project_Node, 1513 From_Project_Node_Tree => From_Project_Node_Tree, 1514 Env => Env); 1515 end if; 1516 end Process; 1517 1518 ------------------------------- 1519 -- Process_Declarative_Items -- 1520 ------------------------------- 1521 1522 procedure Process_Declarative_Items 1523 (Project : Project_Id; 1524 In_Tree : Project_Tree_Ref; 1525 From_Project_Node : Project_Node_Id; 1526 Node_Tree : Project_Node_Tree_Ref; 1527 Env : Prj.Tree.Environment; 1528 Pkg : Package_Id; 1529 Item : Project_Node_Id; 1530 Child_Env : in out Prj.Tree.Environment) 1531 is 1532 Shared : constant Shared_Project_Tree_Data_Access := In_Tree.Shared; 1533 1534 procedure Check_Or_Set_Typed_Variable 1535 (Value : in out Variable_Value; 1536 Declaration : Project_Node_Id); 1537 -- Check whether Value is valid for this typed variable declaration. If 1538 -- it is an error, the behavior depends on the flags: either an error is 1539 -- reported, or a warning, or nothing. In the last two cases, the value 1540 -- of the variable is set to a valid value, replacing Value. 1541 1542 procedure Process_Package_Declaration 1543 (Current_Item : Project_Node_Id); 1544 procedure Process_Attribute_Declaration 1545 (Current : Project_Node_Id); 1546 procedure Process_Case_Construction 1547 (Current_Item : Project_Node_Id); 1548 procedure Process_Associative_Array 1549 (Current_Item : Project_Node_Id); 1550 procedure Process_Expression 1551 (Current : Project_Node_Id); 1552 procedure Process_Expression_For_Associative_Array 1553 (Current : Project_Node_Id; 1554 New_Value : Variable_Value); 1555 procedure Process_Expression_Variable_Decl 1556 (Current_Item : Project_Node_Id; 1557 New_Value : Variable_Value); 1558 -- Process the various declarative items 1559 1560 --------------------------------- 1561 -- Check_Or_Set_Typed_Variable -- 1562 --------------------------------- 1563 1564 procedure Check_Or_Set_Typed_Variable 1565 (Value : in out Variable_Value; 1566 Declaration : Project_Node_Id) 1567 is 1568 Loc : constant Source_Ptr := Location_Of (Declaration, Node_Tree); 1569 1570 Reset_Value : Boolean := False; 1571 Current_String : Project_Node_Id; 1572 1573 begin 1574 -- Report an error for an empty string 1575 1576 if Value.Value = Empty_String then 1577 Error_Msg_Name_1 := Name_Of (Declaration, Node_Tree); 1578 1579 case Env.Flags.Allow_Invalid_External is 1580 when Error => 1581 Error_Msg 1582 (Env.Flags, "no value defined for %%", Loc, Project); 1583 when Warning => 1584 Reset_Value := True; 1585 Error_Msg 1586 (Env.Flags, "?no value defined for %%", Loc, Project); 1587 when Silent => 1588 Reset_Value := True; 1589 end case; 1590 1591 else 1592 -- Loop through all the valid strings for the 1593 -- string type and compare to the string value. 1594 1595 Current_String := 1596 First_Literal_String 1597 (String_Type_Of (Declaration, Node_Tree), Node_Tree); 1598 1599 while Present (Current_String) 1600 and then 1601 String_Value_Of (Current_String, Node_Tree) /= Value.Value 1602 loop 1603 Current_String := 1604 Next_Literal_String (Current_String, Node_Tree); 1605 end loop; 1606 1607 -- Report error if string value is not one for the string type 1608 1609 if No (Current_String) then 1610 Error_Msg_Name_1 := Value.Value; 1611 Error_Msg_Name_2 := Name_Of (Declaration, Node_Tree); 1612 1613 case Env.Flags.Allow_Invalid_External is 1614 when Error => 1615 Error_Msg 1616 (Env.Flags, "value %% is illegal for typed string %%", 1617 Loc, Project); 1618 1619 when Warning => 1620 Error_Msg 1621 (Env.Flags, "?value %% is illegal for typed string %%", 1622 Loc, Project); 1623 Reset_Value := True; 1624 1625 when Silent => 1626 Reset_Value := True; 1627 end case; 1628 end if; 1629 end if; 1630 1631 if Reset_Value then 1632 Current_String := 1633 First_Literal_String 1634 (String_Type_Of (Declaration, Node_Tree), Node_Tree); 1635 Value.Value := String_Value_Of (Current_String, Node_Tree); 1636 end if; 1637 end Check_Or_Set_Typed_Variable; 1638 1639 --------------------------------- 1640 -- Process_Package_Declaration -- 1641 --------------------------------- 1642 1643 procedure Process_Package_Declaration 1644 (Current_Item : Project_Node_Id) 1645 is 1646 begin 1647 -- Do not process a package declaration that should be ignored 1648 1649 if Expression_Kind_Of (Current_Item, Node_Tree) /= Ignored then 1650 1651 -- Create the new package 1652 1653 Package_Table.Increment_Last (Shared.Packages); 1654 1655 declare 1656 New_Pkg : constant Package_Id := 1657 Package_Table.Last (Shared.Packages); 1658 The_New_Package : Package_Element; 1659 1660 Project_Of_Renamed_Package : constant Project_Node_Id := 1661 Project_Of_Renamed_Package_Of 1662 (Current_Item, Node_Tree); 1663 1664 begin 1665 -- Set the name of the new package 1666 1667 The_New_Package.Name := Name_Of (Current_Item, Node_Tree); 1668 1669 -- Insert the new package in the appropriate list 1670 1671 if Pkg /= No_Package then 1672 The_New_Package.Next := 1673 Shared.Packages.Table (Pkg).Decl.Packages; 1674 Shared.Packages.Table (Pkg).Decl.Packages := New_Pkg; 1675 1676 else 1677 The_New_Package.Next := Project.Decl.Packages; 1678 Project.Decl.Packages := New_Pkg; 1679 end if; 1680 1681 Shared.Packages.Table (New_Pkg) := The_New_Package; 1682 1683 if Present (Project_Of_Renamed_Package) then 1684 1685 -- Renamed or extending package 1686 1687 declare 1688 Project_Name : constant Name_Id := 1689 Name_Of (Project_Of_Renamed_Package, 1690 Node_Tree); 1691 1692 Renamed_Project : constant Project_Id := 1693 Imported_Or_Extended_Project_From 1694 (Project, Project_Name); 1695 1696 Renamed_Package : constant Package_Id := 1697 Package_From 1698 (Renamed_Project, Shared, 1699 Name_Of (Current_Item, Node_Tree)); 1700 1701 begin 1702 -- For a renamed package, copy the declarations of the 1703 -- renamed package, but set all the locations to the 1704 -- location of the package name in the renaming 1705 -- declaration. 1706 1707 Copy_Package_Declarations 1708 (From => Shared.Packages.Table 1709 (Renamed_Package).Decl, 1710 To => Shared.Packages.Table (New_Pkg).Decl, 1711 New_Loc => Location_Of (Current_Item, Node_Tree), 1712 Restricted => False, 1713 Shared => Shared); 1714 end; 1715 1716 else 1717 -- Set the default values of the attributes 1718 1719 Add_Attributes 1720 (Project, 1721 Project.Name, 1722 Name_Id (Project.Directory.Display_Name), 1723 Shared, 1724 Shared.Packages.Table (New_Pkg).Decl, 1725 First_Attribute_Of 1726 (Package_Id_Of (Current_Item, Node_Tree)), 1727 Project_Level => False); 1728 end if; 1729 1730 -- Process declarative items (nothing to do when the package is 1731 -- renaming, as the first declarative item is null). 1732 1733 Process_Declarative_Items 1734 (Project => Project, 1735 In_Tree => In_Tree, 1736 From_Project_Node => From_Project_Node, 1737 Node_Tree => Node_Tree, 1738 Env => Env, 1739 Pkg => New_Pkg, 1740 Item => 1741 First_Declarative_Item_Of (Current_Item, Node_Tree), 1742 Child_Env => Child_Env); 1743 end; 1744 end if; 1745 end Process_Package_Declaration; 1746 1747 ------------------------------- 1748 -- Process_Associative_Array -- 1749 ------------------------------- 1750 1751 procedure Process_Associative_Array 1752 (Current_Item : Project_Node_Id) 1753 is 1754 Current_Item_Name : constant Name_Id := 1755 Name_Of (Current_Item, Node_Tree); 1756 -- The name of the attribute 1757 1758 Current_Location : constant Source_Ptr := 1759 Location_Of (Current_Item, Node_Tree); 1760 1761 New_Array : Array_Id; 1762 -- The new associative array created 1763 1764 Orig_Array : Array_Id; 1765 -- The associative array value 1766 1767 Orig_Project_Name : Name_Id := No_Name; 1768 -- The name of the project where the associative array 1769 -- value is. 1770 1771 Orig_Project : Project_Id := No_Project; 1772 -- The id of the project where the associative array 1773 -- value is. 1774 1775 Orig_Package_Name : Name_Id := No_Name; 1776 -- The name of the package, if any, where the associative array value 1777 -- is located. 1778 1779 Orig_Package : Package_Id := No_Package; 1780 -- The id of the package, if any, where the associative array value 1781 -- is located. 1782 1783 New_Element : Array_Element_Id := No_Array_Element; 1784 -- Id of a new array element created 1785 1786 Prev_Element : Array_Element_Id := No_Array_Element; 1787 -- Last new element id created 1788 1789 Orig_Element : Array_Element_Id := No_Array_Element; 1790 -- Current array element in original associative array 1791 1792 Next_Element : Array_Element_Id := No_Array_Element; 1793 -- Id of the array element that follows the new element. This is not 1794 -- always nil, because values for the associative array attribute may 1795 -- already have been declared, and the array elements declared are 1796 -- reused. 1797 1798 Prj : Project_List; 1799 1800 begin 1801 -- First find if the associative array attribute already has elements 1802 -- declared. 1803 1804 if Pkg /= No_Package then 1805 New_Array := Shared.Packages.Table (Pkg).Decl.Arrays; 1806 else 1807 New_Array := Project.Decl.Arrays; 1808 end if; 1809 1810 while New_Array /= No_Array 1811 and then Shared.Arrays.Table (New_Array).Name /= Current_Item_Name 1812 loop 1813 New_Array := Shared.Arrays.Table (New_Array).Next; 1814 end loop; 1815 1816 -- If the attribute has never been declared add new entry in the 1817 -- arrays of the project/package and link it. 1818 1819 if New_Array = No_Array then 1820 Array_Table.Increment_Last (Shared.Arrays); 1821 New_Array := Array_Table.Last (Shared.Arrays); 1822 1823 if Pkg /= No_Package then 1824 Shared.Arrays.Table (New_Array) := 1825 (Name => Current_Item_Name, 1826 Location => Current_Location, 1827 Value => No_Array_Element, 1828 Next => Shared.Packages.Table (Pkg).Decl.Arrays); 1829 1830 Shared.Packages.Table (Pkg).Decl.Arrays := New_Array; 1831 1832 else 1833 Shared.Arrays.Table (New_Array) := 1834 (Name => Current_Item_Name, 1835 Location => Current_Location, 1836 Value => No_Array_Element, 1837 Next => Project.Decl.Arrays); 1838 1839 Project.Decl.Arrays := New_Array; 1840 end if; 1841 end if; 1842 1843 -- Find the project where the value is declared 1844 1845 Orig_Project_Name := 1846 Name_Of 1847 (Associative_Project_Of (Current_Item, Node_Tree), Node_Tree); 1848 1849 Prj := In_Tree.Projects; 1850 while Prj /= null loop 1851 if Prj.Project.Name = Orig_Project_Name then 1852 Orig_Project := Prj.Project; 1853 exit; 1854 end if; 1855 Prj := Prj.Next; 1856 end loop; 1857 1858 pragma Assert (Orig_Project /= No_Project, 1859 "original project not found"); 1860 1861 if No (Associative_Package_Of (Current_Item, Node_Tree)) then 1862 Orig_Array := Orig_Project.Decl.Arrays; 1863 1864 else 1865 -- If in a package, find the package where the value is declared 1866 1867 Orig_Package_Name := 1868 Name_Of 1869 (Associative_Package_Of (Current_Item, Node_Tree), Node_Tree); 1870 1871 Orig_Package := Orig_Project.Decl.Packages; 1872 pragma Assert (Orig_Package /= No_Package, 1873 "original package not found"); 1874 1875 while Shared.Packages.Table 1876 (Orig_Package).Name /= Orig_Package_Name 1877 loop 1878 Orig_Package := Shared.Packages.Table (Orig_Package).Next; 1879 pragma Assert (Orig_Package /= No_Package, 1880 "original package not found"); 1881 end loop; 1882 1883 Orig_Array := Shared.Packages.Table (Orig_Package).Decl.Arrays; 1884 end if; 1885 1886 -- Now look for the array 1887 1888 while Orig_Array /= No_Array 1889 and then Shared.Arrays.Table (Orig_Array).Name /= Current_Item_Name 1890 loop 1891 Orig_Array := Shared.Arrays.Table (Orig_Array).Next; 1892 end loop; 1893 1894 if Orig_Array = No_Array then 1895 Error_Msg 1896 (Env.Flags, 1897 "associative array value not found", 1898 Location_Of (Current_Item, Node_Tree), 1899 Project); 1900 1901 else 1902 Orig_Element := Shared.Arrays.Table (Orig_Array).Value; 1903 1904 -- Copy each array element 1905 1906 while Orig_Element /= No_Array_Element loop 1907 1908 -- Case of first element 1909 1910 if Prev_Element = No_Array_Element then 1911 1912 -- And there is no array element declared yet, create a new 1913 -- first array element. 1914 1915 if Shared.Arrays.Table (New_Array).Value = 1916 No_Array_Element 1917 then 1918 Array_Element_Table.Increment_Last 1919 (Shared.Array_Elements); 1920 New_Element := Array_Element_Table.Last 1921 (Shared.Array_Elements); 1922 Shared.Arrays.Table (New_Array).Value := New_Element; 1923 Next_Element := No_Array_Element; 1924 1925 -- Otherwise, the new element is the first 1926 1927 else 1928 New_Element := Shared.Arrays.Table (New_Array).Value; 1929 Next_Element := 1930 Shared.Array_Elements.Table (New_Element).Next; 1931 end if; 1932 1933 -- Otherwise, reuse an existing element, or create 1934 -- one if necessary. 1935 1936 else 1937 Next_Element := 1938 Shared.Array_Elements.Table (Prev_Element).Next; 1939 1940 if Next_Element = No_Array_Element then 1941 Array_Element_Table.Increment_Last 1942 (Shared.Array_Elements); 1943 New_Element := Array_Element_Table.Last 1944 (Shared.Array_Elements); 1945 Shared.Array_Elements.Table (Prev_Element).Next := 1946 New_Element; 1947 1948 else 1949 New_Element := Next_Element; 1950 Next_Element := 1951 Shared.Array_Elements.Table (New_Element).Next; 1952 end if; 1953 end if; 1954 1955 -- Copy the value of the element 1956 1957 Shared.Array_Elements.Table (New_Element) := 1958 Shared.Array_Elements.Table (Orig_Element); 1959 Shared.Array_Elements.Table (New_Element).Value.Project 1960 := Project; 1961 1962 -- Adjust the Next link 1963 1964 Shared.Array_Elements.Table (New_Element).Next := Next_Element; 1965 1966 -- Adjust the previous id for the next element 1967 1968 Prev_Element := New_Element; 1969 1970 -- Go to the next element in the original array 1971 1972 Orig_Element := Shared.Array_Elements.Table (Orig_Element).Next; 1973 end loop; 1974 1975 -- Make sure that the array ends here, in case there previously a 1976 -- greater number of elements. 1977 1978 Shared.Array_Elements.Table (New_Element).Next := No_Array_Element; 1979 end if; 1980 end Process_Associative_Array; 1981 1982 ---------------------------------------------- 1983 -- Process_Expression_For_Associative_Array -- 1984 ---------------------------------------------- 1985 1986 procedure Process_Expression_For_Associative_Array 1987 (Current : Project_Node_Id; 1988 New_Value : Variable_Value) 1989 is 1990 Name : constant Name_Id := Name_Of (Current, Node_Tree); 1991 Current_Location : constant Source_Ptr := 1992 Location_Of (Current, Node_Tree); 1993 1994 Index_Name : Name_Id := 1995 Associative_Array_Index_Of (Current, Node_Tree); 1996 1997 Source_Index : constant Int := 1998 Source_Index_Of (Current, Node_Tree); 1999 2000 The_Array : Array_Id; 2001 Elem : Array_Element_Id := No_Array_Element; 2002 2003 begin 2004 if Index_Name /= All_Other_Names then 2005 Index_Name := Get_Attribute_Index (Node_Tree, Current, Index_Name); 2006 end if; 2007 2008 -- Look for the array in the appropriate list 2009 2010 if Pkg /= No_Package then 2011 The_Array := Shared.Packages.Table (Pkg).Decl.Arrays; 2012 else 2013 The_Array := Project.Decl.Arrays; 2014 end if; 2015 2016 while The_Array /= No_Array 2017 and then Shared.Arrays.Table (The_Array).Name /= Name 2018 loop 2019 The_Array := Shared.Arrays.Table (The_Array).Next; 2020 end loop; 2021 2022 -- If the array cannot be found, create a new entry in the list. 2023 -- As The_Array_Element is initialized to No_Array_Element, a new 2024 -- element will be created automatically later 2025 2026 if The_Array = No_Array then 2027 Array_Table.Increment_Last (Shared.Arrays); 2028 The_Array := Array_Table.Last (Shared.Arrays); 2029 2030 if Pkg /= No_Package then 2031 Shared.Arrays.Table (The_Array) := 2032 (Name => Name, 2033 Location => Current_Location, 2034 Value => No_Array_Element, 2035 Next => Shared.Packages.Table (Pkg).Decl.Arrays); 2036 2037 Shared.Packages.Table (Pkg).Decl.Arrays := The_Array; 2038 2039 else 2040 Shared.Arrays.Table (The_Array) := 2041 (Name => Name, 2042 Location => Current_Location, 2043 Value => No_Array_Element, 2044 Next => Project.Decl.Arrays); 2045 2046 Project.Decl.Arrays := The_Array; 2047 end if; 2048 2049 else 2050 Elem := Shared.Arrays.Table (The_Array).Value; 2051 end if; 2052 2053 -- Look in the list, if any, to find an element with the same index 2054 -- and same source index. 2055 2056 while Elem /= No_Array_Element 2057 and then 2058 (Shared.Array_Elements.Table (Elem).Index /= Index_Name 2059 or else 2060 Shared.Array_Elements.Table (Elem).Src_Index /= Source_Index) 2061 loop 2062 Elem := Shared.Array_Elements.Table (Elem).Next; 2063 end loop; 2064 2065 -- If no such element were found, create a new one 2066 -- and insert it in the element list, with the 2067 -- proper value. 2068 2069 if Elem = No_Array_Element then 2070 Array_Element_Table.Increment_Last (Shared.Array_Elements); 2071 Elem := Array_Element_Table.Last (Shared.Array_Elements); 2072 2073 Shared.Array_Elements.Table 2074 (Elem) := 2075 (Index => Index_Name, 2076 Restricted => False, 2077 Src_Index => Source_Index, 2078 Index_Case_Sensitive => 2079 not Case_Insensitive (Current, Node_Tree), 2080 Value => New_Value, 2081 Next => Shared.Arrays.Table (The_Array).Value); 2082 2083 Shared.Arrays.Table (The_Array).Value := Elem; 2084 2085 else 2086 -- An element with the same index already exists, just replace its 2087 -- value with the new one. 2088 2089 Shared.Array_Elements.Table (Elem).Value := New_Value; 2090 end if; 2091 2092 if Name = Snames.Name_External then 2093 if In_Tree.Is_Root_Tree then 2094 Add (Child_Env.External, 2095 External_Name => Get_Name_String (Index_Name), 2096 Value => Get_Name_String (New_Value.Value), 2097 Source => From_External_Attribute); 2098 Add (Env.External, 2099 External_Name => Get_Name_String (Index_Name), 2100 Value => Get_Name_String (New_Value.Value), 2101 Source => From_External_Attribute, 2102 Silent => True); 2103 else 2104 if Current_Verbosity = High then 2105 Debug_Output 2106 ("'for External' has no effect except in root aggregate (" 2107 & Get_Name_String (Index_Name) & ")", New_Value.Value); 2108 end if; 2109 end if; 2110 end if; 2111 end Process_Expression_For_Associative_Array; 2112 2113 -------------------------------------- 2114 -- Process_Expression_Variable_Decl -- 2115 -------------------------------------- 2116 2117 procedure Process_Expression_Variable_Decl 2118 (Current_Item : Project_Node_Id; 2119 New_Value : Variable_Value) 2120 is 2121 Name : constant Name_Id := Name_Of (Current_Item, Node_Tree); 2122 2123 Is_Attribute : constant Boolean := 2124 Kind_Of (Current_Item, Node_Tree) = 2125 N_Attribute_Declaration; 2126 2127 Var : Variable_Id := No_Variable; 2128 2129 begin 2130 -- First, find the list where to find the variable or attribute 2131 2132 if Is_Attribute then 2133 if Pkg /= No_Package then 2134 Var := Shared.Packages.Table (Pkg).Decl.Attributes; 2135 else 2136 Var := Project.Decl.Attributes; 2137 end if; 2138 2139 else 2140 if Pkg /= No_Package then 2141 Var := Shared.Packages.Table (Pkg).Decl.Variables; 2142 else 2143 Var := Project.Decl.Variables; 2144 end if; 2145 end if; 2146 2147 -- Loop through the list, to find if it has already been declared 2148 2149 while Var /= No_Variable 2150 and then Shared.Variable_Elements.Table (Var).Name /= Name 2151 loop 2152 Var := Shared.Variable_Elements.Table (Var).Next; 2153 end loop; 2154 2155 -- If it has not been declared, create a new entry in the list 2156 2157 if Var = No_Variable then 2158 2159 -- All single string attribute should already have been declared 2160 -- with a default empty string value. 2161 2162 pragma Assert 2163 (not Is_Attribute, 2164 "illegal attribute declaration for " & Get_Name_String (Name)); 2165 2166 Variable_Element_Table.Increment_Last (Shared.Variable_Elements); 2167 Var := Variable_Element_Table.Last (Shared.Variable_Elements); 2168 2169 -- Put the new variable in the appropriate list 2170 2171 if Pkg /= No_Package then 2172 Shared.Variable_Elements.Table (Var) := 2173 (Next => Shared.Packages.Table (Pkg).Decl.Variables, 2174 Name => Name, 2175 Value => New_Value); 2176 Shared.Packages.Table (Pkg).Decl.Variables := Var; 2177 2178 else 2179 Shared.Variable_Elements.Table (Var) := 2180 (Next => Project.Decl.Variables, 2181 Name => Name, 2182 Value => New_Value); 2183 Project.Decl.Variables := Var; 2184 end if; 2185 2186 -- If the variable/attribute has already been declared, just 2187 -- change the value. 2188 2189 else 2190 Shared.Variable_Elements.Table (Var).Value := New_Value; 2191 end if; 2192 2193 if Is_Attribute and then Name = Snames.Name_Project_Path then 2194 if In_Tree.Is_Root_Tree then 2195 declare 2196 package Name_Ids is 2197 new Ada.Containers.Vectors (Positive, Name_Id); 2198 Val : String_List_Id := New_Value.Values; 2199 List : Name_Ids.Vector; 2200 begin 2201 -- Get all values 2202 2203 while Val /= Nil_String loop 2204 List.Prepend 2205 (Shared.String_Elements.Table (Val).Value); 2206 Val := Shared.String_Elements.Table (Val).Next; 2207 end loop; 2208 2209 -- Prepend them in the order found in the attribute 2210 2211 for K in Positive range 1 .. Positive (List.Length) loop 2212 Prj.Env.Add_Directories 2213 (Child_Env.Project_Path, 2214 Normalize_Pathname 2215 (Name => Get_Name_String 2216 (List.Element (K)), 2217 Directory => Get_Name_String 2218 (Project.Directory.Display_Name)), 2219 Prepend => True); 2220 end loop; 2221 end; 2222 2223 else 2224 if Current_Verbosity = High then 2225 Debug_Output 2226 ("'for Project_Path' has no effect except in" 2227 & " root aggregate"); 2228 end if; 2229 end if; 2230 end if; 2231 end Process_Expression_Variable_Decl; 2232 2233 ------------------------ 2234 -- Process_Expression -- 2235 ------------------------ 2236 2237 procedure Process_Expression (Current : Project_Node_Id) is 2238 New_Value : Variable_Value := 2239 Expression 2240 (Project => Project, 2241 Shared => Shared, 2242 From_Project_Node => From_Project_Node, 2243 From_Project_Node_Tree => Node_Tree, 2244 Env => Env, 2245 Pkg => Pkg, 2246 First_Term => 2247 Tree.First_Term 2248 (Expression_Of (Current, Node_Tree), Node_Tree), 2249 Kind => 2250 Expression_Kind_Of (Current, Node_Tree)); 2251 2252 begin 2253 -- Process a typed variable declaration 2254 2255 if Kind_Of (Current, Node_Tree) = N_Typed_Variable_Declaration then 2256 Check_Or_Set_Typed_Variable (New_Value, Current); 2257 end if; 2258 2259 if Kind_Of (Current, Node_Tree) /= N_Attribute_Declaration 2260 or else Associative_Array_Index_Of (Current, Node_Tree) = No_Name 2261 then 2262 Process_Expression_Variable_Decl (Current, New_Value); 2263 else 2264 Process_Expression_For_Associative_Array (Current, New_Value); 2265 end if; 2266 end Process_Expression; 2267 2268 ----------------------------------- 2269 -- Process_Attribute_Declaration -- 2270 ----------------------------------- 2271 2272 procedure Process_Attribute_Declaration (Current : Project_Node_Id) is 2273 begin 2274 if Expression_Of (Current, Node_Tree) = Empty_Node then 2275 Process_Associative_Array (Current); 2276 else 2277 Process_Expression (Current); 2278 end if; 2279 end Process_Attribute_Declaration; 2280 2281 ------------------------------- 2282 -- Process_Case_Construction -- 2283 ------------------------------- 2284 2285 procedure Process_Case_Construction 2286 (Current_Item : Project_Node_Id) 2287 is 2288 The_Project : Project_Id := Project; 2289 -- The id of the project of the case variable 2290 2291 The_Package : Package_Id := Pkg; 2292 -- The id of the package, if any, of the case variable 2293 2294 The_Variable : Variable_Value := Nil_Variable_Value; 2295 -- The case variable 2296 2297 Case_Value : Name_Id := No_Name; 2298 -- The case variable value 2299 2300 Case_Item : Project_Node_Id := Empty_Node; 2301 Choice_String : Project_Node_Id := Empty_Node; 2302 Decl_Item : Project_Node_Id := Empty_Node; 2303 2304 begin 2305 declare 2306 Variable_Node : constant Project_Node_Id := 2307 Case_Variable_Reference_Of 2308 (Current_Item, 2309 Node_Tree); 2310 2311 Var_Id : Variable_Id := No_Variable; 2312 Name : Name_Id := No_Name; 2313 2314 begin 2315 -- If a project was specified for the case variable, get its id 2316 2317 if Present (Project_Node_Of (Variable_Node, Node_Tree)) then 2318 Name := 2319 Name_Of 2320 (Project_Node_Of (Variable_Node, Node_Tree), Node_Tree); 2321 The_Project := 2322 Imported_Or_Extended_Project_From 2323 (Project, Name, No_Extending => True); 2324 The_Package := No_Package; 2325 end if; 2326 2327 -- If a package was specified for the case variable, get its id 2328 2329 if Present (Package_Node_Of (Variable_Node, Node_Tree)) then 2330 Name := 2331 Name_Of 2332 (Package_Node_Of (Variable_Node, Node_Tree), Node_Tree); 2333 The_Package := Package_From (The_Project, Shared, Name); 2334 end if; 2335 2336 Name := Name_Of (Variable_Node, Node_Tree); 2337 2338 -- First, look for the case variable into the package, if any 2339 2340 if The_Package /= No_Package then 2341 Name := Name_Of (Variable_Node, Node_Tree); 2342 2343 Var_Id := Shared.Packages.Table (The_Package).Decl.Variables; 2344 while Var_Id /= No_Variable 2345 and then Shared.Variable_Elements.Table (Var_Id).Name /= Name 2346 loop 2347 Var_Id := Shared.Variable_Elements.Table (Var_Id).Next; 2348 end loop; 2349 end if; 2350 2351 -- If not found in the package, or if there is no package, look at 2352 -- the project level. 2353 2354 if Var_Id = No_Variable 2355 and then No (Package_Node_Of (Variable_Node, Node_Tree)) 2356 then 2357 Var_Id := The_Project.Decl.Variables; 2358 while Var_Id /= No_Variable 2359 and then Shared.Variable_Elements.Table (Var_Id).Name /= Name 2360 loop 2361 Var_Id := Shared.Variable_Elements.Table (Var_Id).Next; 2362 end loop; 2363 end if; 2364 2365 if Var_Id = No_Variable then 2366 if Node_Tree.Incomplete_With then 2367 return; 2368 2369 -- Should never happen, because this has already been checked 2370 -- during parsing. 2371 2372 else 2373 Write_Line 2374 ("variable """ & Get_Name_String (Name) & """ not found"); 2375 raise Program_Error; 2376 end if; 2377 end if; 2378 2379 -- Get the case variable 2380 2381 The_Variable := Shared.Variable_Elements. Table (Var_Id).Value; 2382 2383 if The_Variable.Kind /= Single then 2384 2385 -- Should never happen, because this has already been checked 2386 -- during parsing. 2387 2388 Write_Line ("variable""" & Get_Name_String (Name) & 2389 """ is not a single string variable"); 2390 raise Program_Error; 2391 end if; 2392 2393 -- Get the case variable value 2394 2395 Case_Value := The_Variable.Value; 2396 end; 2397 2398 -- Now look into all the case items of the case construction 2399 2400 Case_Item := First_Case_Item_Of (Current_Item, Node_Tree); 2401 2402 Case_Item_Loop : 2403 while Present (Case_Item) loop 2404 Choice_String := First_Choice_Of (Case_Item, Node_Tree); 2405 2406 -- When Choice_String is nil, it means that it is the 2407 -- "when others =>" alternative. 2408 2409 if No (Choice_String) then 2410 Decl_Item := First_Declarative_Item_Of (Case_Item, Node_Tree); 2411 exit Case_Item_Loop; 2412 end if; 2413 2414 -- Look into all the alternative of this case item 2415 2416 Choice_Loop : 2417 while Present (Choice_String) loop 2418 if Case_Value = String_Value_Of (Choice_String, Node_Tree) then 2419 Decl_Item := 2420 First_Declarative_Item_Of (Case_Item, Node_Tree); 2421 exit Case_Item_Loop; 2422 end if; 2423 2424 Choice_String := Next_Literal_String (Choice_String, Node_Tree); 2425 end loop Choice_Loop; 2426 2427 Case_Item := Next_Case_Item (Case_Item, Node_Tree); 2428 end loop Case_Item_Loop; 2429 2430 -- If there is an alternative, then we process it 2431 2432 if Present (Decl_Item) then 2433 Process_Declarative_Items 2434 (Project => Project, 2435 In_Tree => In_Tree, 2436 From_Project_Node => From_Project_Node, 2437 Node_Tree => Node_Tree, 2438 Env => Env, 2439 Pkg => Pkg, 2440 Item => Decl_Item, 2441 Child_Env => Child_Env); 2442 end if; 2443 end Process_Case_Construction; 2444 2445 -- Local variables 2446 2447 Current, Decl : Project_Node_Id; 2448 Kind : Project_Node_Kind; 2449 2450 -- Start of processing for Process_Declarative_Items 2451 2452 begin 2453 Decl := Item; 2454 while Present (Decl) loop 2455 Current := Current_Item_Node (Decl, Node_Tree); 2456 Decl := Next_Declarative_Item (Decl, Node_Tree); 2457 Kind := Kind_Of (Current, Node_Tree); 2458 2459 case Kind is 2460 when N_Package_Declaration => 2461 Process_Package_Declaration (Current); 2462 2463 -- Nothing to process for string type declaration 2464 2465 when N_String_Type_Declaration => 2466 null; 2467 2468 when N_Attribute_Declaration | 2469 N_Typed_Variable_Declaration | 2470 N_Variable_Declaration => 2471 Process_Attribute_Declaration (Current); 2472 2473 when N_Case_Construction => 2474 Process_Case_Construction (Current); 2475 2476 when others => 2477 Write_Line ("Illegal declarative item: " & Kind'Img); 2478 raise Program_Error; 2479 end case; 2480 end loop; 2481 end Process_Declarative_Items; 2482 2483 ---------------------------------- 2484 -- Process_Project_Tree_Phase_1 -- 2485 ---------------------------------- 2486 2487 procedure Process_Project_Tree_Phase_1 2488 (In_Tree : Project_Tree_Ref; 2489 Project : out Project_Id; 2490 Packages_To_Check : String_List_Access; 2491 Success : out Boolean; 2492 From_Project_Node : Project_Node_Id; 2493 From_Project_Node_Tree : Project_Node_Tree_Ref; 2494 Env : in out Prj.Tree.Environment; 2495 Reset_Tree : Boolean := True; 2496 On_New_Tree_Loaded : Tree_Loaded_Callback := null) 2497 is 2498 begin 2499 if Reset_Tree then 2500 2501 -- Make sure there are no projects in the data structure 2502 2503 Free_List (In_Tree.Projects, Free_Project => True); 2504 end if; 2505 2506 Processed_Projects.Reset; 2507 2508 -- And process the main project and all of the projects it depends on, 2509 -- recursively. 2510 2511 Debug_Increase_Indent ("Process tree, phase 1"); 2512 2513 Recursive_Process 2514 (Project => Project, 2515 In_Tree => In_Tree, 2516 Packages_To_Check => Packages_To_Check, 2517 From_Project_Node => From_Project_Node, 2518 From_Project_Node_Tree => From_Project_Node_Tree, 2519 Env => Env, 2520 Extended_By => No_Project, 2521 From_Encapsulated_Lib => False, 2522 On_New_Tree_Loaded => On_New_Tree_Loaded); 2523 2524 Success := 2525 Total_Errors_Detected = 0 2526 and then 2527 (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0); 2528 2529 if Current_Verbosity = High then 2530 Debug_Decrease_Indent 2531 ("Done Process tree, phase 1, Success=" & Success'Img); 2532 end if; 2533 end Process_Project_Tree_Phase_1; 2534 2535 ---------------------------------- 2536 -- Process_Project_Tree_Phase_2 -- 2537 ---------------------------------- 2538 2539 procedure Process_Project_Tree_Phase_2 2540 (In_Tree : Project_Tree_Ref; 2541 Project : Project_Id; 2542 Success : out Boolean; 2543 From_Project_Node : Project_Node_Id; 2544 From_Project_Node_Tree : Project_Node_Tree_Ref; 2545 Env : Environment) 2546 is 2547 Obj_Dir : Path_Name_Type; 2548 Extending : Project_Id; 2549 Extending2 : Project_Id; 2550 Prj : Project_List; 2551 2552 -- Start of processing for Process_Project_Tree_Phase_2 2553 2554 begin 2555 Success := True; 2556 2557 Debug_Increase_Indent ("Process tree, phase 2", Project.Name); 2558 2559 if Project /= No_Project then 2560 Check (In_Tree, Project, From_Project_Node_Tree, Env.Flags); 2561 end if; 2562 2563 -- If main project is an extending all project, set object directory of 2564 -- all virtual extending projects to object directory of main project. 2565 2566 if Project /= No_Project 2567 and then Is_Extending_All (From_Project_Node, From_Project_Node_Tree) 2568 then 2569 declare 2570 Object_Dir : constant Path_Information := Project.Object_Directory; 2571 2572 begin 2573 Prj := In_Tree.Projects; 2574 while Prj /= null loop 2575 if Prj.Project.Virtual then 2576 Prj.Project.Object_Directory := Object_Dir; 2577 end if; 2578 2579 Prj := Prj.Next; 2580 end loop; 2581 end; 2582 end if; 2583 2584 -- Check that no extending project shares its object directory with 2585 -- the project(s) it extends. 2586 2587 if Project /= No_Project then 2588 Prj := In_Tree.Projects; 2589 while Prj /= null loop 2590 Extending := Prj.Project.Extended_By; 2591 2592 if Extending /= No_Project then 2593 Obj_Dir := Prj.Project.Object_Directory.Name; 2594 2595 -- Check that a project being extended does not share its 2596 -- object directory with any project that extends it, directly 2597 -- or indirectly, including a virtual extending project. 2598 2599 -- Start with the project directly extending it 2600 2601 Extending2 := Extending; 2602 while Extending2 /= No_Project loop 2603 if Has_Ada_Sources (Extending2) 2604 and then Extending2.Object_Directory.Name = Obj_Dir 2605 then 2606 if Extending2.Virtual then 2607 Error_Msg_Name_1 := Prj.Project.Display_Name; 2608 Error_Msg 2609 (Env.Flags, 2610 "project %% cannot be extended by a virtual" & 2611 " project with the same object directory", 2612 Prj.Project.Location, Project); 2613 2614 else 2615 Error_Msg_Name_1 := Extending2.Display_Name; 2616 Error_Msg_Name_2 := Prj.Project.Display_Name; 2617 Error_Msg 2618 (Env.Flags, 2619 "project %% cannot extend project %%", 2620 Extending2.Location, Project); 2621 Error_Msg 2622 (Env.Flags, 2623 "\they share the same object directory", 2624 Extending2.Location, Project); 2625 end if; 2626 end if; 2627 2628 -- Continue with the next extending project, if any 2629 2630 Extending2 := Extending2.Extended_By; 2631 end loop; 2632 end if; 2633 2634 Prj := Prj.Next; 2635 end loop; 2636 end if; 2637 2638 Debug_Decrease_Indent ("Done Process tree, phase 2"); 2639 2640 Success := Total_Errors_Detected = 0 2641 and then 2642 (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0); 2643 end Process_Project_Tree_Phase_2; 2644 2645 ----------------------- 2646 -- Recursive_Process -- 2647 ----------------------- 2648 2649 procedure Recursive_Process 2650 (In_Tree : Project_Tree_Ref; 2651 Project : out Project_Id; 2652 Packages_To_Check : String_List_Access; 2653 From_Project_Node : Project_Node_Id; 2654 From_Project_Node_Tree : Project_Node_Tree_Ref; 2655 Env : in out Prj.Tree.Environment; 2656 Extended_By : Project_Id; 2657 From_Encapsulated_Lib : Boolean; 2658 On_New_Tree_Loaded : Tree_Loaded_Callback := null) 2659 is 2660 Shared : constant Shared_Project_Tree_Data_Access := In_Tree.Shared; 2661 2662 Child_Env : Prj.Tree.Environment; 2663 -- Only used for the root aggregate project (if any). This is left 2664 -- uninitialized otherwise. 2665 2666 procedure Process_Imported_Projects 2667 (Imported : in out Project_List; 2668 Limited_With : Boolean); 2669 -- Process imported projects. If Limited_With is True, then only 2670 -- projects processed through a "limited with" are processed, otherwise 2671 -- only projects imported through a standard "with" are processed. 2672 -- Imported is the id of the last imported project. 2673 2674 procedure Process_Aggregated_Projects; 2675 -- Process all the projects aggregated in List. This does nothing if the 2676 -- project is not an aggregate project. 2677 2678 procedure Process_Extended_Project; 2679 -- Process the extended project: inherit all packages from the extended 2680 -- project that are not explicitly defined or renamed. Also inherit the 2681 -- languages, if attribute Languages is not explicitly defined. 2682 2683 ------------------------------- 2684 -- Process_Imported_Projects -- 2685 ------------------------------- 2686 2687 procedure Process_Imported_Projects 2688 (Imported : in out Project_List; 2689 Limited_With : Boolean) 2690 is 2691 With_Clause : Project_Node_Id; 2692 New_Project : Project_Id; 2693 Proj_Node : Project_Node_Id; 2694 2695 begin 2696 With_Clause := 2697 First_With_Clause_Of 2698 (From_Project_Node, From_Project_Node_Tree); 2699 2700 while Present (With_Clause) loop 2701 Proj_Node := 2702 Non_Limited_Project_Node_Of 2703 (With_Clause, From_Project_Node_Tree); 2704 New_Project := No_Project; 2705 2706 if (Limited_With and then No (Proj_Node)) 2707 or else (not Limited_With and then Present (Proj_Node)) 2708 then 2709 Recursive_Process 2710 (In_Tree => In_Tree, 2711 Project => New_Project, 2712 Packages_To_Check => Packages_To_Check, 2713 From_Project_Node => 2714 Project_Node_Of (With_Clause, From_Project_Node_Tree), 2715 From_Project_Node_Tree => From_Project_Node_Tree, 2716 Env => Env, 2717 Extended_By => No_Project, 2718 From_Encapsulated_Lib => From_Encapsulated_Lib, 2719 On_New_Tree_Loaded => On_New_Tree_Loaded); 2720 2721 if Imported = null then 2722 Project.Imported_Projects := new Project_List_Element' 2723 (Project => New_Project, 2724 From_Encapsulated_Lib => False, 2725 Next => null); 2726 Imported := Project.Imported_Projects; 2727 else 2728 Imported.Next := new Project_List_Element' 2729 (Project => New_Project, 2730 From_Encapsulated_Lib => False, 2731 Next => null); 2732 Imported := Imported.Next; 2733 end if; 2734 end if; 2735 2736 With_Clause := 2737 Next_With_Clause_Of (With_Clause, From_Project_Node_Tree); 2738 end loop; 2739 end Process_Imported_Projects; 2740 2741 --------------------------------- 2742 -- Process_Aggregated_Projects -- 2743 --------------------------------- 2744 2745 procedure Process_Aggregated_Projects is 2746 List : Aggregated_Project_List; 2747 Loaded_Project : Prj.Tree.Project_Node_Id; 2748 Success : Boolean := True; 2749 Tree : Project_Tree_Ref; 2750 Node_Tree : Project_Node_Tree_Ref; 2751 2752 begin 2753 if Project.Qualifier not in Aggregate_Project then 2754 return; 2755 end if; 2756 2757 Debug_Increase_Indent ("Process_Aggregated_Projects", Project.Name); 2758 2759 Prj.Nmsc.Process_Aggregated_Projects 2760 (Tree => In_Tree, 2761 Project => Project, 2762 Node_Tree => From_Project_Node_Tree, 2763 Flags => Env.Flags); 2764 2765 List := Project.Aggregated_Projects; 2766 while Success and then List /= null loop 2767 Node_Tree := new Project_Node_Tree_Data; 2768 Initialize (Node_Tree); 2769 2770 Prj.Part.Parse 2771 (In_Tree => Node_Tree, 2772 Project => Loaded_Project, 2773 Packages_To_Check => Packages_To_Check, 2774 Project_File_Name => Get_Name_String (List.Path), 2775 Errout_Handling => Prj.Part.Never_Finalize, 2776 Current_Directory => Get_Name_String (Project.Directory.Name), 2777 Is_Config_File => False, 2778 Env => Child_Env); 2779 2780 Success := not Prj.Tree.No (Loaded_Project); 2781 2782 if Success then 2783 if Node_Tree.Incomplete_With then 2784 From_Project_Node_Tree.Incomplete_With := True; 2785 end if; 2786 2787 List.Tree := new Project_Tree_Data (Is_Root_Tree => False); 2788 Prj.Initialize (List.Tree); 2789 List.Tree.Shared := In_Tree.Shared; 2790 2791 -- In aggregate library, aggregated projects are parsed using 2792 -- the aggregate library tree. 2793 2794 if Project.Qualifier = Aggregate_Library then 2795 Tree := In_Tree; 2796 else 2797 Tree := List.Tree; 2798 end if; 2799 2800 -- We can only do the phase 1 of the processing, since we do 2801 -- not have access to the configuration file yet (this is 2802 -- called when doing phase 1 of the processing for the root 2803 -- aggregate project). 2804 2805 if In_Tree.Is_Root_Tree then 2806 Process_Project_Tree_Phase_1 2807 (In_Tree => Tree, 2808 Project => List.Project, 2809 Packages_To_Check => Packages_To_Check, 2810 Success => Success, 2811 From_Project_Node => Loaded_Project, 2812 From_Project_Node_Tree => Node_Tree, 2813 Env => Child_Env, 2814 Reset_Tree => False, 2815 On_New_Tree_Loaded => On_New_Tree_Loaded); 2816 else 2817 -- use the same environment as the rest of the aggregated 2818 -- projects, ie the one that was setup by the root aggregate 2819 Process_Project_Tree_Phase_1 2820 (In_Tree => Tree, 2821 Project => List.Project, 2822 Packages_To_Check => Packages_To_Check, 2823 Success => Success, 2824 From_Project_Node => Loaded_Project, 2825 From_Project_Node_Tree => Node_Tree, 2826 Env => Env, 2827 Reset_Tree => False, 2828 On_New_Tree_Loaded => On_New_Tree_Loaded); 2829 end if; 2830 2831 if On_New_Tree_Loaded /= null then 2832 On_New_Tree_Loaded 2833 (Node_Tree, Tree, Loaded_Project, List.Project); 2834 end if; 2835 2836 else 2837 Debug_Output ("Failed to parse", Name_Id (List.Path)); 2838 end if; 2839 2840 List := List.Next; 2841 end loop; 2842 2843 Debug_Decrease_Indent ("Done Process_Aggregated_Projects"); 2844 end Process_Aggregated_Projects; 2845 2846 ------------------------------ 2847 -- Process_Extended_Project -- 2848 ------------------------------ 2849 2850 procedure Process_Extended_Project is 2851 Extended_Pkg : Package_Id; 2852 Current_Pkg : Package_Id; 2853 Element : Package_Element; 2854 First : constant Package_Id := Project.Decl.Packages; 2855 Attribute1 : Variable_Id; 2856 Attribute2 : Variable_Id; 2857 Attr_Value1 : Variable; 2858 Attr_Value2 : Variable; 2859 2860 begin 2861 Extended_Pkg := Project.Extends.Decl.Packages; 2862 while Extended_Pkg /= No_Package loop 2863 Element := Shared.Packages.Table (Extended_Pkg); 2864 2865 Current_Pkg := First; 2866 while Current_Pkg /= No_Package 2867 and then 2868 Shared.Packages.Table (Current_Pkg).Name /= Element.Name 2869 loop 2870 Current_Pkg := Shared.Packages.Table (Current_Pkg).Next; 2871 end loop; 2872 2873 if Current_Pkg = No_Package then 2874 Package_Table.Increment_Last (Shared.Packages); 2875 Current_Pkg := Package_Table.Last (Shared.Packages); 2876 Shared.Packages.Table (Current_Pkg) := 2877 (Name => Element.Name, 2878 Decl => No_Declarations, 2879 Parent => No_Package, 2880 Next => Project.Decl.Packages); 2881 Project.Decl.Packages := Current_Pkg; 2882 Copy_Package_Declarations 2883 (From => Element.Decl, 2884 To => Shared.Packages.Table (Current_Pkg).Decl, 2885 New_Loc => No_Location, 2886 Restricted => True, 2887 Shared => Shared); 2888 end if; 2889 2890 Extended_Pkg := Element.Next; 2891 end loop; 2892 2893 -- Check if attribute Languages is declared in the extending project 2894 2895 Attribute1 := Project.Decl.Attributes; 2896 while Attribute1 /= No_Variable loop 2897 Attr_Value1 := Shared.Variable_Elements. Table (Attribute1); 2898 exit when Attr_Value1.Name = Snames.Name_Languages; 2899 Attribute1 := Attr_Value1.Next; 2900 end loop; 2901 2902 if Attribute1 = No_Variable or else Attr_Value1.Value.Default then 2903 2904 -- Attribute Languages is not declared in the extending project. 2905 -- Check if it is declared in the project being extended. 2906 2907 Attribute2 := Project.Extends.Decl.Attributes; 2908 while Attribute2 /= No_Variable loop 2909 Attr_Value2 := Shared.Variable_Elements.Table (Attribute2); 2910 exit when Attr_Value2.Name = Snames.Name_Languages; 2911 Attribute2 := Attr_Value2.Next; 2912 end loop; 2913 2914 if Attribute2 /= No_Variable 2915 and then not Attr_Value2.Value.Default 2916 then 2917 -- As attribute Languages is declared in the project being 2918 -- extended, copy its value for the extending project. 2919 2920 if Attribute1 = No_Variable then 2921 Variable_Element_Table.Increment_Last 2922 (Shared.Variable_Elements); 2923 Attribute1 := Variable_Element_Table.Last 2924 (Shared.Variable_Elements); 2925 Attr_Value1.Next := Project.Decl.Attributes; 2926 Project.Decl.Attributes := Attribute1; 2927 end if; 2928 2929 Attr_Value1.Name := Snames.Name_Languages; 2930 Attr_Value1.Value := Attr_Value2.Value; 2931 Shared.Variable_Elements.Table (Attribute1) := Attr_Value1; 2932 end if; 2933 end if; 2934 end Process_Extended_Project; 2935 2936 -- Start of processing for Recursive_Process 2937 2938 begin 2939 if No (From_Project_Node) then 2940 Project := No_Project; 2941 2942 else 2943 declare 2944 Imported, Mark : Project_List; 2945 Declaration_Node : Project_Node_Id := Empty_Node; 2946 2947 Name : constant Name_Id := 2948 Name_Of (From_Project_Node, From_Project_Node_Tree); 2949 2950 Display_Name : constant Name_Id := 2951 Display_Name_Of 2952 (From_Project_Node, From_Project_Node_Tree); 2953 2954 begin 2955 Project := Processed_Projects.Get (Name); 2956 2957 if Project /= No_Project then 2958 2959 -- Make sure that, when a project is extended, the project id 2960 -- of the project extending it is recorded in its data, even 2961 -- when it has already been processed as an imported project. 2962 -- This is for virtually extended projects. 2963 2964 if Extended_By /= No_Project then 2965 Project.Extended_By := Extended_By; 2966 end if; 2967 2968 return; 2969 end if; 2970 2971 -- Check if the project is already in the tree 2972 2973 Project := No_Project; 2974 2975 declare 2976 List : Project_List := In_Tree.Projects; 2977 Path : constant Path_Name_Type := 2978 Path_Name_Of (From_Project_Node, 2979 From_Project_Node_Tree); 2980 2981 begin 2982 while List /= null loop 2983 if List.Project.Path.Display_Name = Path then 2984 Project := List.Project; 2985 exit; 2986 end if; 2987 2988 List := List.Next; 2989 end loop; 2990 end; 2991 2992 if Project = No_Project then 2993 Project := 2994 new Project_Data' 2995 (Empty_Project 2996 (Project_Qualifier_Of 2997 (From_Project_Node, From_Project_Node_Tree))); 2998 2999 -- Note that at this point we do not know yet if the project 3000 -- has been withed from an encapsulated library or not. 3001 3002 In_Tree.Projects := 3003 new Project_List_Element' 3004 (Project => Project, 3005 From_Encapsulated_Lib => False, 3006 Next => In_Tree.Projects); 3007 end if; 3008 3009 -- Keep track of this point 3010 3011 Mark := In_Tree.Projects; 3012 3013 Processed_Projects.Set (Name, Project); 3014 3015 Project.Name := Name; 3016 Project.Display_Name := Display_Name; 3017 3018 Get_Name_String (Name); 3019 3020 -- If name starts with the virtual prefix, flag the project as 3021 -- being a virtual extending project. 3022 3023 if Name_Len > Virtual_Prefix'Length 3024 and then 3025 Name_Buffer (1 .. Virtual_Prefix'Length) = Virtual_Prefix 3026 then 3027 Project.Virtual := True; 3028 end if; 3029 3030 Project.Path.Display_Name := 3031 Path_Name_Of (From_Project_Node, From_Project_Node_Tree); 3032 Get_Name_String (Project.Path.Display_Name); 3033 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); 3034 Project.Path.Name := Name_Find; 3035 3036 Project.Location := 3037 Location_Of (From_Project_Node, From_Project_Node_Tree); 3038 3039 Project.Directory.Display_Name := 3040 Directory_Of (From_Project_Node, From_Project_Node_Tree); 3041 Get_Name_String (Project.Directory.Display_Name); 3042 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); 3043 Project.Directory.Name := Name_Find; 3044 3045 Project.Extended_By := Extended_By; 3046 3047 Add_Attributes 3048 (Project, 3049 Name, 3050 Name_Id (Project.Directory.Display_Name), 3051 In_Tree.Shared, 3052 Project.Decl, 3053 Prj.Attr.Attribute_First, 3054 Project_Level => True); 3055 3056 Process_Imported_Projects (Imported, Limited_With => False); 3057 3058 if Project.Qualifier = Aggregate then 3059 Initialize_And_Copy (Child_Env, Copy_From => Env); 3060 3061 elsif Project.Qualifier = Aggregate_Library then 3062 3063 -- The child environment is the same as the current one 3064 3065 Child_Env := Env; 3066 3067 else 3068 -- No need to initialize Child_Env, since it will not be 3069 -- used anyway by Process_Declarative_Items (only the root 3070 -- aggregate can modify it, and it is never read anyway). 3071 3072 null; 3073 end if; 3074 3075 Declaration_Node := 3076 Project_Declaration_Of 3077 (From_Project_Node, From_Project_Node_Tree); 3078 3079 Recursive_Process 3080 (In_Tree => In_Tree, 3081 Project => Project.Extends, 3082 Packages_To_Check => Packages_To_Check, 3083 From_Project_Node => 3084 Extended_Project_Of 3085 (Declaration_Node, From_Project_Node_Tree), 3086 From_Project_Node_Tree => From_Project_Node_Tree, 3087 Env => Env, 3088 Extended_By => Project, 3089 From_Encapsulated_Lib => From_Encapsulated_Lib, 3090 On_New_Tree_Loaded => On_New_Tree_Loaded); 3091 3092 Process_Declarative_Items 3093 (Project => Project, 3094 In_Tree => In_Tree, 3095 From_Project_Node => From_Project_Node, 3096 Node_Tree => From_Project_Node_Tree, 3097 Env => Env, 3098 Pkg => No_Package, 3099 Item => First_Declarative_Item_Of 3100 (Declaration_Node, From_Project_Node_Tree), 3101 Child_Env => Child_Env); 3102 3103 if Project.Extends /= No_Project then 3104 Process_Extended_Project; 3105 end if; 3106 3107 Process_Imported_Projects (Imported, Limited_With => True); 3108 3109 if Total_Errors_Detected = 0 then 3110 Process_Aggregated_Projects; 3111 end if; 3112 3113 -- At this point (after Process_Declarative_Items) we have the 3114 -- attribute values set, we can backtrace In_Tree.Project and 3115 -- set the From_Encapsulated_Library status. 3116 3117 declare 3118 Lib_Standalone : constant Prj.Variable_Value := 3119 Prj.Util.Value_Of 3120 (Snames.Name_Library_Standalone, 3121 Project.Decl.Attributes, 3122 Shared); 3123 List : Project_List := In_Tree.Projects; 3124 Is_Encapsulated : Boolean; 3125 3126 begin 3127 Get_Name_String (Lib_Standalone.Value); 3128 To_Lower (Name_Buffer (1 .. Name_Len)); 3129 3130 Is_Encapsulated := Name_Buffer (1 .. Name_Len) = "encapsulated"; 3131 3132 if Is_Encapsulated then 3133 while List /= null and then List /= Mark loop 3134 List.From_Encapsulated_Lib := Is_Encapsulated; 3135 List := List.Next; 3136 end loop; 3137 end if; 3138 3139 if Total_Errors_Detected = 0 then 3140 3141 -- For an aggregate library we add the aggregated projects 3142 -- as imported ones. This is necessary to give visibility 3143 -- to all sources from the aggregates from the aggregated 3144 -- library projects. 3145 3146 if Project.Qualifier = Aggregate_Library then 3147 declare 3148 L : Aggregated_Project_List; 3149 begin 3150 L := Project.Aggregated_Projects; 3151 while L /= null loop 3152 Project.Imported_Projects := 3153 new Project_List_Element' 3154 (Project => L.Project, 3155 From_Encapsulated_Lib => Is_Encapsulated, 3156 Next => 3157 Project.Imported_Projects); 3158 L := L.Next; 3159 end loop; 3160 end; 3161 end if; 3162 end if; 3163 end; 3164 3165 if Project.Qualifier = Aggregate and then In_Tree.Is_Root_Tree then 3166 Free (Child_Env); 3167 end if; 3168 end; 3169 end if; 3170 end Recursive_Process; 3171 3172 ----------------------------- 3173 -- Set_Default_Runtime_For -- 3174 ----------------------------- 3175 3176 procedure Set_Default_Runtime_For (Language : Name_Id; Value : String) is 3177 begin 3178 Name_Len := Value'Length; 3179 Name_Buffer (1 .. Name_Len) := Value; 3180 Runtime_Defaults.Set (Language, Name_Find); 3181 end Set_Default_Runtime_For; 3182end Prj.Proc; 3183