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 package Name_Ids is new Ada.Containers.Vectors (Positive, Name_Id); 76 77 procedure Add (To_Exp : in out Name_Id; Str : Name_Id); 78 -- Concatenate two strings and returns another string if both 79 -- arguments are not null string. 80 81 -- In the following procedures, we are expected to guess the meaning of 82 -- the parameters from their names, this is never a good idea, comments 83 -- should be added precisely defining every formal ??? 84 85 procedure Add_Attributes 86 (Project : Project_Id; 87 Project_Name : Name_Id; 88 Project_Dir : Name_Id; 89 Shared : Shared_Project_Tree_Data_Access; 90 Decl : in out Declarations; 91 First : Attribute_Node_Id; 92 Project_Level : Boolean); 93 -- Add all attributes, starting with First, with their default values to 94 -- the package or project with declarations Decl. 95 96 procedure Check 97 (In_Tree : Project_Tree_Ref; 98 Project : Project_Id; 99 Node_Tree : Prj.Tree.Project_Node_Tree_Ref; 100 Flags : Processing_Flags); 101 -- Set all projects to not checked, then call Recursive_Check for the 102 -- main project Project. Project is set to No_Project if errors occurred. 103 -- Current_Dir is for optimization purposes, avoiding extra system calls. 104 -- If Allow_Duplicate_Basenames, then files with the same base names are 105 -- authorized within a project for source-based languages (never for unit 106 -- based languages) 107 108 procedure Copy_Package_Declarations 109 (From : Declarations; 110 To : in out Declarations; 111 New_Loc : Source_Ptr; 112 Restricted : Boolean; 113 Shared : Shared_Project_Tree_Data_Access); 114 -- Copy a package declaration From to To for a renamed package. Change the 115 -- locations of all the attributes to New_Loc. When Restricted is 116 -- True, do not copy attributes Body, Spec, Implementation, Specification 117 -- and Linker_Options. 118 119 function Expression 120 (Project : Project_Id; 121 Shared : Shared_Project_Tree_Data_Access; 122 From_Project_Node : Project_Node_Id; 123 From_Project_Node_Tree : Project_Node_Tree_Ref; 124 Env : Prj.Tree.Environment; 125 Pkg : Package_Id; 126 First_Term : Project_Node_Id; 127 Kind : Variable_Kind) return Variable_Value; 128 -- From N_Expression project node From_Project_Node, compute the value 129 -- of an expression and return it as a Variable_Value. 130 131 function Imported_Or_Extended_Project_From 132 (Project : Project_Id; 133 With_Name : Name_Id; 134 No_Extending : Boolean := False) return Project_Id; 135 -- Find an imported or extended project of Project whose name is With_Name. 136 -- When No_Extending is True, do not look for extending projects, returns 137 -- the exact project whose name is With_Name. 138 139 function Package_From 140 (Project : Project_Id; 141 Shared : Shared_Project_Tree_Data_Access; 142 With_Name : Name_Id) return Package_Id; 143 -- Find the package of Project whose name is With_Name 144 145 procedure Process_Declarative_Items 146 (Project : Project_Id; 147 In_Tree : Project_Tree_Ref; 148 From_Project_Node : Project_Node_Id; 149 Node_Tree : Project_Node_Tree_Ref; 150 Env : Prj.Tree.Environment; 151 Pkg : Package_Id; 152 Item : Project_Node_Id; 153 Child_Env : in out Prj.Tree.Environment); 154 -- Process declarative items starting with From_Project_Node, and put them 155 -- in declarations Decl. This is a recursive procedure; it calls itself for 156 -- a package declaration or a case construction. 157 -- 158 -- Child_Env is the modified environment after seeing declarations like 159 -- "for External(...) use" or "for Project_Path use" in aggregate projects. 160 -- It should have been initialized first. 161 162 procedure Recursive_Process 163 (In_Tree : Project_Tree_Ref; 164 Project : out Project_Id; 165 Packages_To_Check : String_List_Access; 166 From_Project_Node : Project_Node_Id; 167 From_Project_Node_Tree : Project_Node_Tree_Ref; 168 Env : in out Prj.Tree.Environment; 169 Extended_By : Project_Id; 170 From_Encapsulated_Lib : Boolean; 171 On_New_Tree_Loaded : Tree_Loaded_Callback := null); 172 -- Process project with node From_Project_Node in the tree. Do nothing if 173 -- From_Project_Node is Empty_Node. If project has already been processed, 174 -- simply return its project id. Otherwise create a new project id, mark it 175 -- as processed, call itself recursively for all imported projects and a 176 -- extended project, if any. Then process the declarative items of the 177 -- project. 178 -- 179 -- Is_Root_Project should be true only for the project that the user 180 -- explicitly loaded. In the context of aggregate projects, only that 181 -- project is allowed to modify the environment that will be used to load 182 -- projects (Child_Env). 183 -- 184 -- From_Encapsulated_Lib is true if we are parsing a project from 185 -- encapsulated library dependencies. 186 -- 187 -- If specified, On_New_Tree_Loaded is called after each aggregated project 188 -- has been processed succesfully. 189 190 function Get_Attribute_Index 191 (Tree : Project_Node_Tree_Ref; 192 Attr : Project_Node_Id; 193 Index : Name_Id) return Name_Id; 194 -- Copy the index of the attribute into Name_Buffer, converting to lower 195 -- case if the attribute is case-insensitive. 196 197 --------- 198 -- Add -- 199 --------- 200 201 procedure Add (To_Exp : in out Name_Id; Str : Name_Id) is 202 begin 203 if To_Exp = No_Name or else To_Exp = Empty_String then 204 205 -- To_Exp is nil or empty. The result is Str 206 207 To_Exp := Str; 208 209 -- If Str is nil, then do not change To_Ext 210 211 elsif Str /= No_Name and then Str /= Empty_String then 212 declare 213 S : constant String := Get_Name_String (Str); 214 begin 215 Get_Name_String (To_Exp); 216 Add_Str_To_Name_Buffer (S); 217 To_Exp := Name_Find; 218 end; 219 end if; 220 end Add; 221 222 -------------------- 223 -- Add_Attributes -- 224 -------------------- 225 226 procedure Add_Attributes 227 (Project : Project_Id; 228 Project_Name : Name_Id; 229 Project_Dir : Name_Id; 230 Shared : Shared_Project_Tree_Data_Access; 231 Decl : in out Declarations; 232 First : Attribute_Node_Id; 233 Project_Level : Boolean) 234 is 235 The_Attribute : Attribute_Node_Id := First; 236 237 begin 238 while The_Attribute /= Empty_Attribute loop 239 if Attribute_Kind_Of (The_Attribute) = Single then 240 declare 241 New_Attribute : Variable_Value; 242 243 begin 244 case Variable_Kind_Of (The_Attribute) is 245 246 -- Undefined should not happen 247 248 when Undefined => 249 pragma Assert 250 (False, "attribute with an undefined kind"); 251 raise Program_Error; 252 253 -- Single attributes have a default value of empty string 254 255 when Single => 256 New_Attribute := 257 (Project => Project, 258 Kind => Single, 259 Location => No_Location, 260 Default => True, 261 Value => Empty_String, 262 Index => 0); 263 264 -- Special cases of <project>'Name and 265 -- <project>'Project_Dir. 266 267 if Project_Level then 268 if Attribute_Name_Of (The_Attribute) = 269 Snames.Name_Name 270 then 271 New_Attribute.Value := Project_Name; 272 273 elsif Attribute_Name_Of (The_Attribute) = 274 Snames.Name_Project_Dir 275 then 276 New_Attribute.Value := Project_Dir; 277 end if; 278 end if; 279 280 -- List attributes have a default value of nil list 281 282 when List => 283 New_Attribute := 284 (Project => Project, 285 Kind => List, 286 Location => No_Location, 287 Default => True, 288 Values => Nil_String); 289 290 end case; 291 292 Variable_Element_Table.Increment_Last 293 (Shared.Variable_Elements); 294 Shared.Variable_Elements.Table 295 (Variable_Element_Table.Last (Shared.Variable_Elements)) := 296 (Next => Decl.Attributes, 297 Name => Attribute_Name_Of (The_Attribute), 298 Value => New_Attribute); 299 Decl.Attributes := 300 Variable_Element_Table.Last 301 (Shared.Variable_Elements); 302 end; 303 end if; 304 305 The_Attribute := Next_Attribute (After => The_Attribute); 306 end loop; 307 end Add_Attributes; 308 309 ----------- 310 -- Check -- 311 ----------- 312 313 procedure Check 314 (In_Tree : Project_Tree_Ref; 315 Project : Project_Id; 316 Node_Tree : Prj.Tree.Project_Node_Tree_Ref; 317 Flags : Processing_Flags) 318 is 319 begin 320 Process_Naming_Scheme (In_Tree, Project, Node_Tree, Flags); 321 322 -- Set the Other_Part field for the units 323 324 declare 325 Source1 : Source_Id; 326 Name : Name_Id; 327 Source2 : Source_Id; 328 Iter : Source_Iterator; 329 330 begin 331 Unit_Htable.Reset; 332 333 Iter := For_Each_Source (In_Tree); 334 loop 335 Source1 := Prj.Element (Iter); 336 exit when Source1 = No_Source; 337 338 if Source1.Unit /= No_Unit_Index then 339 Name := Source1.Unit.Name; 340 Source2 := Unit_Htable.Get (Name); 341 342 if Source2 = No_Source then 343 Unit_Htable.Set (K => Name, E => Source1); 344 else 345 Unit_Htable.Remove (Name); 346 end if; 347 end if; 348 349 Next (Iter); 350 end loop; 351 end; 352 end Check; 353 354 ------------------------------- 355 -- Copy_Package_Declarations -- 356 ------------------------------- 357 358 procedure Copy_Package_Declarations 359 (From : Declarations; 360 To : in out Declarations; 361 New_Loc : Source_Ptr; 362 Restricted : Boolean; 363 Shared : Shared_Project_Tree_Data_Access) 364 is 365 V1 : Variable_Id; 366 V2 : Variable_Id := No_Variable; 367 Var : Variable; 368 A1 : Array_Id; 369 A2 : Array_Id := No_Array; 370 Arr : Array_Data; 371 E1 : Array_Element_Id; 372 E2 : Array_Element_Id := No_Array_Element; 373 Elm : Array_Element; 374 375 begin 376 -- To avoid references in error messages to attribute declarations in 377 -- an original package that has been renamed, copy all the attribute 378 -- declarations of the package and change all locations to New_Loc, 379 -- the location of the renamed package. 380 381 -- First single attributes 382 383 V1 := From.Attributes; 384 while V1 /= No_Variable loop 385 386 -- Copy the attribute 387 388 Var := Shared.Variable_Elements.Table (V1); 389 V1 := Var.Next; 390 391 -- Do not copy the value of attribute Linker_Options if Restricted 392 393 if Restricted and then Var.Name = Snames.Name_Linker_Options then 394 Var.Value.Values := Nil_String; 395 end if; 396 397 -- Remove the Next component 398 399 Var.Next := No_Variable; 400 401 -- Change the location to New_Loc 402 403 Var.Value.Location := New_Loc; 404 Variable_Element_Table.Increment_Last (Shared.Variable_Elements); 405 406 -- Put in new declaration 407 408 if To.Attributes = No_Variable then 409 To.Attributes := 410 Variable_Element_Table.Last (Shared.Variable_Elements); 411 else 412 Shared.Variable_Elements.Table (V2).Next := 413 Variable_Element_Table.Last (Shared.Variable_Elements); 414 end if; 415 416 V2 := Variable_Element_Table.Last (Shared.Variable_Elements); 417 Shared.Variable_Elements.Table (V2) := Var; 418 end loop; 419 420 -- Then the associated array attributes 421 422 A1 := From.Arrays; 423 while A1 /= No_Array loop 424 Arr := Shared.Arrays.Table (A1); 425 A1 := Arr.Next; 426 427 -- Remove the Next component 428 429 Arr.Next := No_Array; 430 Array_Table.Increment_Last (Shared.Arrays); 431 432 -- Create new Array declaration 433 434 if To.Arrays = No_Array then 435 To.Arrays := Array_Table.Last (Shared.Arrays); 436 else 437 Shared.Arrays.Table (A2).Next := 438 Array_Table.Last (Shared.Arrays); 439 end if; 440 441 A2 := Array_Table.Last (Shared.Arrays); 442 443 -- Don't store the array as its first element has not been set yet 444 445 -- Copy the array elements of the array 446 447 E1 := Arr.Value; 448 Arr.Value := No_Array_Element; 449 while E1 /= No_Array_Element loop 450 451 -- Copy the array element 452 453 Elm := Shared.Array_Elements.Table (E1); 454 E1 := Elm.Next; 455 456 -- Remove the Next component 457 458 Elm.Next := No_Array_Element; 459 460 Elm.Restricted := Restricted; 461 462 -- Change the location 463 464 Elm.Value.Location := New_Loc; 465 Array_Element_Table.Increment_Last (Shared.Array_Elements); 466 467 -- Create new array element 468 469 if Arr.Value = No_Array_Element then 470 Arr.Value := Array_Element_Table.Last (Shared.Array_Elements); 471 else 472 Shared.Array_Elements.Table (E2).Next := 473 Array_Element_Table.Last (Shared.Array_Elements); 474 end if; 475 476 E2 := Array_Element_Table.Last (Shared.Array_Elements); 477 Shared.Array_Elements.Table (E2) := Elm; 478 end loop; 479 480 -- Finally, store the new array 481 482 Shared.Arrays.Table (A2) := Arr; 483 end loop; 484 end Copy_Package_Declarations; 485 486 ------------------------- 487 -- Get_Attribute_Index -- 488 ------------------------- 489 490 function Get_Attribute_Index 491 (Tree : Project_Node_Tree_Ref; 492 Attr : Project_Node_Id; 493 Index : Name_Id) return Name_Id 494 is 495 begin 496 if Index = All_Other_Names 497 or else not Case_Insensitive (Attr, Tree) 498 then 499 return Index; 500 end if; 501 502 Get_Name_String (Index); 503 To_Lower (Name_Buffer (1 .. Name_Len)); 504 return Name_Find; 505 end Get_Attribute_Index; 506 507 ---------------- 508 -- Expression -- 509 ---------------- 510 511 function Expression 512 (Project : Project_Id; 513 Shared : Shared_Project_Tree_Data_Access; 514 From_Project_Node : Project_Node_Id; 515 From_Project_Node_Tree : Project_Node_Tree_Ref; 516 Env : Prj.Tree.Environment; 517 Pkg : Package_Id; 518 First_Term : Project_Node_Id; 519 Kind : Variable_Kind) return Variable_Value 520 is 521 The_Term : Project_Node_Id; 522 -- The term in the expression list 523 524 The_Current_Term : Project_Node_Id := Empty_Node; 525 -- The current term node id 526 527 Result : Variable_Value (Kind => Kind); 528 -- The returned result 529 530 Last : String_List_Id := Nil_String; 531 -- Reference to the last string elements in Result, when Kind is List 532 533 Current_Term_Kind : Project_Node_Kind; 534 535 begin 536 Result.Project := Project; 537 Result.Location := Location_Of (First_Term, From_Project_Node_Tree); 538 539 -- Process each term of the expression, starting with First_Term 540 541 The_Term := First_Term; 542 while Present (The_Term) loop 543 The_Current_Term := Current_Term (The_Term, From_Project_Node_Tree); 544 545 if The_Current_Term /= Empty_Node then 546 Current_Term_Kind := 547 Kind_Of (The_Current_Term, From_Project_Node_Tree); 548 549 case Current_Term_Kind is 550 551 when N_Literal_String => 552 case Kind is 553 when Undefined => 554 555 -- Should never happen 556 557 pragma Assert (False, "Undefined expression kind"); 558 raise Program_Error; 559 560 when Single => 561 Add (Result.Value, 562 String_Value_Of 563 (The_Current_Term, From_Project_Node_Tree)); 564 Result.Index := 565 Source_Index_Of 566 (The_Current_Term, From_Project_Node_Tree); 567 568 when List => 569 570 String_Element_Table.Increment_Last 571 (Shared.String_Elements); 572 573 if Last = Nil_String then 574 575 -- This can happen in an expression like () & "toto" 576 577 Result.Values := String_Element_Table.Last 578 (Shared.String_Elements); 579 580 else 581 Shared.String_Elements.Table 582 (Last).Next := String_Element_Table.Last 583 (Shared.String_Elements); 584 end if; 585 586 Last := String_Element_Table.Last 587 (Shared.String_Elements); 588 589 Shared.String_Elements.Table (Last) := 590 (Value => String_Value_Of 591 (The_Current_Term, 592 From_Project_Node_Tree), 593 Index => Source_Index_Of 594 (The_Current_Term, 595 From_Project_Node_Tree), 596 Display_Value => No_Name, 597 Location => Location_Of 598 (The_Current_Term, 599 From_Project_Node_Tree), 600 Flag => False, 601 Next => Nil_String); 602 end case; 603 604 when N_Literal_String_List => 605 declare 606 String_Node : Project_Node_Id := 607 First_Expression_In_List 608 (The_Current_Term, 609 From_Project_Node_Tree); 610 611 Value : Variable_Value; 612 613 begin 614 if Present (String_Node) then 615 616 -- If String_Node is nil, it is an empty list, there is 617 -- nothing to do. 618 619 Value := Expression 620 (Project => Project, 621 Shared => Shared, 622 From_Project_Node => From_Project_Node, 623 From_Project_Node_Tree => From_Project_Node_Tree, 624 Env => Env, 625 Pkg => Pkg, 626 First_Term => 627 Tree.First_Term 628 (String_Node, From_Project_Node_Tree), 629 Kind => Single); 630 String_Element_Table.Increment_Last 631 (Shared.String_Elements); 632 633 if Result.Values = Nil_String then 634 635 -- This literal string list is the first term in a 636 -- string list expression 637 638 Result.Values := 639 String_Element_Table.Last 640 (Shared.String_Elements); 641 642 else 643 Shared.String_Elements.Table (Last).Next := 644 String_Element_Table.Last (Shared.String_Elements); 645 end if; 646 647 Last := 648 String_Element_Table.Last (Shared.String_Elements); 649 650 Shared.String_Elements.Table (Last) := 651 (Value => Value.Value, 652 Display_Value => No_Name, 653 Location => Value.Location, 654 Flag => False, 655 Next => Nil_String, 656 Index => Value.Index); 657 658 loop 659 -- Add the other element of the literal string list 660 -- one after the other. 661 662 String_Node := 663 Next_Expression_In_List 664 (String_Node, From_Project_Node_Tree); 665 666 exit when No (String_Node); 667 668 Value := 669 Expression 670 (Project => Project, 671 Shared => Shared, 672 From_Project_Node => From_Project_Node, 673 From_Project_Node_Tree => From_Project_Node_Tree, 674 Env => Env, 675 Pkg => Pkg, 676 First_Term => 677 Tree.First_Term 678 (String_Node, From_Project_Node_Tree), 679 Kind => Single); 680 681 String_Element_Table.Increment_Last 682 (Shared.String_Elements); 683 Shared.String_Elements.Table (Last).Next := 684 String_Element_Table.Last (Shared.String_Elements); 685 Last := String_Element_Table.Last 686 (Shared.String_Elements); 687 Shared.String_Elements.Table (Last) := 688 (Value => Value.Value, 689 Display_Value => No_Name, 690 Location => Value.Location, 691 Flag => False, 692 Next => Nil_String, 693 Index => Value.Index); 694 end loop; 695 end if; 696 end; 697 698 when N_Variable_Reference | N_Attribute_Reference => 699 declare 700 The_Project : Project_Id := Project; 701 The_Package : Package_Id := Pkg; 702 The_Name : Name_Id := No_Name; 703 The_Variable_Id : Variable_Id := No_Variable; 704 The_Variable : Variable_Value; 705 Term_Project : constant Project_Node_Id := 706 Project_Node_Of 707 (The_Current_Term, 708 From_Project_Node_Tree); 709 Term_Package : constant Project_Node_Id := 710 Package_Node_Of 711 (The_Current_Term, 712 From_Project_Node_Tree); 713 Index : Name_Id := No_Name; 714 715 begin 716 <<Object_Dir_Restart>> 717 The_Project := Project; 718 The_Package := Pkg; 719 The_Name := No_Name; 720 The_Variable_Id := No_Variable; 721 Index := No_Name; 722 723 if Present (Term_Project) 724 and then Term_Project /= From_Project_Node 725 then 726 -- This variable or attribute comes from another project 727 728 The_Name := 729 Name_Of (Term_Project, From_Project_Node_Tree); 730 The_Project := Imported_Or_Extended_Project_From 731 (Project => Project, 732 With_Name => The_Name, 733 No_Extending => True); 734 end if; 735 736 if Present (Term_Package) then 737 738 -- This is an attribute of a package 739 740 The_Name := 741 Name_Of (Term_Package, From_Project_Node_Tree); 742 743 The_Package := The_Project.Decl.Packages; 744 while The_Package /= No_Package 745 and then Shared.Packages.Table (The_Package).Name /= 746 The_Name 747 loop 748 The_Package := 749 Shared.Packages.Table (The_Package).Next; 750 end loop; 751 752 pragma Assert 753 (The_Package /= No_Package, "package not found."); 754 755 elsif Kind_Of (The_Current_Term, From_Project_Node_Tree) = 756 N_Attribute_Reference 757 then 758 The_Package := No_Package; 759 end if; 760 761 The_Name := 762 Name_Of (The_Current_Term, From_Project_Node_Tree); 763 764 if Current_Term_Kind = N_Attribute_Reference then 765 Index := 766 Associative_Array_Index_Of 767 (The_Current_Term, From_Project_Node_Tree); 768 end if; 769 770 -- If it is not an associative array attribute 771 772 if Index = No_Name then 773 774 -- It is not an associative array attribute 775 776 if The_Package /= No_Package then 777 778 -- First, if there is a package, look into the package 779 780 if Current_Term_Kind = N_Variable_Reference then 781 The_Variable_Id := 782 Shared.Packages.Table 783 (The_Package).Decl.Variables; 784 else 785 The_Variable_Id := 786 Shared.Packages.Table 787 (The_Package).Decl.Attributes; 788 end if; 789 790 while The_Variable_Id /= No_Variable 791 and then Shared.Variable_Elements.Table 792 (The_Variable_Id).Name /= The_Name 793 loop 794 The_Variable_Id := 795 Shared.Variable_Elements.Table 796 (The_Variable_Id).Next; 797 end loop; 798 799 end if; 800 801 if The_Variable_Id = No_Variable then 802 803 -- If we have not found it, look into the project 804 805 if Current_Term_Kind = N_Variable_Reference then 806 The_Variable_Id := The_Project.Decl.Variables; 807 else 808 The_Variable_Id := The_Project.Decl.Attributes; 809 end if; 810 811 while The_Variable_Id /= No_Variable 812 and then Shared.Variable_Elements.Table 813 (The_Variable_Id).Name /= The_Name 814 loop 815 The_Variable_Id := 816 Shared.Variable_Elements.Table 817 (The_Variable_Id).Next; 818 end loop; 819 820 end if; 821 822 if From_Project_Node_Tree.Incomplete_With then 823 if The_Variable_Id = No_Variable then 824 The_Variable := Nil_Variable_Value; 825 else 826 The_Variable := 827 Shared.Variable_Elements.Table 828 (The_Variable_Id).Value; 829 end if; 830 831 else 832 pragma Assert (The_Variable_Id /= No_Variable, 833 "variable or attribute not found"); 834 835 The_Variable := 836 Shared.Variable_Elements.Table 837 (The_Variable_Id).Value; 838 end if; 839 840 else 841 842 -- It is an associative array attribute 843 844 declare 845 The_Array : Array_Id := No_Array; 846 The_Element : Array_Element_Id := No_Array_Element; 847 Array_Index : Name_Id := No_Name; 848 849 begin 850 if The_Package /= No_Package then 851 The_Array := 852 Shared.Packages.Table (The_Package).Decl.Arrays; 853 else 854 The_Array := The_Project.Decl.Arrays; 855 end if; 856 857 while The_Array /= No_Array 858 and then Shared.Arrays.Table (The_Array).Name /= 859 The_Name 860 loop 861 The_Array := Shared.Arrays.Table (The_Array).Next; 862 end loop; 863 864 if The_Array /= No_Array then 865 The_Element := 866 Shared.Arrays.Table (The_Array).Value; 867 Array_Index := 868 Get_Attribute_Index 869 (From_Project_Node_Tree, 870 The_Current_Term, 871 Index); 872 873 while The_Element /= No_Array_Element 874 and then Shared.Array_Elements.Table 875 (The_Element).Index /= Array_Index 876 loop 877 The_Element := 878 Shared.Array_Elements.Table (The_Element).Next; 879 end loop; 880 881 end if; 882 883 if The_Element /= No_Array_Element then 884 The_Variable := 885 Shared.Array_Elements.Table (The_Element).Value; 886 887 else 888 if Expression_Kind_Of 889 (The_Current_Term, From_Project_Node_Tree) = 890 List 891 then 892 The_Variable := 893 (Project => Project, 894 Kind => List, 895 Location => No_Location, 896 Default => True, 897 Values => Nil_String); 898 else 899 The_Variable := 900 (Project => Project, 901 Kind => Single, 902 Location => No_Location, 903 Default => True, 904 Value => Empty_String, 905 Index => 0); 906 end if; 907 end if; 908 end; 909 end if; 910 911 -- Check the defaults 912 913 if Current_Term_Kind = N_Attribute_Reference then 914 declare 915 The_Default : constant Attribute_Default_Value := 916 Default_Of 917 (The_Current_Term, From_Project_Node_Tree); 918 919 begin 920 -- Check the special value for 'Target when specified 921 922 if The_Default = Target_Value 923 and then Opt.Target_Origin = Specified 924 then 925 Name_Len := 0; 926 Add_Str_To_Name_Buffer (Opt.Target_Value.all); 927 The_Variable.Value := Name_Find; 928 929 -- Check the defaults 930 931 elsif The_Variable.Default then 932 case The_Variable.Kind is 933 934 when Undefined => 935 null; 936 937 when Single => 938 case The_Default is 939 when Read_Only_Value => 940 null; 941 942 when Empty_Value => 943 The_Variable.Value := Empty_String; 944 945 when Dot_Value => 946 The_Variable.Value := Dot_String; 947 948 when Object_Dir_Value => 949 From_Project_Node_Tree.Project_Nodes.Table 950 (The_Current_Term).Name := 951 Snames.Name_Object_Dir; 952 From_Project_Node_Tree.Project_Nodes.Table 953 (The_Current_Term).Default := 954 Dot_Value; 955 goto Object_Dir_Restart; 956 957 when Target_Value => 958 if Opt.Target_Value = null then 959 The_Variable.Value := Empty_String; 960 961 else 962 Name_Len := 0; 963 Add_Str_To_Name_Buffer 964 (Opt.Target_Value.all); 965 The_Variable.Value := Name_Find; 966 end if; 967 968 when Runtime_Value => 969 Get_Name_String (Index); 970 To_Lower (Name_Buffer (1 .. Name_Len)); 971 The_Variable.Value := 972 Runtime_Defaults.Get (Name_Find); 973 if The_Variable.Value = No_Name then 974 The_Variable.Value := Empty_String; 975 end if; 976 977 end case; 978 979 when List => 980 case The_Default is 981 when Read_Only_Value => 982 null; 983 984 when Empty_Value => 985 The_Variable.Values := Nil_String; 986 987 when Dot_Value => 988 The_Variable.Values := 989 Shared.Dot_String_List; 990 991 when Object_Dir_Value | 992 Target_Value | 993 Runtime_Value => 994 null; 995 end case; 996 end case; 997 end if; 998 end; 999 end if; 1000 1001 case Kind is 1002 when Undefined => 1003 1004 -- Should never happen 1005 1006 pragma Assert (False, "undefined expression kind"); 1007 null; 1008 1009 when Single => 1010 case The_Variable.Kind is 1011 1012 when Undefined => 1013 null; 1014 1015 when Single => 1016 Add (Result.Value, The_Variable.Value); 1017 1018 when List => 1019 1020 -- Should never happen 1021 1022 pragma Assert 1023 (False, 1024 "list cannot appear in single " & 1025 "string expression"); 1026 null; 1027 end case; 1028 1029 when List => 1030 case The_Variable.Kind is 1031 1032 when Undefined => 1033 null; 1034 1035 when Single => 1036 String_Element_Table.Increment_Last 1037 (Shared.String_Elements); 1038 1039 if Last = Nil_String then 1040 1041 -- This can happen in an expression such as 1042 -- () & Var 1043 1044 Result.Values := 1045 String_Element_Table.Last 1046 (Shared.String_Elements); 1047 1048 else 1049 Shared.String_Elements.Table (Last).Next := 1050 String_Element_Table.Last 1051 (Shared.String_Elements); 1052 end if; 1053 1054 Last := 1055 String_Element_Table.Last 1056 (Shared.String_Elements); 1057 1058 Shared.String_Elements.Table (Last) := 1059 (Value => The_Variable.Value, 1060 Display_Value => No_Name, 1061 Location => Location_Of 1062 (The_Current_Term, 1063 From_Project_Node_Tree), 1064 Flag => False, 1065 Next => Nil_String, 1066 Index => 0); 1067 1068 when List => 1069 1070 declare 1071 The_List : String_List_Id := 1072 The_Variable.Values; 1073 1074 begin 1075 while The_List /= Nil_String loop 1076 String_Element_Table.Increment_Last 1077 (Shared.String_Elements); 1078 1079 if Last = Nil_String then 1080 Result.Values := 1081 String_Element_Table.Last 1082 (Shared.String_Elements); 1083 1084 else 1085 Shared. 1086 String_Elements.Table (Last).Next := 1087 String_Element_Table.Last 1088 (Shared.String_Elements); 1089 1090 end if; 1091 1092 Last := 1093 String_Element_Table.Last 1094 (Shared.String_Elements); 1095 1096 Shared.String_Elements.Table 1097 (Last) := 1098 (Value => 1099 Shared.String_Elements.Table 1100 (The_List).Value, 1101 Display_Value => No_Name, 1102 Location => 1103 Location_Of 1104 (The_Current_Term, 1105 From_Project_Node_Tree), 1106 Flag => False, 1107 Next => Nil_String, 1108 Index => 0); 1109 1110 The_List := Shared.String_Elements.Table 1111 (The_List).Next; 1112 end loop; 1113 end; 1114 end case; 1115 end case; 1116 end; 1117 1118 when N_External_Value => 1119 Get_Name_String 1120 (String_Value_Of 1121 (External_Reference_Of 1122 (The_Current_Term, From_Project_Node_Tree), 1123 From_Project_Node_Tree)); 1124 1125 declare 1126 Name : constant Name_Id := Name_Find; 1127 Default : Name_Id := No_Name; 1128 Value : Name_Id := No_Name; 1129 Ext_List : Boolean := False; 1130 Str_List : String_List_Access := null; 1131 Def_Var : Variable_Value; 1132 1133 Default_Node : constant Project_Node_Id := 1134 External_Default_Of 1135 (The_Current_Term, 1136 From_Project_Node_Tree); 1137 1138 begin 1139 -- If there is a default value for the external reference, 1140 -- get its value. 1141 1142 if Present (Default_Node) then 1143 Def_Var := Expression 1144 (Project => Project, 1145 Shared => Shared, 1146 From_Project_Node => From_Project_Node, 1147 From_Project_Node_Tree => From_Project_Node_Tree, 1148 Env => Env, 1149 Pkg => Pkg, 1150 First_Term => 1151 Tree.First_Term 1152 (Default_Node, From_Project_Node_Tree), 1153 Kind => Single); 1154 1155 if Def_Var /= Nil_Variable_Value then 1156 Default := Def_Var.Value; 1157 end if; 1158 end if; 1159 1160 Ext_List := Expression_Kind_Of 1161 (The_Current_Term, 1162 From_Project_Node_Tree) = List; 1163 1164 if Ext_List then 1165 Value := Prj.Ext.Value_Of (Env.External, Name, No_Name); 1166 1167 if Value /= No_Name then 1168 declare 1169 Sep : constant String := 1170 Get_Name_String (Default); 1171 First : Positive := 1; 1172 Lst : Natural; 1173 Done : Boolean := False; 1174 Nmb : Natural; 1175 1176 begin 1177 Get_Name_String (Value); 1178 1179 if Name_Len = 0 1180 or else Sep'Length = 0 1181 or else Name_Buffer (1 .. Name_Len) = Sep 1182 then 1183 Done := True; 1184 end if; 1185 1186 if not Done and then Name_Len < Sep'Length then 1187 Str_List := 1188 new String_List' 1189 (1 => new String' 1190 (Name_Buffer (1 .. Name_Len))); 1191 Done := True; 1192 end if; 1193 1194 if not Done then 1195 if Name_Buffer (1 .. Sep'Length) = Sep then 1196 First := Sep'Length + 1; 1197 end if; 1198 1199 if Name_Len - First + 1 >= Sep'Length 1200 and then 1201 Name_Buffer (Name_Len - Sep'Length + 1 .. 1202 Name_Len) = Sep 1203 then 1204 Name_Len := Name_Len - Sep'Length; 1205 end if; 1206 1207 if Name_Len = 0 then 1208 Str_List := 1209 new String_List'(1 => new String'("")); 1210 Done := True; 1211 end if; 1212 end if; 1213 1214 if not Done then 1215 1216 -- Count the number of strings 1217 1218 declare 1219 Saved : constant Positive := First; 1220 1221 begin 1222 Nmb := 1; 1223 loop 1224 Lst := 1225 Index 1226 (Source => 1227 Name_Buffer (First .. Name_Len), 1228 Pattern => Sep); 1229 exit when Lst = 0; 1230 Nmb := Nmb + 1; 1231 First := Lst + Sep'Length; 1232 end loop; 1233 1234 First := Saved; 1235 end; 1236 1237 Str_List := new String_List (1 .. Nmb); 1238 1239 -- Populate the string list 1240 1241 Nmb := 1; 1242 loop 1243 Lst := 1244 Index 1245 (Source => 1246 Name_Buffer (First .. Name_Len), 1247 Pattern => Sep); 1248 1249 if Lst = 0 then 1250 Str_List (Nmb) := 1251 new String' 1252 (Name_Buffer (First .. Name_Len)); 1253 exit; 1254 1255 else 1256 Str_List (Nmb) := 1257 new String' 1258 (Name_Buffer (First .. Lst - 1)); 1259 Nmb := Nmb + 1; 1260 First := Lst + Sep'Length; 1261 end if; 1262 end loop; 1263 end if; 1264 end; 1265 end if; 1266 1267 else 1268 -- Get the value 1269 1270 Value := Prj.Ext.Value_Of (Env.External, Name, Default); 1271 1272 if Value = No_Name then 1273 if not Quiet_Output then 1274 Error_Msg 1275 (Env.Flags, "?undefined external reference", 1276 Location_Of 1277 (The_Current_Term, From_Project_Node_Tree), 1278 Project); 1279 end if; 1280 1281 Value := Empty_String; 1282 end if; 1283 end if; 1284 1285 case Kind is 1286 1287 when Undefined => 1288 null; 1289 1290 when Single => 1291 if Ext_List then 1292 null; -- error 1293 1294 else 1295 Add (Result.Value, Value); 1296 end if; 1297 1298 when List => 1299 if not Ext_List or else Str_List /= null then 1300 String_Element_Table.Increment_Last 1301 (Shared.String_Elements); 1302 1303 if Last = Nil_String then 1304 Result.Values := 1305 String_Element_Table.Last 1306 (Shared.String_Elements); 1307 1308 else 1309 Shared.String_Elements.Table (Last).Next 1310 := String_Element_Table.Last 1311 (Shared.String_Elements); 1312 end if; 1313 1314 Last := String_Element_Table.Last 1315 (Shared.String_Elements); 1316 1317 if Ext_List then 1318 for Ind in Str_List'Range loop 1319 Name_Len := 0; 1320 Add_Str_To_Name_Buffer (Str_List (Ind).all); 1321 Value := Name_Find; 1322 Shared.String_Elements.Table (Last) := 1323 (Value => Value, 1324 Display_Value => No_Name, 1325 Location => 1326 Location_Of 1327 (The_Current_Term, 1328 From_Project_Node_Tree), 1329 Flag => False, 1330 Next => Nil_String, 1331 Index => 0); 1332 1333 if Ind /= Str_List'Last then 1334 String_Element_Table.Increment_Last 1335 (Shared.String_Elements); 1336 Shared.String_Elements.Table (Last).Next := 1337 String_Element_Table.Last 1338 (Shared.String_Elements); 1339 Last := String_Element_Table.Last 1340 (Shared.String_Elements); 1341 end if; 1342 end loop; 1343 1344 else 1345 Shared.String_Elements.Table (Last) := 1346 (Value => Value, 1347 Display_Value => No_Name, 1348 Location => 1349 Location_Of 1350 (The_Current_Term, 1351 From_Project_Node_Tree), 1352 Flag => False, 1353 Next => Nil_String, 1354 Index => 0); 1355 end if; 1356 end if; 1357 end case; 1358 end; 1359 1360 when others => 1361 1362 -- Should never happen 1363 1364 pragma Assert 1365 (False, 1366 "illegal node kind in an expression"); 1367 raise Program_Error; 1368 1369 end case; 1370 end if; 1371 1372 The_Term := Next_Term (The_Term, From_Project_Node_Tree); 1373 end loop; 1374 1375 return Result; 1376 end Expression; 1377 1378 --------------------------------------- 1379 -- Imported_Or_Extended_Project_From -- 1380 --------------------------------------- 1381 1382 function Imported_Or_Extended_Project_From 1383 (Project : Project_Id; 1384 With_Name : Name_Id; 1385 No_Extending : Boolean := False) return Project_Id 1386 is 1387 List : Project_List; 1388 Result : Project_Id; 1389 Temp_Result : Project_Id; 1390 1391 begin 1392 -- First check if it is the name of an extended project 1393 1394 Result := Project.Extends; 1395 while Result /= No_Project loop 1396 if Result.Name = With_Name then 1397 return Result; 1398 else 1399 Result := Result.Extends; 1400 end if; 1401 end loop; 1402 1403 -- Then check the name of each imported project 1404 1405 Temp_Result := No_Project; 1406 List := Project.Imported_Projects; 1407 while List /= null loop 1408 Result := List.Project; 1409 1410 -- If the project is directly imported, then returns its ID 1411 1412 if Result.Name = With_Name then 1413 return Result; 1414 end if; 1415 1416 -- If a project extending the project is imported, then keep this 1417 -- extending project as a possibility. It will be the returned ID 1418 -- if the project is not imported directly. 1419 1420 declare 1421 Proj : Project_Id; 1422 1423 begin 1424 Proj := Result.Extends; 1425 while Proj /= No_Project loop 1426 if Proj.Name = With_Name then 1427 if No_Extending then 1428 Temp_Result := Proj; 1429 else 1430 Temp_Result := Result; 1431 end if; 1432 1433 exit; 1434 end if; 1435 1436 Proj := Proj.Extends; 1437 end loop; 1438 end; 1439 1440 List := List.Next; 1441 end loop; 1442 1443 pragma Assert (Temp_Result /= No_Project, "project not found"); 1444 return Temp_Result; 1445 end Imported_Or_Extended_Project_From; 1446 1447 ------------------ 1448 -- Package_From -- 1449 ------------------ 1450 1451 function Package_From 1452 (Project : Project_Id; 1453 Shared : Shared_Project_Tree_Data_Access; 1454 With_Name : Name_Id) return Package_Id 1455 is 1456 Result : Package_Id := Project.Decl.Packages; 1457 1458 begin 1459 -- Check the name of each existing package of Project 1460 1461 while Result /= No_Package 1462 and then Shared.Packages.Table (Result).Name /= With_Name 1463 loop 1464 Result := Shared.Packages.Table (Result).Next; 1465 end loop; 1466 1467 if Result = No_Package then 1468 1469 -- Should never happen 1470 1471 Write_Line 1472 ("package """ & Get_Name_String (With_Name) & """ not found"); 1473 raise Program_Error; 1474 1475 else 1476 return Result; 1477 end if; 1478 end Package_From; 1479 1480 ------------- 1481 -- Process -- 1482 ------------- 1483 1484 procedure Process 1485 (In_Tree : Project_Tree_Ref; 1486 Project : out Project_Id; 1487 Packages_To_Check : String_List_Access; 1488 Success : out Boolean; 1489 From_Project_Node : Project_Node_Id; 1490 From_Project_Node_Tree : Project_Node_Tree_Ref; 1491 Env : in out Prj.Tree.Environment; 1492 Reset_Tree : Boolean := True; 1493 On_New_Tree_Loaded : Tree_Loaded_Callback := null) 1494 is 1495 begin 1496 Process_Project_Tree_Phase_1 1497 (In_Tree => In_Tree, 1498 Project => Project, 1499 Success => Success, 1500 From_Project_Node => From_Project_Node, 1501 From_Project_Node_Tree => From_Project_Node_Tree, 1502 Env => Env, 1503 Packages_To_Check => Packages_To_Check, 1504 Reset_Tree => Reset_Tree, 1505 On_New_Tree_Loaded => On_New_Tree_Loaded); 1506 1507 if Project_Qualifier_Of 1508 (From_Project_Node, From_Project_Node_Tree) /= Configuration 1509 then 1510 Process_Project_Tree_Phase_2 1511 (In_Tree => In_Tree, 1512 Project => Project, 1513 Success => Success, 1514 From_Project_Node => From_Project_Node, 1515 From_Project_Node_Tree => From_Project_Node_Tree, 1516 Env => Env); 1517 end if; 1518 end Process; 1519 1520 ------------------------------- 1521 -- Process_Declarative_Items -- 1522 ------------------------------- 1523 1524 procedure Process_Declarative_Items 1525 (Project : Project_Id; 1526 In_Tree : Project_Tree_Ref; 1527 From_Project_Node : Project_Node_Id; 1528 Node_Tree : Project_Node_Tree_Ref; 1529 Env : Prj.Tree.Environment; 1530 Pkg : Package_Id; 1531 Item : Project_Node_Id; 1532 Child_Env : in out Prj.Tree.Environment) 1533 is 1534 Shared : constant Shared_Project_Tree_Data_Access := In_Tree.Shared; 1535 1536 procedure Check_Or_Set_Typed_Variable 1537 (Value : in out Variable_Value; 1538 Declaration : Project_Node_Id); 1539 -- Check whether Value is valid for this typed variable declaration. If 1540 -- it is an error, the behavior depends on the flags: either an error is 1541 -- reported, or a warning, or nothing. In the last two cases, the value 1542 -- of the variable is set to a valid value, replacing Value. 1543 1544 procedure Process_Package_Declaration 1545 (Current_Item : Project_Node_Id); 1546 procedure Process_Attribute_Declaration 1547 (Current : Project_Node_Id); 1548 procedure Process_Case_Construction 1549 (Current_Item : Project_Node_Id); 1550 procedure Process_Associative_Array 1551 (Current_Item : Project_Node_Id); 1552 procedure Process_Expression 1553 (Current : Project_Node_Id); 1554 procedure Process_Expression_For_Associative_Array 1555 (Current : Project_Node_Id; 1556 New_Value : Variable_Value); 1557 procedure Process_Expression_Variable_Decl 1558 (Current_Item : Project_Node_Id; 1559 New_Value : Variable_Value); 1560 -- Process the various declarative items 1561 1562 --------------------------------- 1563 -- Check_Or_Set_Typed_Variable -- 1564 --------------------------------- 1565 1566 procedure Check_Or_Set_Typed_Variable 1567 (Value : in out Variable_Value; 1568 Declaration : Project_Node_Id) 1569 is 1570 Loc : constant Source_Ptr := Location_Of (Declaration, Node_Tree); 1571 1572 Reset_Value : Boolean := False; 1573 Current_String : Project_Node_Id; 1574 1575 begin 1576 -- Report an error for an empty string 1577 1578 if Value.Value = Empty_String then 1579 Error_Msg_Name_1 := Name_Of (Declaration, Node_Tree); 1580 1581 case Env.Flags.Allow_Invalid_External is 1582 when Error => 1583 Error_Msg 1584 (Env.Flags, "no value defined for %%", Loc, Project); 1585 when Warning => 1586 Reset_Value := True; 1587 Error_Msg 1588 (Env.Flags, "?no value defined for %%", Loc, Project); 1589 when Silent => 1590 Reset_Value := True; 1591 end case; 1592 1593 else 1594 -- Loop through all the valid strings for the 1595 -- string type and compare to the string value. 1596 1597 Current_String := 1598 First_Literal_String 1599 (String_Type_Of (Declaration, Node_Tree), Node_Tree); 1600 1601 while Present (Current_String) 1602 and then 1603 String_Value_Of (Current_String, Node_Tree) /= Value.Value 1604 loop 1605 Current_String := 1606 Next_Literal_String (Current_String, Node_Tree); 1607 end loop; 1608 1609 -- Report error if string value is not one for the string type 1610 1611 if No (Current_String) then 1612 Error_Msg_Name_1 := Value.Value; 1613 Error_Msg_Name_2 := Name_Of (Declaration, Node_Tree); 1614 1615 case Env.Flags.Allow_Invalid_External is 1616 when Error => 1617 Error_Msg 1618 (Env.Flags, "value %% is illegal for typed string %%", 1619 Loc, Project); 1620 1621 when Warning => 1622 Error_Msg 1623 (Env.Flags, "?value %% is illegal for typed string %%", 1624 Loc, Project); 1625 Reset_Value := True; 1626 1627 when Silent => 1628 Reset_Value := True; 1629 end case; 1630 end if; 1631 end if; 1632 1633 if Reset_Value then 1634 Current_String := 1635 First_Literal_String 1636 (String_Type_Of (Declaration, Node_Tree), Node_Tree); 1637 Value.Value := String_Value_Of (Current_String, Node_Tree); 1638 end if; 1639 end Check_Or_Set_Typed_Variable; 1640 1641 --------------------------------- 1642 -- Process_Package_Declaration -- 1643 --------------------------------- 1644 1645 procedure Process_Package_Declaration 1646 (Current_Item : Project_Node_Id) 1647 is 1648 begin 1649 -- Do not process a package declaration that should be ignored 1650 1651 if Expression_Kind_Of (Current_Item, Node_Tree) /= Ignored then 1652 1653 -- Create the new package 1654 1655 Package_Table.Increment_Last (Shared.Packages); 1656 1657 declare 1658 New_Pkg : constant Package_Id := 1659 Package_Table.Last (Shared.Packages); 1660 The_New_Package : Package_Element; 1661 1662 Project_Of_Renamed_Package : constant Project_Node_Id := 1663 Project_Of_Renamed_Package_Of 1664 (Current_Item, Node_Tree); 1665 1666 begin 1667 -- Set the name of the new package 1668 1669 The_New_Package.Name := Name_Of (Current_Item, Node_Tree); 1670 1671 -- Insert the new package in the appropriate list 1672 1673 if Pkg /= No_Package then 1674 The_New_Package.Next := 1675 Shared.Packages.Table (Pkg).Decl.Packages; 1676 Shared.Packages.Table (Pkg).Decl.Packages := New_Pkg; 1677 1678 else 1679 The_New_Package.Next := Project.Decl.Packages; 1680 Project.Decl.Packages := New_Pkg; 1681 end if; 1682 1683 Shared.Packages.Table (New_Pkg) := The_New_Package; 1684 1685 if Present (Project_Of_Renamed_Package) then 1686 1687 -- Renamed or extending package 1688 1689 declare 1690 Project_Name : constant Name_Id := 1691 Name_Of (Project_Of_Renamed_Package, 1692 Node_Tree); 1693 1694 Renamed_Project : constant Project_Id := 1695 Imported_Or_Extended_Project_From 1696 (Project, Project_Name); 1697 1698 Renamed_Package : constant Package_Id := 1699 Package_From 1700 (Renamed_Project, Shared, 1701 Name_Of (Current_Item, Node_Tree)); 1702 1703 begin 1704 -- For a renamed package, copy the declarations of the 1705 -- renamed package, but set all the locations to the 1706 -- location of the package name in the renaming 1707 -- declaration. 1708 1709 Copy_Package_Declarations 1710 (From => Shared.Packages.Table 1711 (Renamed_Package).Decl, 1712 To => Shared.Packages.Table (New_Pkg).Decl, 1713 New_Loc => Location_Of (Current_Item, Node_Tree), 1714 Restricted => False, 1715 Shared => Shared); 1716 end; 1717 1718 else 1719 -- Set the default values of the attributes 1720 1721 Add_Attributes 1722 (Project, 1723 Project.Name, 1724 Name_Id (Project.Directory.Display_Name), 1725 Shared, 1726 Shared.Packages.Table (New_Pkg).Decl, 1727 First_Attribute_Of 1728 (Package_Id_Of (Current_Item, Node_Tree)), 1729 Project_Level => False); 1730 end if; 1731 1732 -- Process declarative items (nothing to do when the package is 1733 -- renaming, as the first declarative item is null). 1734 1735 Process_Declarative_Items 1736 (Project => Project, 1737 In_Tree => In_Tree, 1738 From_Project_Node => From_Project_Node, 1739 Node_Tree => Node_Tree, 1740 Env => Env, 1741 Pkg => New_Pkg, 1742 Item => 1743 First_Declarative_Item_Of (Current_Item, Node_Tree), 1744 Child_Env => Child_Env); 1745 end; 1746 end if; 1747 end Process_Package_Declaration; 1748 1749 ------------------------------- 1750 -- Process_Associative_Array -- 1751 ------------------------------- 1752 1753 procedure Process_Associative_Array 1754 (Current_Item : Project_Node_Id) 1755 is 1756 Current_Item_Name : constant Name_Id := 1757 Name_Of (Current_Item, Node_Tree); 1758 -- The name of the attribute 1759 1760 Current_Location : constant Source_Ptr := 1761 Location_Of (Current_Item, Node_Tree); 1762 1763 New_Array : Array_Id; 1764 -- The new associative array created 1765 1766 Orig_Array : Array_Id; 1767 -- The associative array value 1768 1769 Orig_Project_Name : Name_Id := No_Name; 1770 -- The name of the project where the associative array 1771 -- value is. 1772 1773 Orig_Project : Project_Id := No_Project; 1774 -- The id of the project where the associative array 1775 -- value is. 1776 1777 Orig_Package_Name : Name_Id := No_Name; 1778 -- The name of the package, if any, where the associative array value 1779 -- is located. 1780 1781 Orig_Package : Package_Id := No_Package; 1782 -- The id of the package, if any, where the associative array value 1783 -- is located. 1784 1785 New_Element : Array_Element_Id := No_Array_Element; 1786 -- Id of a new array element created 1787 1788 Prev_Element : Array_Element_Id := No_Array_Element; 1789 -- Last new element id created 1790 1791 Orig_Element : Array_Element_Id := No_Array_Element; 1792 -- Current array element in original associative array 1793 1794 Next_Element : Array_Element_Id := No_Array_Element; 1795 -- Id of the array element that follows the new element. This is not 1796 -- always nil, because values for the associative array attribute may 1797 -- already have been declared, and the array elements declared are 1798 -- reused. 1799 1800 Prj : Project_List; 1801 1802 begin 1803 -- First find if the associative array attribute already has elements 1804 -- declared. 1805 1806 if Pkg /= No_Package then 1807 New_Array := Shared.Packages.Table (Pkg).Decl.Arrays; 1808 else 1809 New_Array := Project.Decl.Arrays; 1810 end if; 1811 1812 while New_Array /= No_Array 1813 and then Shared.Arrays.Table (New_Array).Name /= Current_Item_Name 1814 loop 1815 New_Array := Shared.Arrays.Table (New_Array).Next; 1816 end loop; 1817 1818 -- If the attribute has never been declared add new entry in the 1819 -- arrays of the project/package and link it. 1820 1821 if New_Array = No_Array then 1822 Array_Table.Increment_Last (Shared.Arrays); 1823 New_Array := Array_Table.Last (Shared.Arrays); 1824 1825 if Pkg /= No_Package then 1826 Shared.Arrays.Table (New_Array) := 1827 (Name => Current_Item_Name, 1828 Location => Current_Location, 1829 Value => No_Array_Element, 1830 Next => Shared.Packages.Table (Pkg).Decl.Arrays); 1831 1832 Shared.Packages.Table (Pkg).Decl.Arrays := New_Array; 1833 1834 else 1835 Shared.Arrays.Table (New_Array) := 1836 (Name => Current_Item_Name, 1837 Location => Current_Location, 1838 Value => No_Array_Element, 1839 Next => Project.Decl.Arrays); 1840 1841 Project.Decl.Arrays := New_Array; 1842 end if; 1843 end if; 1844 1845 -- Find the project where the value is declared 1846 1847 Orig_Project_Name := 1848 Name_Of 1849 (Associative_Project_Of (Current_Item, Node_Tree), Node_Tree); 1850 1851 Prj := In_Tree.Projects; 1852 while Prj /= null loop 1853 if Prj.Project.Name = Orig_Project_Name then 1854 Orig_Project := Prj.Project; 1855 exit; 1856 end if; 1857 Prj := Prj.Next; 1858 end loop; 1859 1860 pragma Assert (Orig_Project /= No_Project, 1861 "original project not found"); 1862 1863 if No (Associative_Package_Of (Current_Item, Node_Tree)) then 1864 Orig_Array := Orig_Project.Decl.Arrays; 1865 1866 else 1867 -- If in a package, find the package where the value is declared 1868 1869 Orig_Package_Name := 1870 Name_Of 1871 (Associative_Package_Of (Current_Item, Node_Tree), Node_Tree); 1872 1873 Orig_Package := Orig_Project.Decl.Packages; 1874 pragma Assert (Orig_Package /= No_Package, 1875 "original package not found"); 1876 1877 while Shared.Packages.Table 1878 (Orig_Package).Name /= Orig_Package_Name 1879 loop 1880 Orig_Package := Shared.Packages.Table (Orig_Package).Next; 1881 pragma Assert (Orig_Package /= No_Package, 1882 "original package not found"); 1883 end loop; 1884 1885 Orig_Array := Shared.Packages.Table (Orig_Package).Decl.Arrays; 1886 end if; 1887 1888 -- Now look for the array 1889 1890 while Orig_Array /= No_Array 1891 and then Shared.Arrays.Table (Orig_Array).Name /= Current_Item_Name 1892 loop 1893 Orig_Array := Shared.Arrays.Table (Orig_Array).Next; 1894 end loop; 1895 1896 if Orig_Array = No_Array then 1897 Error_Msg 1898 (Env.Flags, 1899 "associative array value not found", 1900 Location_Of (Current_Item, Node_Tree), 1901 Project); 1902 1903 else 1904 Orig_Element := Shared.Arrays.Table (Orig_Array).Value; 1905 1906 -- Copy each array element 1907 1908 while Orig_Element /= No_Array_Element loop 1909 1910 -- Case of first element 1911 1912 if Prev_Element = No_Array_Element then 1913 1914 -- And there is no array element declared yet, create a new 1915 -- first array element. 1916 1917 if Shared.Arrays.Table (New_Array).Value = 1918 No_Array_Element 1919 then 1920 Array_Element_Table.Increment_Last 1921 (Shared.Array_Elements); 1922 New_Element := Array_Element_Table.Last 1923 (Shared.Array_Elements); 1924 Shared.Arrays.Table (New_Array).Value := New_Element; 1925 Next_Element := No_Array_Element; 1926 1927 -- Otherwise, the new element is the first 1928 1929 else 1930 New_Element := Shared.Arrays.Table (New_Array).Value; 1931 Next_Element := 1932 Shared.Array_Elements.Table (New_Element).Next; 1933 end if; 1934 1935 -- Otherwise, reuse an existing element, or create 1936 -- one if necessary. 1937 1938 else 1939 Next_Element := 1940 Shared.Array_Elements.Table (Prev_Element).Next; 1941 1942 if Next_Element = No_Array_Element then 1943 Array_Element_Table.Increment_Last 1944 (Shared.Array_Elements); 1945 New_Element := Array_Element_Table.Last 1946 (Shared.Array_Elements); 1947 Shared.Array_Elements.Table (Prev_Element).Next := 1948 New_Element; 1949 1950 else 1951 New_Element := Next_Element; 1952 Next_Element := 1953 Shared.Array_Elements.Table (New_Element).Next; 1954 end if; 1955 end if; 1956 1957 -- Copy the value of the element 1958 1959 Shared.Array_Elements.Table (New_Element) := 1960 Shared.Array_Elements.Table (Orig_Element); 1961 Shared.Array_Elements.Table (New_Element).Value.Project 1962 := Project; 1963 1964 -- Adjust the Next link 1965 1966 Shared.Array_Elements.Table (New_Element).Next := Next_Element; 1967 1968 -- Adjust the previous id for the next element 1969 1970 Prev_Element := New_Element; 1971 1972 -- Go to the next element in the original array 1973 1974 Orig_Element := Shared.Array_Elements.Table (Orig_Element).Next; 1975 end loop; 1976 1977 -- Make sure that the array ends here, in case there previously a 1978 -- greater number of elements. 1979 1980 Shared.Array_Elements.Table (New_Element).Next := No_Array_Element; 1981 end if; 1982 end Process_Associative_Array; 1983 1984 ---------------------------------------------- 1985 -- Process_Expression_For_Associative_Array -- 1986 ---------------------------------------------- 1987 1988 procedure Process_Expression_For_Associative_Array 1989 (Current : Project_Node_Id; 1990 New_Value : Variable_Value) 1991 is 1992 Name : constant Name_Id := Name_Of (Current, Node_Tree); 1993 Current_Location : constant Source_Ptr := 1994 Location_Of (Current, Node_Tree); 1995 1996 Index_Name : Name_Id := 1997 Associative_Array_Index_Of (Current, Node_Tree); 1998 1999 Source_Index : constant Int := 2000 Source_Index_Of (Current, Node_Tree); 2001 2002 The_Array : Array_Id; 2003 Elem : Array_Element_Id := No_Array_Element; 2004 2005 begin 2006 if Index_Name /= All_Other_Names then 2007 Index_Name := Get_Attribute_Index (Node_Tree, Current, Index_Name); 2008 end if; 2009 2010 -- Look for the array in the appropriate list 2011 2012 if Pkg /= No_Package then 2013 The_Array := Shared.Packages.Table (Pkg).Decl.Arrays; 2014 else 2015 The_Array := Project.Decl.Arrays; 2016 end if; 2017 2018 while The_Array /= No_Array 2019 and then Shared.Arrays.Table (The_Array).Name /= Name 2020 loop 2021 The_Array := Shared.Arrays.Table (The_Array).Next; 2022 end loop; 2023 2024 -- If the array cannot be found, create a new entry in the list. 2025 -- As The_Array_Element is initialized to No_Array_Element, a new 2026 -- element will be created automatically later 2027 2028 if The_Array = No_Array then 2029 Array_Table.Increment_Last (Shared.Arrays); 2030 The_Array := Array_Table.Last (Shared.Arrays); 2031 2032 if Pkg /= No_Package then 2033 Shared.Arrays.Table (The_Array) := 2034 (Name => Name, 2035 Location => Current_Location, 2036 Value => No_Array_Element, 2037 Next => Shared.Packages.Table (Pkg).Decl.Arrays); 2038 2039 Shared.Packages.Table (Pkg).Decl.Arrays := The_Array; 2040 2041 else 2042 Shared.Arrays.Table (The_Array) := 2043 (Name => Name, 2044 Location => Current_Location, 2045 Value => No_Array_Element, 2046 Next => Project.Decl.Arrays); 2047 2048 Project.Decl.Arrays := The_Array; 2049 end if; 2050 2051 else 2052 Elem := Shared.Arrays.Table (The_Array).Value; 2053 end if; 2054 2055 -- Look in the list, if any, to find an element with the same index 2056 -- and same source index. 2057 2058 while Elem /= No_Array_Element 2059 and then 2060 (Shared.Array_Elements.Table (Elem).Index /= Index_Name 2061 or else 2062 Shared.Array_Elements.Table (Elem).Src_Index /= Source_Index) 2063 loop 2064 Elem := Shared.Array_Elements.Table (Elem).Next; 2065 end loop; 2066 2067 -- If no such element were found, create a new one 2068 -- and insert it in the element list, with the 2069 -- proper value. 2070 2071 if Elem = No_Array_Element then 2072 Array_Element_Table.Increment_Last (Shared.Array_Elements); 2073 Elem := Array_Element_Table.Last (Shared.Array_Elements); 2074 2075 Shared.Array_Elements.Table 2076 (Elem) := 2077 (Index => Index_Name, 2078 Restricted => False, 2079 Src_Index => Source_Index, 2080 Index_Case_Sensitive => 2081 not Case_Insensitive (Current, Node_Tree), 2082 Value => New_Value, 2083 Next => Shared.Arrays.Table (The_Array).Value); 2084 2085 Shared.Arrays.Table (The_Array).Value := Elem; 2086 2087 else 2088 -- An element with the same index already exists, just replace its 2089 -- value with the new one. 2090 2091 Shared.Array_Elements.Table (Elem).Value := New_Value; 2092 end if; 2093 2094 if Name = Snames.Name_External then 2095 if In_Tree.Is_Root_Tree then 2096 Add (Child_Env.External, 2097 External_Name => Get_Name_String (Index_Name), 2098 Value => Get_Name_String (New_Value.Value), 2099 Source => From_External_Attribute); 2100 Add (Env.External, 2101 External_Name => Get_Name_String (Index_Name), 2102 Value => Get_Name_String (New_Value.Value), 2103 Source => From_External_Attribute, 2104 Silent => True); 2105 else 2106 if Current_Verbosity = High then 2107 Debug_Output 2108 ("'for External' has no effect except in root aggregate (" 2109 & Get_Name_String (Index_Name) & ")", New_Value.Value); 2110 end if; 2111 end if; 2112 end if; 2113 end Process_Expression_For_Associative_Array; 2114 2115 -------------------------------------- 2116 -- Process_Expression_Variable_Decl -- 2117 -------------------------------------- 2118 2119 procedure Process_Expression_Variable_Decl 2120 (Current_Item : Project_Node_Id; 2121 New_Value : Variable_Value) 2122 is 2123 Name : constant Name_Id := Name_Of (Current_Item, Node_Tree); 2124 2125 Is_Attribute : constant Boolean := 2126 Kind_Of (Current_Item, Node_Tree) = 2127 N_Attribute_Declaration; 2128 2129 Var : Variable_Id := No_Variable; 2130 2131 begin 2132 -- First, find the list where to find the variable or attribute 2133 2134 if Is_Attribute then 2135 if Pkg /= No_Package then 2136 Var := Shared.Packages.Table (Pkg).Decl.Attributes; 2137 else 2138 Var := Project.Decl.Attributes; 2139 end if; 2140 2141 else 2142 if Pkg /= No_Package then 2143 Var := Shared.Packages.Table (Pkg).Decl.Variables; 2144 else 2145 Var := Project.Decl.Variables; 2146 end if; 2147 end if; 2148 2149 -- Loop through the list, to find if it has already been declared 2150 2151 while Var /= No_Variable 2152 and then Shared.Variable_Elements.Table (Var).Name /= Name 2153 loop 2154 Var := Shared.Variable_Elements.Table (Var).Next; 2155 end loop; 2156 2157 -- If it has not been declared, create a new entry in the list 2158 2159 if Var = No_Variable then 2160 2161 -- All single string attribute should already have been declared 2162 -- with a default empty string value. 2163 2164 pragma Assert 2165 (not Is_Attribute, 2166 "illegal attribute declaration for " & Get_Name_String (Name)); 2167 2168 Variable_Element_Table.Increment_Last (Shared.Variable_Elements); 2169 Var := Variable_Element_Table.Last (Shared.Variable_Elements); 2170 2171 -- Put the new variable in the appropriate list 2172 2173 if Pkg /= No_Package then 2174 Shared.Variable_Elements.Table (Var) := 2175 (Next => Shared.Packages.Table (Pkg).Decl.Variables, 2176 Name => Name, 2177 Value => New_Value); 2178 Shared.Packages.Table (Pkg).Decl.Variables := Var; 2179 2180 else 2181 Shared.Variable_Elements.Table (Var) := 2182 (Next => Project.Decl.Variables, 2183 Name => Name, 2184 Value => New_Value); 2185 Project.Decl.Variables := Var; 2186 end if; 2187 2188 -- If the variable/attribute has already been declared, just 2189 -- change the value. 2190 2191 else 2192 Shared.Variable_Elements.Table (Var).Value := New_Value; 2193 end if; 2194 2195 if Is_Attribute and then Name = Snames.Name_Project_Path then 2196 if In_Tree.Is_Root_Tree then 2197 declare 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