1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- P R J . T R E E -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2001-2014, Free Software Foundation, Inc. -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- 17-- for more details. You should have received a copy of the GNU General -- 18-- Public License distributed with GNAT; see file COPYING3. If not, go to -- 19-- http://www.gnu.org/licenses for a complete copy of the license. -- 20-- -- 21-- GNAT was originally developed by the GNAT team at New York University. -- 22-- Extensive contributions were provided by Ada Core Technologies Inc. -- 23-- -- 24------------------------------------------------------------------------------ 25 26with Osint; use Osint; 27with Prj.Env; use Prj.Env; 28with Prj.Err; 29 30with Ada.Unchecked_Deallocation; 31 32package body Prj.Tree is 33 34 Node_With_Comments : constant array (Project_Node_Kind) of Boolean := 35 (N_Project => True, 36 N_With_Clause => True, 37 N_Project_Declaration => False, 38 N_Declarative_Item => False, 39 N_Package_Declaration => True, 40 N_String_Type_Declaration => True, 41 N_Literal_String => False, 42 N_Attribute_Declaration => True, 43 N_Typed_Variable_Declaration => True, 44 N_Variable_Declaration => True, 45 N_Expression => False, 46 N_Term => False, 47 N_Literal_String_List => False, 48 N_Variable_Reference => False, 49 N_External_Value => False, 50 N_Attribute_Reference => False, 51 N_Case_Construction => True, 52 N_Case_Item => True, 53 N_Comment_Zones => True, 54 N_Comment => True); 55 -- Indicates the kinds of node that may have associated comments 56 57 package Next_End_Nodes is new Table.Table 58 (Table_Component_Type => Project_Node_Id, 59 Table_Index_Type => Natural, 60 Table_Low_Bound => 1, 61 Table_Initial => 10, 62 Table_Increment => 100, 63 Table_Name => "Next_End_Nodes"); 64 -- A stack of nodes to indicates to what node the next "end" is associated 65 66 use Tree_Private_Part; 67 68 End_Of_Line_Node : Project_Node_Id := Empty_Node; 69 -- The node an end of line comment may be associated with 70 71 Previous_Line_Node : Project_Node_Id := Empty_Node; 72 -- The node an immediately following comment may be associated with 73 74 Previous_End_Node : Project_Node_Id := Empty_Node; 75 -- The node comments immediately following an "end" line may be 76 -- associated with. 77 78 Unkept_Comments : Boolean := False; 79 -- Set to True when some comments may not be associated with any node 80 81 function Comment_Zones_Of 82 (Node : Project_Node_Id; 83 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; 84 -- Returns the ID of the N_Comment_Zones node associated with node Node. 85 -- If there is not already an N_Comment_Zones node, create one and 86 -- associate it with node Node. 87 88 ------------------ 89 -- Add_Comments -- 90 ------------------ 91 92 procedure Add_Comments 93 (To : Project_Node_Id; 94 In_Tree : Project_Node_Tree_Ref; 95 Where : Comment_Location) is 96 Zone : Project_Node_Id := Empty_Node; 97 Previous : Project_Node_Id := Empty_Node; 98 99 begin 100 pragma Assert 101 (Present (To) 102 and then In_Tree.Project_Nodes.Table (To).Kind /= N_Comment); 103 104 Zone := In_Tree.Project_Nodes.Table (To).Comments; 105 106 if No (Zone) then 107 108 -- Create new N_Comment_Zones node 109 110 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes); 111 In_Tree.Project_Nodes.Table 112 (Project_Node_Table.Last (In_Tree.Project_Nodes)) := 113 (Kind => N_Comment_Zones, 114 Qualifier => Unspecified, 115 Expr_Kind => Undefined, 116 Location => No_Location, 117 Directory => No_Path, 118 Variables => Empty_Node, 119 Packages => Empty_Node, 120 Pkg_Id => Empty_Package, 121 Name => No_Name, 122 Display_Name => No_Name, 123 Src_Index => 0, 124 Path_Name => No_Path, 125 Value => No_Name, 126 Default => Empty_Value, 127 Field1 => Empty_Node, 128 Field2 => Empty_Node, 129 Field3 => Empty_Node, 130 Field4 => Empty_Node, 131 Flag1 => False, 132 Flag2 => False, 133 Comments => Empty_Node); 134 135 Zone := Project_Node_Table.Last (In_Tree.Project_Nodes); 136 In_Tree.Project_Nodes.Table (To).Comments := Zone; 137 end if; 138 139 if Where = End_Of_Line then 140 In_Tree.Project_Nodes.Table (Zone).Value := Comments.Table (1).Value; 141 142 else 143 -- Get each comments in the Comments table and link them to node To 144 145 for J in 1 .. Comments.Last loop 146 147 -- Create new N_Comment node 148 149 if (Where = After or else Where = After_End) 150 and then Token /= Tok_EOF 151 and then Comments.Table (J).Follows_Empty_Line 152 then 153 Comments.Table (1 .. Comments.Last - J + 1) := 154 Comments.Table (J .. Comments.Last); 155 Comments.Set_Last (Comments.Last - J + 1); 156 return; 157 end if; 158 159 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes); 160 In_Tree.Project_Nodes.Table 161 (Project_Node_Table.Last (In_Tree.Project_Nodes)) := 162 (Kind => N_Comment, 163 Qualifier => Unspecified, 164 Expr_Kind => Undefined, 165 Flag1 => Comments.Table (J).Follows_Empty_Line, 166 Flag2 => 167 Comments.Table (J).Is_Followed_By_Empty_Line, 168 Location => No_Location, 169 Directory => No_Path, 170 Variables => Empty_Node, 171 Packages => Empty_Node, 172 Pkg_Id => Empty_Package, 173 Name => No_Name, 174 Display_Name => No_Name, 175 Src_Index => 0, 176 Path_Name => No_Path, 177 Value => Comments.Table (J).Value, 178 Default => Empty_Value, 179 Field1 => Empty_Node, 180 Field2 => Empty_Node, 181 Field3 => Empty_Node, 182 Field4 => Empty_Node, 183 Comments => Empty_Node); 184 185 -- If this is the first comment, put it in the right field of 186 -- the node Zone. 187 188 if No (Previous) then 189 case Where is 190 when Before => 191 In_Tree.Project_Nodes.Table (Zone).Field1 := 192 Project_Node_Table.Last (In_Tree.Project_Nodes); 193 194 when After => 195 In_Tree.Project_Nodes.Table (Zone).Field2 := 196 Project_Node_Table.Last (In_Tree.Project_Nodes); 197 198 when Before_End => 199 In_Tree.Project_Nodes.Table (Zone).Field3 := 200 Project_Node_Table.Last (In_Tree.Project_Nodes); 201 202 when After_End => 203 In_Tree.Project_Nodes.Table (Zone).Comments := 204 Project_Node_Table.Last (In_Tree.Project_Nodes); 205 206 when End_Of_Line => 207 null; 208 end case; 209 210 else 211 -- When it is not the first, link it to the previous one 212 213 In_Tree.Project_Nodes.Table (Previous).Comments := 214 Project_Node_Table.Last (In_Tree.Project_Nodes); 215 end if; 216 217 -- This node becomes the previous one for the next comment, if 218 -- there is one. 219 220 Previous := Project_Node_Table.Last (In_Tree.Project_Nodes); 221 end loop; 222 end if; 223 224 -- Empty the Comments table, so that there is no risk to link the same 225 -- comments to another node. 226 227 Comments.Set_Last (0); 228 end Add_Comments; 229 230 -------------------------------- 231 -- Associative_Array_Index_Of -- 232 -------------------------------- 233 234 function Associative_Array_Index_Of 235 (Node : Project_Node_Id; 236 In_Tree : Project_Node_Tree_Ref) return Name_Id 237 is 238 begin 239 pragma Assert 240 (Present (Node) 241 and then 242 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration 243 or else 244 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); 245 return In_Tree.Project_Nodes.Table (Node).Value; 246 end Associative_Array_Index_Of; 247 248 ---------------------------- 249 -- Associative_Package_Of -- 250 ---------------------------- 251 252 function Associative_Package_Of 253 (Node : Project_Node_Id; 254 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 255 is 256 begin 257 pragma Assert 258 (Present (Node) 259 and then 260 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration)); 261 return In_Tree.Project_Nodes.Table (Node).Field3; 262 end Associative_Package_Of; 263 264 ---------------------------- 265 -- Associative_Project_Of -- 266 ---------------------------- 267 268 function Associative_Project_Of 269 (Node : Project_Node_Id; 270 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 271 is 272 begin 273 pragma Assert 274 (Present (Node) 275 and then 276 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration)); 277 return In_Tree.Project_Nodes.Table (Node).Field2; 278 end Associative_Project_Of; 279 280 ---------------------- 281 -- Case_Insensitive -- 282 ---------------------- 283 284 function Case_Insensitive 285 (Node : Project_Node_Id; 286 In_Tree : Project_Node_Tree_Ref) return Boolean 287 is 288 begin 289 pragma Assert 290 (Present (Node) 291 and then 292 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration 293 or else 294 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); 295 return In_Tree.Project_Nodes.Table (Node).Flag1; 296 end Case_Insensitive; 297 298 -------------------------------- 299 -- Case_Variable_Reference_Of -- 300 -------------------------------- 301 302 function Case_Variable_Reference_Of 303 (Node : Project_Node_Id; 304 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 305 is 306 begin 307 pragma Assert 308 (Present (Node) 309 and then 310 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction); 311 return In_Tree.Project_Nodes.Table (Node).Field1; 312 end Case_Variable_Reference_Of; 313 314 ---------------------- 315 -- Comment_Zones_Of -- 316 ---------------------- 317 318 function Comment_Zones_Of 319 (Node : Project_Node_Id; 320 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 321 is 322 Zone : Project_Node_Id; 323 324 begin 325 pragma Assert (Present (Node)); 326 Zone := In_Tree.Project_Nodes.Table (Node).Comments; 327 328 -- If there is not already an N_Comment_Zones associated, create a new 329 -- one and associate it with node Node. 330 331 if No (Zone) then 332 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes); 333 Zone := Project_Node_Table.Last (In_Tree.Project_Nodes); 334 In_Tree.Project_Nodes.Table (Zone) := 335 (Kind => N_Comment_Zones, 336 Qualifier => Unspecified, 337 Location => No_Location, 338 Directory => No_Path, 339 Expr_Kind => Undefined, 340 Variables => Empty_Node, 341 Packages => Empty_Node, 342 Pkg_Id => Empty_Package, 343 Name => No_Name, 344 Display_Name => No_Name, 345 Src_Index => 0, 346 Path_Name => No_Path, 347 Value => No_Name, 348 Default => Empty_Value, 349 Field1 => Empty_Node, 350 Field2 => Empty_Node, 351 Field3 => Empty_Node, 352 Field4 => Empty_Node, 353 Flag1 => False, 354 Flag2 => False, 355 Comments => Empty_Node); 356 In_Tree.Project_Nodes.Table (Node).Comments := Zone; 357 end if; 358 359 return Zone; 360 end Comment_Zones_Of; 361 362 ----------------------- 363 -- Current_Item_Node -- 364 ----------------------- 365 366 function Current_Item_Node 367 (Node : Project_Node_Id; 368 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 369 is 370 begin 371 pragma Assert 372 (Present (Node) 373 and then 374 In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item); 375 return In_Tree.Project_Nodes.Table (Node).Field1; 376 end Current_Item_Node; 377 378 ------------------ 379 -- Current_Term -- 380 ------------------ 381 382 function Current_Term 383 (Node : Project_Node_Id; 384 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 385 is 386 begin 387 pragma Assert 388 (Present (Node) 389 and then 390 In_Tree.Project_Nodes.Table (Node).Kind = N_Term); 391 return In_Tree.Project_Nodes.Table (Node).Field1; 392 end Current_Term; 393 394 ---------------- 395 -- Default_Of -- 396 ---------------- 397 398 function Default_Of 399 (Node : Project_Node_Id; 400 In_Tree : Project_Node_Tree_Ref) return Attribute_Default_Value 401 is 402 begin 403 pragma Assert 404 (Present (Node) 405 and then 406 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference); 407 return In_Tree.Project_Nodes.Table (Node).Default; 408 end Default_Of; 409 410 -------------------------- 411 -- Default_Project_Node -- 412 -------------------------- 413 414 function Default_Project_Node 415 (In_Tree : Project_Node_Tree_Ref; 416 Of_Kind : Project_Node_Kind; 417 And_Expr_Kind : Variable_Kind := Undefined) return Project_Node_Id 418 is 419 Result : Project_Node_Id; 420 Zone : Project_Node_Id; 421 Previous : Project_Node_Id; 422 423 begin 424 -- Create new node with specified kind and expression kind 425 426 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes); 427 In_Tree.Project_Nodes.Table 428 (Project_Node_Table.Last (In_Tree.Project_Nodes)) := 429 (Kind => Of_Kind, 430 Qualifier => Unspecified, 431 Location => No_Location, 432 Directory => No_Path, 433 Expr_Kind => And_Expr_Kind, 434 Variables => Empty_Node, 435 Packages => Empty_Node, 436 Pkg_Id => Empty_Package, 437 Name => No_Name, 438 Display_Name => No_Name, 439 Src_Index => 0, 440 Path_Name => No_Path, 441 Value => No_Name, 442 Default => Empty_Value, 443 Field1 => Empty_Node, 444 Field2 => Empty_Node, 445 Field3 => Empty_Node, 446 Field4 => Empty_Node, 447 Flag1 => False, 448 Flag2 => False, 449 Comments => Empty_Node); 450 451 -- Save the new node for the returned value 452 453 Result := Project_Node_Table.Last (In_Tree.Project_Nodes); 454 455 if Comments.Last > 0 then 456 457 -- If this is not a node with comments, then set the flag 458 459 if not Node_With_Comments (Of_Kind) then 460 Unkept_Comments := True; 461 462 elsif Of_Kind /= N_Comment and then Of_Kind /= N_Comment_Zones then 463 464 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes); 465 In_Tree.Project_Nodes.Table 466 (Project_Node_Table.Last (In_Tree.Project_Nodes)) := 467 (Kind => N_Comment_Zones, 468 Qualifier => Unspecified, 469 Expr_Kind => Undefined, 470 Location => No_Location, 471 Directory => No_Path, 472 Variables => Empty_Node, 473 Packages => Empty_Node, 474 Pkg_Id => Empty_Package, 475 Name => No_Name, 476 Display_Name => No_Name, 477 Src_Index => 0, 478 Path_Name => No_Path, 479 Value => No_Name, 480 Default => Empty_Value, 481 Field1 => Empty_Node, 482 Field2 => Empty_Node, 483 Field3 => Empty_Node, 484 Field4 => Empty_Node, 485 Flag1 => False, 486 Flag2 => False, 487 Comments => Empty_Node); 488 489 Zone := Project_Node_Table.Last (In_Tree.Project_Nodes); 490 In_Tree.Project_Nodes.Table (Result).Comments := Zone; 491 Previous := Empty_Node; 492 493 for J in 1 .. Comments.Last loop 494 495 -- Create a new N_Comment node 496 497 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes); 498 In_Tree.Project_Nodes.Table 499 (Project_Node_Table.Last (In_Tree.Project_Nodes)) := 500 (Kind => N_Comment, 501 Qualifier => Unspecified, 502 Expr_Kind => Undefined, 503 Flag1 => Comments.Table (J).Follows_Empty_Line, 504 Flag2 => 505 Comments.Table (J).Is_Followed_By_Empty_Line, 506 Location => No_Location, 507 Directory => No_Path, 508 Variables => Empty_Node, 509 Packages => Empty_Node, 510 Pkg_Id => Empty_Package, 511 Name => No_Name, 512 Display_Name => No_Name, 513 Src_Index => 0, 514 Path_Name => No_Path, 515 Value => Comments.Table (J).Value, 516 Default => Empty_Value, 517 Field1 => Empty_Node, 518 Field2 => Empty_Node, 519 Field3 => Empty_Node, 520 Field4 => Empty_Node, 521 Comments => Empty_Node); 522 523 -- Link it to the N_Comment_Zones node, if it is the first, 524 -- otherwise to the previous one. 525 526 if No (Previous) then 527 In_Tree.Project_Nodes.Table (Zone).Field1 := 528 Project_Node_Table.Last (In_Tree.Project_Nodes); 529 530 else 531 In_Tree.Project_Nodes.Table (Previous).Comments := 532 Project_Node_Table.Last (In_Tree.Project_Nodes); 533 end if; 534 535 -- This new node will be the previous one for the next 536 -- N_Comment node, if there is one. 537 538 Previous := Project_Node_Table.Last (In_Tree.Project_Nodes); 539 end loop; 540 541 -- Empty the Comments table after all comments have been processed 542 543 Comments.Set_Last (0); 544 end if; 545 end if; 546 547 return Result; 548 end Default_Project_Node; 549 550 ------------------ 551 -- Directory_Of -- 552 ------------------ 553 554 function Directory_Of 555 (Node : Project_Node_Id; 556 In_Tree : Project_Node_Tree_Ref) return Path_Name_Type 557 is 558 begin 559 pragma Assert 560 (Present (Node) 561 and then 562 In_Tree.Project_Nodes.Table (Node).Kind = N_Project); 563 return In_Tree.Project_Nodes.Table (Node).Directory; 564 end Directory_Of; 565 566 ------------------------- 567 -- End_Of_Line_Comment -- 568 ------------------------- 569 570 function End_Of_Line_Comment 571 (Node : Project_Node_Id; 572 In_Tree : Project_Node_Tree_Ref) return Name_Id 573 is 574 Zone : Project_Node_Id := Empty_Node; 575 576 begin 577 pragma Assert (Present (Node)); 578 Zone := In_Tree.Project_Nodes.Table (Node).Comments; 579 580 if No (Zone) then 581 return No_Name; 582 else 583 return In_Tree.Project_Nodes.Table (Zone).Value; 584 end if; 585 end End_Of_Line_Comment; 586 587 ------------------------ 588 -- Expression_Kind_Of -- 589 ------------------------ 590 591 function Expression_Kind_Of 592 (Node : Project_Node_Id; 593 In_Tree : Project_Node_Tree_Ref) return Variable_Kind 594 is 595 begin 596 pragma Assert 597 (Present (Node) 598 and then -- should use Nkind_In here ??? why not??? 599 (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String 600 or else 601 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration 602 or else 603 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration 604 or else 605 In_Tree.Project_Nodes.Table (Node).Kind = 606 N_Typed_Variable_Declaration 607 or else 608 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration 609 or else 610 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression 611 or else 612 In_Tree.Project_Nodes.Table (Node).Kind = N_Term 613 or else 614 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference 615 or else 616 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference 617 or else 618 In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value)); 619 return In_Tree.Project_Nodes.Table (Node).Expr_Kind; 620 end Expression_Kind_Of; 621 622 ------------------- 623 -- Expression_Of -- 624 ------------------- 625 626 function Expression_Of 627 (Node : Project_Node_Id; 628 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 629 is 630 begin 631 pragma Assert 632 (Present (Node) 633 and then 634 (In_Tree.Project_Nodes.Table (Node).Kind = 635 N_Attribute_Declaration 636 or else 637 In_Tree.Project_Nodes.Table (Node).Kind = 638 N_Typed_Variable_Declaration 639 or else 640 In_Tree.Project_Nodes.Table (Node).Kind = 641 N_Variable_Declaration)); 642 643 return In_Tree.Project_Nodes.Table (Node).Field1; 644 end Expression_Of; 645 646 ------------------------- 647 -- Extended_Project_Of -- 648 ------------------------- 649 650 function Extended_Project_Of 651 (Node : Project_Node_Id; 652 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 653 is 654 begin 655 pragma Assert 656 (Present (Node) 657 and then 658 In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration); 659 return In_Tree.Project_Nodes.Table (Node).Field2; 660 end Extended_Project_Of; 661 662 ------------------------------ 663 -- Extended_Project_Path_Of -- 664 ------------------------------ 665 666 function Extended_Project_Path_Of 667 (Node : Project_Node_Id; 668 In_Tree : Project_Node_Tree_Ref) return Path_Name_Type 669 is 670 begin 671 pragma Assert 672 (Present (Node) 673 and then 674 In_Tree.Project_Nodes.Table (Node).Kind = N_Project); 675 return Path_Name_Type (In_Tree.Project_Nodes.Table (Node).Value); 676 end Extended_Project_Path_Of; 677 678 -------------------------- 679 -- Extending_Project_Of -- 680 -------------------------- 681 function Extending_Project_Of 682 (Node : Project_Node_Id; 683 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 684 is 685 begin 686 pragma Assert 687 (Present (Node) 688 and then 689 In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration); 690 return In_Tree.Project_Nodes.Table (Node).Field3; 691 end Extending_Project_Of; 692 693 --------------------------- 694 -- External_Reference_Of -- 695 --------------------------- 696 697 function External_Reference_Of 698 (Node : Project_Node_Id; 699 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 700 is 701 begin 702 pragma Assert 703 (Present (Node) 704 and then 705 In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value); 706 return In_Tree.Project_Nodes.Table (Node).Field1; 707 end External_Reference_Of; 708 709 ------------------------- 710 -- External_Default_Of -- 711 ------------------------- 712 713 function External_Default_Of 714 (Node : Project_Node_Id; 715 In_Tree : Project_Node_Tree_Ref) 716 return Project_Node_Id 717 is 718 begin 719 pragma Assert 720 (Present (Node) 721 and then 722 In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value); 723 return In_Tree.Project_Nodes.Table (Node).Field2; 724 end External_Default_Of; 725 726 ------------------------ 727 -- First_Case_Item_Of -- 728 ------------------------ 729 730 function First_Case_Item_Of 731 (Node : Project_Node_Id; 732 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 733 is 734 begin 735 pragma Assert 736 (Present (Node) 737 and then 738 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction); 739 return In_Tree.Project_Nodes.Table (Node).Field2; 740 end First_Case_Item_Of; 741 742 --------------------- 743 -- First_Choice_Of -- 744 --------------------- 745 746 function First_Choice_Of 747 (Node : Project_Node_Id; 748 In_Tree : Project_Node_Tree_Ref) 749 return Project_Node_Id 750 is 751 begin 752 pragma Assert 753 (Present (Node) 754 and then 755 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item); 756 return In_Tree.Project_Nodes.Table (Node).Field1; 757 end First_Choice_Of; 758 759 ------------------------- 760 -- First_Comment_After -- 761 ------------------------- 762 763 function First_Comment_After 764 (Node : Project_Node_Id; 765 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 766 is 767 Zone : Project_Node_Id := Empty_Node; 768 begin 769 pragma Assert (Present (Node)); 770 Zone := In_Tree.Project_Nodes.Table (Node).Comments; 771 772 if No (Zone) then 773 return Empty_Node; 774 775 else 776 return In_Tree.Project_Nodes.Table (Zone).Field2; 777 end if; 778 end First_Comment_After; 779 780 ----------------------------- 781 -- First_Comment_After_End -- 782 ----------------------------- 783 784 function First_Comment_After_End 785 (Node : Project_Node_Id; 786 In_Tree : Project_Node_Tree_Ref) 787 return Project_Node_Id 788 is 789 Zone : Project_Node_Id := Empty_Node; 790 791 begin 792 pragma Assert (Present (Node)); 793 Zone := In_Tree.Project_Nodes.Table (Node).Comments; 794 795 if No (Zone) then 796 return Empty_Node; 797 798 else 799 return In_Tree.Project_Nodes.Table (Zone).Comments; 800 end if; 801 end First_Comment_After_End; 802 803 -------------------------- 804 -- First_Comment_Before -- 805 -------------------------- 806 807 function First_Comment_Before 808 (Node : Project_Node_Id; 809 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 810 is 811 Zone : Project_Node_Id := Empty_Node; 812 813 begin 814 pragma Assert (Present (Node)); 815 Zone := In_Tree.Project_Nodes.Table (Node).Comments; 816 817 if No (Zone) then 818 return Empty_Node; 819 820 else 821 return In_Tree.Project_Nodes.Table (Zone).Field1; 822 end if; 823 end First_Comment_Before; 824 825 ------------------------------ 826 -- First_Comment_Before_End -- 827 ------------------------------ 828 829 function First_Comment_Before_End 830 (Node : Project_Node_Id; 831 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 832 is 833 Zone : Project_Node_Id := Empty_Node; 834 835 begin 836 pragma Assert (Present (Node)); 837 Zone := In_Tree.Project_Nodes.Table (Node).Comments; 838 839 if No (Zone) then 840 return Empty_Node; 841 842 else 843 return In_Tree.Project_Nodes.Table (Zone).Field3; 844 end if; 845 end First_Comment_Before_End; 846 847 ------------------------------- 848 -- First_Declarative_Item_Of -- 849 ------------------------------- 850 851 function First_Declarative_Item_Of 852 (Node : Project_Node_Id; 853 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 854 is 855 begin 856 pragma Assert 857 (Present (Node) 858 and then 859 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration 860 or else 861 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item 862 or else 863 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration)); 864 865 if In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration then 866 return In_Tree.Project_Nodes.Table (Node).Field1; 867 else 868 return In_Tree.Project_Nodes.Table (Node).Field2; 869 end if; 870 end First_Declarative_Item_Of; 871 872 ------------------------------ 873 -- First_Expression_In_List -- 874 ------------------------------ 875 876 function First_Expression_In_List 877 (Node : Project_Node_Id; 878 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 879 is 880 begin 881 pragma Assert 882 (Present (Node) 883 and then 884 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List); 885 return In_Tree.Project_Nodes.Table (Node).Field1; 886 end First_Expression_In_List; 887 888 -------------------------- 889 -- First_Literal_String -- 890 -------------------------- 891 892 function First_Literal_String 893 (Node : Project_Node_Id; 894 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 895 is 896 begin 897 pragma Assert 898 (Present (Node) 899 and then 900 In_Tree.Project_Nodes.Table (Node).Kind = 901 N_String_Type_Declaration); 902 return In_Tree.Project_Nodes.Table (Node).Field1; 903 end First_Literal_String; 904 905 ---------------------- 906 -- First_Package_Of -- 907 ---------------------- 908 909 function First_Package_Of 910 (Node : Project_Node_Id; 911 In_Tree : Project_Node_Tree_Ref) return Package_Declaration_Id 912 is 913 begin 914 pragma Assert 915 (Present (Node) 916 and then 917 In_Tree.Project_Nodes.Table (Node).Kind = N_Project); 918 return In_Tree.Project_Nodes.Table (Node).Packages; 919 end First_Package_Of; 920 921 -------------------------- 922 -- First_String_Type_Of -- 923 -------------------------- 924 925 function First_String_Type_Of 926 (Node : Project_Node_Id; 927 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 928 is 929 begin 930 pragma Assert 931 (Present (Node) 932 and then 933 In_Tree.Project_Nodes.Table (Node).Kind = N_Project); 934 return In_Tree.Project_Nodes.Table (Node).Field3; 935 end First_String_Type_Of; 936 937 ---------------- 938 -- First_Term -- 939 ---------------- 940 941 function First_Term 942 (Node : Project_Node_Id; 943 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 944 is 945 begin 946 pragma Assert 947 (Present (Node) 948 and then 949 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression); 950 return In_Tree.Project_Nodes.Table (Node).Field1; 951 end First_Term; 952 953 ----------------------- 954 -- First_Variable_Of -- 955 ----------------------- 956 957 function First_Variable_Of 958 (Node : Project_Node_Id; 959 In_Tree : Project_Node_Tree_Ref) return Variable_Node_Id 960 is 961 begin 962 pragma Assert 963 (Present (Node) 964 and then 965 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project 966 or else 967 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration)); 968 969 return In_Tree.Project_Nodes.Table (Node).Variables; 970 end First_Variable_Of; 971 972 -------------------------- 973 -- First_With_Clause_Of -- 974 -------------------------- 975 976 function First_With_Clause_Of 977 (Node : Project_Node_Id; 978 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 979 is 980 begin 981 pragma Assert 982 (Present (Node) 983 and then 984 In_Tree.Project_Nodes.Table (Node).Kind = N_Project); 985 return In_Tree.Project_Nodes.Table (Node).Field1; 986 end First_With_Clause_Of; 987 988 ------------------------ 989 -- Follows_Empty_Line -- 990 ------------------------ 991 992 function Follows_Empty_Line 993 (Node : Project_Node_Id; 994 In_Tree : Project_Node_Tree_Ref) return Boolean 995 is 996 begin 997 pragma Assert 998 (Present (Node) 999 and then 1000 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment); 1001 return In_Tree.Project_Nodes.Table (Node).Flag1; 1002 end Follows_Empty_Line; 1003 1004 ---------- 1005 -- Hash -- 1006 ---------- 1007 1008 function Hash (N : Project_Node_Id) return Header_Num is 1009 begin 1010 return Header_Num (N mod Project_Node_Id (Header_Num'Last)); 1011 end Hash; 1012 1013 ---------------- 1014 -- Initialize -- 1015 ---------------- 1016 1017 procedure Initialize (Tree : Project_Node_Tree_Ref) is 1018 begin 1019 Project_Node_Table.Init (Tree.Project_Nodes); 1020 Projects_Htable.Reset (Tree.Projects_HT); 1021 end Initialize; 1022 1023 -------------------- 1024 -- Override_Flags -- 1025 -------------------- 1026 1027 procedure Override_Flags 1028 (Self : in out Environment; 1029 Flags : Prj.Processing_Flags) 1030 is 1031 begin 1032 Self.Flags := Flags; 1033 end Override_Flags; 1034 1035 ---------------- 1036 -- Initialize -- 1037 ---------------- 1038 1039 procedure Initialize 1040 (Self : out Environment; 1041 Flags : Processing_Flags) 1042 is 1043 begin 1044 -- Do not reset the external references, in case we are reloading a 1045 -- project, since we want to preserve the current environment. But we 1046 -- still need to ensure that the external references are properly 1047 -- initialized. 1048 1049 Prj.Ext.Initialize (Self.External); 1050 1051 Self.Flags := Flags; 1052 end Initialize; 1053 1054 ------------------------- 1055 -- Initialize_And_Copy -- 1056 ------------------------- 1057 1058 procedure Initialize_And_Copy 1059 (Self : out Environment; 1060 Copy_From : Environment) 1061 is 1062 begin 1063 Self.Flags := Copy_From.Flags; 1064 Prj.Ext.Initialize (Self.External, Copy_From => Copy_From.External); 1065 Prj.Env.Copy (From => Copy_From.Project_Path, To => Self.Project_Path); 1066 end Initialize_And_Copy; 1067 1068 ---------- 1069 -- Free -- 1070 ---------- 1071 1072 procedure Free (Self : in out Environment) is 1073 begin 1074 Prj.Ext.Free (Self.External); 1075 Free (Self.Project_Path); 1076 end Free; 1077 1078 ---------- 1079 -- Free -- 1080 ---------- 1081 1082 procedure Free (Proj : in out Project_Node_Tree_Ref) is 1083 procedure Unchecked_Free is new Ada.Unchecked_Deallocation 1084 (Project_Node_Tree_Data, Project_Node_Tree_Ref); 1085 begin 1086 if Proj /= null then 1087 Project_Node_Table.Free (Proj.Project_Nodes); 1088 Projects_Htable.Reset (Proj.Projects_HT); 1089 Unchecked_Free (Proj); 1090 end if; 1091 end Free; 1092 1093 ------------------------------- 1094 -- Is_Followed_By_Empty_Line -- 1095 ------------------------------- 1096 1097 function Is_Followed_By_Empty_Line 1098 (Node : Project_Node_Id; 1099 In_Tree : Project_Node_Tree_Ref) return Boolean 1100 is 1101 begin 1102 pragma Assert 1103 (Present (Node) 1104 and then 1105 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment); 1106 return In_Tree.Project_Nodes.Table (Node).Flag2; 1107 end Is_Followed_By_Empty_Line; 1108 1109 ---------------------- 1110 -- Is_Extending_All -- 1111 ---------------------- 1112 1113 function Is_Extending_All 1114 (Node : Project_Node_Id; 1115 In_Tree : Project_Node_Tree_Ref) return Boolean 1116 is 1117 begin 1118 pragma Assert 1119 (Present (Node) 1120 and then 1121 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project 1122 or else 1123 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause)); 1124 return In_Tree.Project_Nodes.Table (Node).Flag2; 1125 end Is_Extending_All; 1126 1127 ------------------------- 1128 -- Is_Not_Last_In_List -- 1129 ------------------------- 1130 1131 function Is_Not_Last_In_List 1132 (Node : Project_Node_Id; 1133 In_Tree : Project_Node_Tree_Ref) return Boolean 1134 is 1135 begin 1136 pragma Assert 1137 (Present (Node) 1138 and then 1139 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause); 1140 return In_Tree.Project_Nodes.Table (Node).Flag1; 1141 end Is_Not_Last_In_List; 1142 1143 ------------------------------------- 1144 -- Imported_Or_Extended_Project_Of -- 1145 ------------------------------------- 1146 1147 function Imported_Or_Extended_Project_Of 1148 (Project : Project_Node_Id; 1149 In_Tree : Project_Node_Tree_Ref; 1150 With_Name : Name_Id) return Project_Node_Id 1151 is 1152 With_Clause : Project_Node_Id; 1153 Result : Project_Node_Id := Empty_Node; 1154 Decl : Project_Node_Id; 1155 1156 begin 1157 -- First check all the imported projects 1158 1159 With_Clause := First_With_Clause_Of (Project, In_Tree); 1160 while Present (With_Clause) loop 1161 1162 -- Only non limited imported project may be used as prefix of 1163 -- variables or attributes. 1164 1165 Result := Non_Limited_Project_Node_Of (With_Clause, In_Tree); 1166 while Present (Result) loop 1167 if Name_Of (Result, In_Tree) = With_Name then 1168 return Result; 1169 end if; 1170 1171 Decl := Project_Declaration_Of (Result, In_Tree); 1172 1173 -- Do not try to check for an extended project, if the project 1174 -- does not have yet a project declaration. 1175 1176 exit when Decl = Empty_Node; 1177 1178 Result := Extended_Project_Of (Decl, In_Tree); 1179 end loop; 1180 1181 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree); 1182 end loop; 1183 1184 -- If it is not an imported project, it might be an extended project 1185 1186 if No (With_Clause) then 1187 Result := Project; 1188 loop 1189 Result := 1190 Extended_Project_Of 1191 (Project_Declaration_Of (Result, In_Tree), In_Tree); 1192 1193 exit when No (Result) 1194 or else Name_Of (Result, In_Tree) = With_Name; 1195 end loop; 1196 end if; 1197 1198 return Result; 1199 end Imported_Or_Extended_Project_Of; 1200 1201 ------------- 1202 -- Kind_Of -- 1203 ------------- 1204 1205 function Kind_Of 1206 (Node : Project_Node_Id; 1207 In_Tree : Project_Node_Tree_Ref) return Project_Node_Kind 1208 is 1209 begin 1210 pragma Assert (Present (Node)); 1211 return In_Tree.Project_Nodes.Table (Node).Kind; 1212 end Kind_Of; 1213 1214 ----------------- 1215 -- Location_Of -- 1216 ----------------- 1217 1218 function Location_Of 1219 (Node : Project_Node_Id; 1220 In_Tree : Project_Node_Tree_Ref) return Source_Ptr 1221 is 1222 begin 1223 pragma Assert (Present (Node)); 1224 return In_Tree.Project_Nodes.Table (Node).Location; 1225 end Location_Of; 1226 1227 ------------- 1228 -- Name_Of -- 1229 ------------- 1230 1231 function Name_Of 1232 (Node : Project_Node_Id; 1233 In_Tree : Project_Node_Tree_Ref) return Name_Id 1234 is 1235 begin 1236 pragma Assert (Present (Node)); 1237 return In_Tree.Project_Nodes.Table (Node).Name; 1238 end Name_Of; 1239 1240 --------------------- 1241 -- Display_Name_Of -- 1242 --------------------- 1243 1244 function Display_Name_Of 1245 (Node : Project_Node_Id; 1246 In_Tree : Project_Node_Tree_Ref) return Name_Id 1247 is 1248 begin 1249 pragma Assert 1250 (Present (Node) 1251 and then 1252 In_Tree.Project_Nodes.Table (Node).Kind = N_Project); 1253 return In_Tree.Project_Nodes.Table (Node).Display_Name; 1254 end Display_Name_Of; 1255 1256 -------------------- 1257 -- Next_Case_Item -- 1258 -------------------- 1259 1260 function Next_Case_Item 1261 (Node : Project_Node_Id; 1262 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 1263 is 1264 begin 1265 pragma Assert 1266 (Present (Node) 1267 and then 1268 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item); 1269 return In_Tree.Project_Nodes.Table (Node).Field3; 1270 end Next_Case_Item; 1271 1272 ------------------ 1273 -- Next_Comment -- 1274 ------------------ 1275 1276 function Next_Comment 1277 (Node : Project_Node_Id; 1278 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 1279 is 1280 begin 1281 pragma Assert 1282 (Present (Node) 1283 and then 1284 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment); 1285 return In_Tree.Project_Nodes.Table (Node).Comments; 1286 end Next_Comment; 1287 1288 --------------------------- 1289 -- Next_Declarative_Item -- 1290 --------------------------- 1291 1292 function Next_Declarative_Item 1293 (Node : Project_Node_Id; 1294 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 1295 is 1296 begin 1297 pragma Assert 1298 (Present (Node) 1299 and then 1300 In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item); 1301 return In_Tree.Project_Nodes.Table (Node).Field2; 1302 end Next_Declarative_Item; 1303 1304 ----------------------------- 1305 -- Next_Expression_In_List -- 1306 ----------------------------- 1307 1308 function Next_Expression_In_List 1309 (Node : Project_Node_Id; 1310 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 1311 is 1312 begin 1313 pragma Assert 1314 (Present (Node) 1315 and then 1316 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression); 1317 return In_Tree.Project_Nodes.Table (Node).Field2; 1318 end Next_Expression_In_List; 1319 1320 ------------------------- 1321 -- Next_Literal_String -- 1322 ------------------------- 1323 1324 function Next_Literal_String 1325 (Node : Project_Node_Id; 1326 In_Tree : Project_Node_Tree_Ref) 1327 return Project_Node_Id 1328 is 1329 begin 1330 pragma Assert 1331 (Present (Node) 1332 and then 1333 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String); 1334 return In_Tree.Project_Nodes.Table (Node).Field1; 1335 end Next_Literal_String; 1336 1337 ----------------------------- 1338 -- Next_Package_In_Project -- 1339 ----------------------------- 1340 1341 function Next_Package_In_Project 1342 (Node : Project_Node_Id; 1343 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 1344 is 1345 begin 1346 pragma Assert 1347 (Present (Node) 1348 and then 1349 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration); 1350 return In_Tree.Project_Nodes.Table (Node).Field3; 1351 end Next_Package_In_Project; 1352 1353 ---------------------- 1354 -- Next_String_Type -- 1355 ---------------------- 1356 1357 function Next_String_Type 1358 (Node : Project_Node_Id; 1359 In_Tree : Project_Node_Tree_Ref) 1360 return Project_Node_Id 1361 is 1362 begin 1363 pragma Assert 1364 (Present (Node) 1365 and then 1366 In_Tree.Project_Nodes.Table (Node).Kind = 1367 N_String_Type_Declaration); 1368 return In_Tree.Project_Nodes.Table (Node).Field2; 1369 end Next_String_Type; 1370 1371 --------------- 1372 -- Next_Term -- 1373 --------------- 1374 1375 function Next_Term 1376 (Node : Project_Node_Id; 1377 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 1378 is 1379 begin 1380 pragma Assert 1381 (Present (Node) 1382 and then In_Tree.Project_Nodes.Table (Node).Kind = N_Term); 1383 return In_Tree.Project_Nodes.Table (Node).Field2; 1384 end Next_Term; 1385 1386 ------------------- 1387 -- Next_Variable -- 1388 ------------------- 1389 1390 function Next_Variable 1391 (Node : Project_Node_Id; 1392 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 1393 is 1394 begin 1395 pragma Assert 1396 (Present (Node) 1397 and then 1398 (In_Tree.Project_Nodes.Table (Node).Kind = 1399 N_Typed_Variable_Declaration 1400 or else 1401 In_Tree.Project_Nodes.Table (Node).Kind = 1402 N_Variable_Declaration)); 1403 1404 return In_Tree.Project_Nodes.Table (Node).Field3; 1405 end Next_Variable; 1406 1407 ------------------------- 1408 -- Next_With_Clause_Of -- 1409 ------------------------- 1410 1411 function Next_With_Clause_Of 1412 (Node : Project_Node_Id; 1413 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 1414 is 1415 begin 1416 pragma Assert 1417 (Present (Node) 1418 and then 1419 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause); 1420 return In_Tree.Project_Nodes.Table (Node).Field2; 1421 end Next_With_Clause_Of; 1422 1423 -------- 1424 -- No -- 1425 -------- 1426 1427 function No (Node : Project_Node_Id) return Boolean is 1428 begin 1429 return Node = Empty_Node; 1430 end No; 1431 1432 --------------------------------- 1433 -- Non_Limited_Project_Node_Of -- 1434 --------------------------------- 1435 1436 function Non_Limited_Project_Node_Of 1437 (Node : Project_Node_Id; 1438 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 1439 is 1440 begin 1441 pragma Assert 1442 (Present (Node) 1443 and then 1444 (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause)); 1445 return In_Tree.Project_Nodes.Table (Node).Field3; 1446 end Non_Limited_Project_Node_Of; 1447 1448 ------------------- 1449 -- Package_Id_Of -- 1450 ------------------- 1451 1452 function Package_Id_Of 1453 (Node : Project_Node_Id; 1454 In_Tree : Project_Node_Tree_Ref) return Package_Node_Id 1455 is 1456 begin 1457 pragma Assert 1458 (Present (Node) 1459 and then 1460 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration); 1461 return In_Tree.Project_Nodes.Table (Node).Pkg_Id; 1462 end Package_Id_Of; 1463 1464 --------------------- 1465 -- Package_Node_Of -- 1466 --------------------- 1467 1468 function Package_Node_Of 1469 (Node : Project_Node_Id; 1470 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 1471 is 1472 begin 1473 pragma Assert 1474 (Present (Node) 1475 and then 1476 (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference 1477 or else 1478 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); 1479 return In_Tree.Project_Nodes.Table (Node).Field2; 1480 end Package_Node_Of; 1481 1482 ------------------ 1483 -- Path_Name_Of -- 1484 ------------------ 1485 1486 function Path_Name_Of 1487 (Node : Project_Node_Id; 1488 In_Tree : Project_Node_Tree_Ref) return Path_Name_Type 1489 is 1490 begin 1491 pragma Assert 1492 (Present (Node) 1493 and then 1494 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project 1495 or else 1496 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause)); 1497 return In_Tree.Project_Nodes.Table (Node).Path_Name; 1498 end Path_Name_Of; 1499 1500 ------------- 1501 -- Present -- 1502 ------------- 1503 1504 function Present (Node : Project_Node_Id) return Boolean is 1505 begin 1506 return Node /= Empty_Node; 1507 end Present; 1508 1509 ---------------------------- 1510 -- Project_Declaration_Of -- 1511 ---------------------------- 1512 1513 function Project_Declaration_Of 1514 (Node : Project_Node_Id; 1515 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 1516 is 1517 begin 1518 pragma Assert 1519 (Present (Node) 1520 and then 1521 In_Tree.Project_Nodes.Table (Node).Kind = N_Project); 1522 return In_Tree.Project_Nodes.Table (Node).Field2; 1523 end Project_Declaration_Of; 1524 1525 -------------------------- 1526 -- Project_Qualifier_Of -- 1527 -------------------------- 1528 1529 function Project_Qualifier_Of 1530 (Node : Project_Node_Id; 1531 In_Tree : Project_Node_Tree_Ref) return Project_Qualifier 1532 is 1533 begin 1534 pragma Assert 1535 (Present (Node) 1536 and then 1537 In_Tree.Project_Nodes.Table (Node).Kind = N_Project); 1538 return In_Tree.Project_Nodes.Table (Node).Qualifier; 1539 end Project_Qualifier_Of; 1540 1541 ----------------------- 1542 -- Parent_Project_Of -- 1543 ----------------------- 1544 1545 function Parent_Project_Of 1546 (Node : Project_Node_Id; 1547 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 1548 is 1549 begin 1550 pragma Assert 1551 (Present (Node) 1552 and then 1553 In_Tree.Project_Nodes.Table (Node).Kind = N_Project); 1554 return In_Tree.Project_Nodes.Table (Node).Field4; 1555 end Parent_Project_Of; 1556 1557 ------------------------------------------- 1558 -- Project_File_Includes_Unkept_Comments -- 1559 ------------------------------------------- 1560 1561 function Project_File_Includes_Unkept_Comments 1562 (Node : Project_Node_Id; 1563 In_Tree : Project_Node_Tree_Ref) return Boolean 1564 is 1565 Declaration : constant Project_Node_Id := 1566 Project_Declaration_Of (Node, In_Tree); 1567 begin 1568 return In_Tree.Project_Nodes.Table (Declaration).Flag1; 1569 end Project_File_Includes_Unkept_Comments; 1570 1571 --------------------- 1572 -- Project_Node_Of -- 1573 --------------------- 1574 1575 function Project_Node_Of 1576 (Node : Project_Node_Id; 1577 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 1578 is 1579 begin 1580 pragma Assert 1581 (Present (Node) 1582 and then 1583 (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause 1584 or else 1585 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference 1586 or else 1587 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); 1588 return In_Tree.Project_Nodes.Table (Node).Field1; 1589 end Project_Node_Of; 1590 1591 ----------------------------------- 1592 -- Project_Of_Renamed_Package_Of -- 1593 ----------------------------------- 1594 1595 function Project_Of_Renamed_Package_Of 1596 (Node : Project_Node_Id; 1597 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 1598 is 1599 begin 1600 pragma Assert 1601 (Present (Node) 1602 and then 1603 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration); 1604 return In_Tree.Project_Nodes.Table (Node).Field1; 1605 end Project_Of_Renamed_Package_Of; 1606 1607 -------------------------- 1608 -- Remove_Next_End_Node -- 1609 -------------------------- 1610 1611 procedure Remove_Next_End_Node is 1612 begin 1613 Next_End_Nodes.Decrement_Last; 1614 end Remove_Next_End_Node; 1615 1616 ----------------- 1617 -- Reset_State -- 1618 ----------------- 1619 1620 procedure Reset_State is 1621 begin 1622 End_Of_Line_Node := Empty_Node; 1623 Previous_Line_Node := Empty_Node; 1624 Previous_End_Node := Empty_Node; 1625 Unkept_Comments := False; 1626 Comments.Set_Last (0); 1627 end Reset_State; 1628 1629 ---------------------- 1630 -- Restore_And_Free -- 1631 ---------------------- 1632 1633 procedure Restore_And_Free (S : in out Comment_State) is 1634 procedure Unchecked_Free is new 1635 Ada.Unchecked_Deallocation (Comment_Array, Comments_Ptr); 1636 1637 begin 1638 End_Of_Line_Node := S.End_Of_Line_Node; 1639 Previous_Line_Node := S.Previous_Line_Node; 1640 Previous_End_Node := S.Previous_End_Node; 1641 Next_End_Nodes.Set_Last (0); 1642 Unkept_Comments := S.Unkept_Comments; 1643 1644 Comments.Set_Last (0); 1645 1646 for J in S.Comments'Range loop 1647 Comments.Increment_Last; 1648 Comments.Table (Comments.Last) := S.Comments (J); 1649 end loop; 1650 1651 Unchecked_Free (S.Comments); 1652 end Restore_And_Free; 1653 1654 ---------- 1655 -- Save -- 1656 ---------- 1657 1658 procedure Save (S : out Comment_State) is 1659 Cmts : constant Comments_Ptr := new Comment_Array (1 .. Comments.Last); 1660 1661 begin 1662 for J in 1 .. Comments.Last loop 1663 Cmts (J) := Comments.Table (J); 1664 end loop; 1665 1666 S := 1667 (End_Of_Line_Node => End_Of_Line_Node, 1668 Previous_Line_Node => Previous_Line_Node, 1669 Previous_End_Node => Previous_End_Node, 1670 Unkept_Comments => Unkept_Comments, 1671 Comments => Cmts); 1672 end Save; 1673 1674 ---------- 1675 -- Scan -- 1676 ---------- 1677 1678 procedure Scan (In_Tree : Project_Node_Tree_Ref) is 1679 Empty_Line : Boolean := False; 1680 1681 begin 1682 -- If there are comments, then they will not be kept. Set the flag and 1683 -- clear the comments. 1684 1685 if Comments.Last > 0 then 1686 Unkept_Comments := True; 1687 Comments.Set_Last (0); 1688 end if; 1689 1690 -- Loop until a token other that End_Of_Line or Comment is found 1691 1692 loop 1693 Prj.Err.Scanner.Scan; 1694 1695 case Token is 1696 when Tok_End_Of_Line => 1697 if Prev_Token = Tok_End_Of_Line then 1698 Empty_Line := True; 1699 1700 if Comments.Last > 0 then 1701 Comments.Table (Comments.Last).Is_Followed_By_Empty_Line 1702 := True; 1703 end if; 1704 end if; 1705 1706 when Tok_Comment => 1707 -- If this is a line comment, add it to the comment table 1708 1709 if Prev_Token = Tok_End_Of_Line 1710 or else Prev_Token = No_Token 1711 then 1712 Comments.Increment_Last; 1713 Comments.Table (Comments.Last) := 1714 (Value => Comment_Id, 1715 Follows_Empty_Line => Empty_Line, 1716 Is_Followed_By_Empty_Line => False); 1717 1718 -- Otherwise, it is an end of line comment. If there is an 1719 -- end of line node specified, associate the comment with 1720 -- this node. 1721 1722 elsif Present (End_Of_Line_Node) then 1723 declare 1724 Zones : constant Project_Node_Id := 1725 Comment_Zones_Of (End_Of_Line_Node, In_Tree); 1726 begin 1727 In_Tree.Project_Nodes.Table (Zones).Value := Comment_Id; 1728 end; 1729 1730 -- Otherwise, this end of line node cannot be kept 1731 1732 else 1733 Unkept_Comments := True; 1734 Comments.Set_Last (0); 1735 end if; 1736 1737 Empty_Line := False; 1738 1739 when others => 1740 1741 -- If there are comments, where the first comment is not 1742 -- following an empty line, put the initial uninterrupted 1743 -- comment zone with the node of the preceding line (either 1744 -- a Previous_Line or a Previous_End node), if any. 1745 1746 if Comments.Last > 0 and then 1747 not Comments.Table (1).Follows_Empty_Line 1748 then 1749 if Present (Previous_Line_Node) then 1750 Add_Comments 1751 (To => Previous_Line_Node, 1752 Where => After, 1753 In_Tree => In_Tree); 1754 1755 elsif Present (Previous_End_Node) then 1756 Add_Comments 1757 (To => Previous_End_Node, 1758 Where => After_End, 1759 In_Tree => In_Tree); 1760 end if; 1761 end if; 1762 1763 -- If there are still comments and the token is "end", then 1764 -- put these comments with the Next_End node, if any; 1765 -- otherwise, these comments cannot be kept. Always clear 1766 -- the comments. 1767 1768 if Comments.Last > 0 and then Token = Tok_End then 1769 if Next_End_Nodes.Last > 0 then 1770 Add_Comments 1771 (To => Next_End_Nodes.Table (Next_End_Nodes.Last), 1772 Where => Before_End, 1773 In_Tree => In_Tree); 1774 1775 else 1776 Unkept_Comments := True; 1777 end if; 1778 1779 Comments.Set_Last (0); 1780 end if; 1781 1782 -- Reset the End_Of_Line, Previous_Line and Previous_End nodes 1783 -- so that they are not used again. 1784 1785 End_Of_Line_Node := Empty_Node; 1786 Previous_Line_Node := Empty_Node; 1787 Previous_End_Node := Empty_Node; 1788 1789 -- And return 1790 1791 exit; 1792 end case; 1793 end loop; 1794 end Scan; 1795 1796 ------------------------------------ 1797 -- Set_Associative_Array_Index_Of -- 1798 ------------------------------------ 1799 1800 procedure Set_Associative_Array_Index_Of 1801 (Node : Project_Node_Id; 1802 In_Tree : Project_Node_Tree_Ref; 1803 To : Name_Id) 1804 is 1805 begin 1806 pragma Assert 1807 (Present (Node) 1808 and then 1809 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration 1810 or else 1811 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); 1812 In_Tree.Project_Nodes.Table (Node).Value := To; 1813 end Set_Associative_Array_Index_Of; 1814 1815 -------------------------------- 1816 -- Set_Associative_Package_Of -- 1817 -------------------------------- 1818 1819 procedure Set_Associative_Package_Of 1820 (Node : Project_Node_Id; 1821 In_Tree : Project_Node_Tree_Ref; 1822 To : Project_Node_Id) 1823 is 1824 begin 1825 pragma Assert 1826 (Present (Node) 1827 and then 1828 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration); 1829 In_Tree.Project_Nodes.Table (Node).Field3 := To; 1830 end Set_Associative_Package_Of; 1831 1832 -------------------------------- 1833 -- Set_Associative_Project_Of -- 1834 -------------------------------- 1835 1836 procedure Set_Associative_Project_Of 1837 (Node : Project_Node_Id; 1838 In_Tree : Project_Node_Tree_Ref; 1839 To : Project_Node_Id) 1840 is 1841 begin 1842 pragma Assert 1843 (Present (Node) 1844 and then 1845 (In_Tree.Project_Nodes.Table (Node).Kind = 1846 N_Attribute_Declaration)); 1847 In_Tree.Project_Nodes.Table (Node).Field2 := To; 1848 end Set_Associative_Project_Of; 1849 1850 -------------------------- 1851 -- Set_Case_Insensitive -- 1852 -------------------------- 1853 1854 procedure Set_Case_Insensitive 1855 (Node : Project_Node_Id; 1856 In_Tree : Project_Node_Tree_Ref; 1857 To : Boolean) 1858 is 1859 begin 1860 pragma Assert 1861 (Present (Node) 1862 and then 1863 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration 1864 or else 1865 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); 1866 In_Tree.Project_Nodes.Table (Node).Flag1 := To; 1867 end Set_Case_Insensitive; 1868 1869 ------------------------------------ 1870 -- Set_Case_Variable_Reference_Of -- 1871 ------------------------------------ 1872 1873 procedure Set_Case_Variable_Reference_Of 1874 (Node : Project_Node_Id; 1875 In_Tree : Project_Node_Tree_Ref; 1876 To : Project_Node_Id) 1877 is 1878 begin 1879 pragma Assert 1880 (Present (Node) 1881 and then 1882 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction); 1883 In_Tree.Project_Nodes.Table (Node).Field1 := To; 1884 end Set_Case_Variable_Reference_Of; 1885 1886 --------------------------- 1887 -- Set_Current_Item_Node -- 1888 --------------------------- 1889 1890 procedure Set_Current_Item_Node 1891 (Node : Project_Node_Id; 1892 In_Tree : Project_Node_Tree_Ref; 1893 To : Project_Node_Id) 1894 is 1895 begin 1896 pragma Assert 1897 (Present (Node) 1898 and then 1899 In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item); 1900 In_Tree.Project_Nodes.Table (Node).Field1 := To; 1901 end Set_Current_Item_Node; 1902 1903 ---------------------- 1904 -- Set_Current_Term -- 1905 ---------------------- 1906 1907 procedure Set_Current_Term 1908 (Node : Project_Node_Id; 1909 In_Tree : Project_Node_Tree_Ref; 1910 To : Project_Node_Id) 1911 is 1912 begin 1913 pragma Assert 1914 (Present (Node) 1915 and then 1916 In_Tree.Project_Nodes.Table (Node).Kind = N_Term); 1917 In_Tree.Project_Nodes.Table (Node).Field1 := To; 1918 end Set_Current_Term; 1919 1920 -------------------- 1921 -- Set_Default_Of -- 1922 -------------------- 1923 1924 procedure Set_Default_Of 1925 (Node : Project_Node_Id; 1926 In_Tree : Project_Node_Tree_Ref; 1927 To : Attribute_Default_Value) 1928 is 1929 begin 1930 pragma Assert 1931 (Present (Node) 1932 and then 1933 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference); 1934 In_Tree.Project_Nodes.Table (Node).Default := To; 1935 end Set_Default_Of; 1936 1937 ---------------------- 1938 -- Set_Directory_Of -- 1939 ---------------------- 1940 1941 procedure Set_Directory_Of 1942 (Node : Project_Node_Id; 1943 In_Tree : Project_Node_Tree_Ref; 1944 To : Path_Name_Type) 1945 is 1946 begin 1947 pragma Assert 1948 (Present (Node) 1949 and then 1950 In_Tree.Project_Nodes.Table (Node).Kind = N_Project); 1951 In_Tree.Project_Nodes.Table (Node).Directory := To; 1952 end Set_Directory_Of; 1953 1954 --------------------- 1955 -- Set_End_Of_Line -- 1956 --------------------- 1957 1958 procedure Set_End_Of_Line (To : Project_Node_Id) is 1959 begin 1960 End_Of_Line_Node := To; 1961 end Set_End_Of_Line; 1962 1963 ---------------------------- 1964 -- Set_Expression_Kind_Of -- 1965 ---------------------------- 1966 1967 procedure Set_Expression_Kind_Of 1968 (Node : Project_Node_Id; 1969 In_Tree : Project_Node_Tree_Ref; 1970 To : Variable_Kind) 1971 is 1972 begin 1973 pragma Assert 1974 (Present (Node) 1975 and then -- should use Nkind_In here ??? why not??? 1976 (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String 1977 or else 1978 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration 1979 or else 1980 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration 1981 or else 1982 In_Tree.Project_Nodes.Table (Node).Kind = 1983 N_Typed_Variable_Declaration 1984 or else 1985 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration 1986 or else 1987 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression 1988 or else 1989 In_Tree.Project_Nodes.Table (Node).Kind = N_Term 1990 or else 1991 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference 1992 or else 1993 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference 1994 or else 1995 In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value)); 1996 In_Tree.Project_Nodes.Table (Node).Expr_Kind := To; 1997 end Set_Expression_Kind_Of; 1998 1999 ----------------------- 2000 -- Set_Expression_Of -- 2001 ----------------------- 2002 2003 procedure Set_Expression_Of 2004 (Node : Project_Node_Id; 2005 In_Tree : Project_Node_Tree_Ref; 2006 To : Project_Node_Id) 2007 is 2008 begin 2009 pragma Assert 2010 (Present (Node) 2011 and then 2012 (In_Tree.Project_Nodes.Table (Node).Kind = 2013 N_Attribute_Declaration 2014 or else 2015 In_Tree.Project_Nodes.Table (Node).Kind = 2016 N_Typed_Variable_Declaration 2017 or else 2018 In_Tree.Project_Nodes.Table (Node).Kind = 2019 N_Variable_Declaration)); 2020 In_Tree.Project_Nodes.Table (Node).Field1 := To; 2021 end Set_Expression_Of; 2022 2023 ------------------------------- 2024 -- Set_External_Reference_Of -- 2025 ------------------------------- 2026 2027 procedure Set_External_Reference_Of 2028 (Node : Project_Node_Id; 2029 In_Tree : Project_Node_Tree_Ref; 2030 To : Project_Node_Id) 2031 is 2032 begin 2033 pragma Assert 2034 (Present (Node) 2035 and then 2036 In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value); 2037 In_Tree.Project_Nodes.Table (Node).Field1 := To; 2038 end Set_External_Reference_Of; 2039 2040 ----------------------------- 2041 -- Set_External_Default_Of -- 2042 ----------------------------- 2043 2044 procedure Set_External_Default_Of 2045 (Node : Project_Node_Id; 2046 In_Tree : Project_Node_Tree_Ref; 2047 To : Project_Node_Id) 2048 is 2049 begin 2050 pragma Assert 2051 (Present (Node) 2052 and then 2053 In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value); 2054 In_Tree.Project_Nodes.Table (Node).Field2 := To; 2055 end Set_External_Default_Of; 2056 2057 ---------------------------- 2058 -- Set_First_Case_Item_Of -- 2059 ---------------------------- 2060 2061 procedure Set_First_Case_Item_Of 2062 (Node : Project_Node_Id; 2063 In_Tree : Project_Node_Tree_Ref; 2064 To : Project_Node_Id) 2065 is 2066 begin 2067 pragma Assert 2068 (Present (Node) 2069 and then 2070 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction); 2071 In_Tree.Project_Nodes.Table (Node).Field2 := To; 2072 end Set_First_Case_Item_Of; 2073 2074 ------------------------- 2075 -- Set_First_Choice_Of -- 2076 ------------------------- 2077 2078 procedure Set_First_Choice_Of 2079 (Node : Project_Node_Id; 2080 In_Tree : Project_Node_Tree_Ref; 2081 To : Project_Node_Id) 2082 is 2083 begin 2084 pragma Assert 2085 (Present (Node) 2086 and then 2087 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item); 2088 In_Tree.Project_Nodes.Table (Node).Field1 := To; 2089 end Set_First_Choice_Of; 2090 2091 ----------------------------- 2092 -- Set_First_Comment_After -- 2093 ----------------------------- 2094 2095 procedure Set_First_Comment_After 2096 (Node : Project_Node_Id; 2097 In_Tree : Project_Node_Tree_Ref; 2098 To : Project_Node_Id) 2099 is 2100 Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree); 2101 begin 2102 In_Tree.Project_Nodes.Table (Zone).Field2 := To; 2103 end Set_First_Comment_After; 2104 2105 --------------------------------- 2106 -- Set_First_Comment_After_End -- 2107 --------------------------------- 2108 2109 procedure Set_First_Comment_After_End 2110 (Node : Project_Node_Id; 2111 In_Tree : Project_Node_Tree_Ref; 2112 To : Project_Node_Id) 2113 is 2114 Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree); 2115 begin 2116 In_Tree.Project_Nodes.Table (Zone).Comments := To; 2117 end Set_First_Comment_After_End; 2118 2119 ------------------------------ 2120 -- Set_First_Comment_Before -- 2121 ------------------------------ 2122 2123 procedure Set_First_Comment_Before 2124 (Node : Project_Node_Id; 2125 In_Tree : Project_Node_Tree_Ref; 2126 To : Project_Node_Id) 2127 is 2128 Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree); 2129 begin 2130 In_Tree.Project_Nodes.Table (Zone).Field1 := To; 2131 end Set_First_Comment_Before; 2132 2133 ---------------------------------- 2134 -- Set_First_Comment_Before_End -- 2135 ---------------------------------- 2136 2137 procedure Set_First_Comment_Before_End 2138 (Node : Project_Node_Id; 2139 In_Tree : Project_Node_Tree_Ref; 2140 To : Project_Node_Id) 2141 is 2142 Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree); 2143 begin 2144 In_Tree.Project_Nodes.Table (Zone).Field2 := To; 2145 end Set_First_Comment_Before_End; 2146 2147 ------------------------ 2148 -- Set_Next_Case_Item -- 2149 ------------------------ 2150 2151 procedure Set_Next_Case_Item 2152 (Node : Project_Node_Id; 2153 In_Tree : Project_Node_Tree_Ref; 2154 To : Project_Node_Id) 2155 is 2156 begin 2157 pragma Assert 2158 (Present (Node) 2159 and then 2160 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item); 2161 In_Tree.Project_Nodes.Table (Node).Field3 := To; 2162 end Set_Next_Case_Item; 2163 2164 ---------------------- 2165 -- Set_Next_Comment -- 2166 ---------------------- 2167 2168 procedure Set_Next_Comment 2169 (Node : Project_Node_Id; 2170 In_Tree : Project_Node_Tree_Ref; 2171 To : Project_Node_Id) 2172 is 2173 begin 2174 pragma Assert 2175 (Present (Node) 2176 and then 2177 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment); 2178 In_Tree.Project_Nodes.Table (Node).Comments := To; 2179 end Set_Next_Comment; 2180 2181 ----------------------------------- 2182 -- Set_First_Declarative_Item_Of -- 2183 ----------------------------------- 2184 2185 procedure Set_First_Declarative_Item_Of 2186 (Node : Project_Node_Id; 2187 In_Tree : Project_Node_Tree_Ref; 2188 To : Project_Node_Id) 2189 is 2190 begin 2191 pragma Assert 2192 (Present (Node) 2193 and then 2194 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration 2195 or else 2196 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item 2197 or else 2198 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration)); 2199 2200 if In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration then 2201 In_Tree.Project_Nodes.Table (Node).Field1 := To; 2202 else 2203 In_Tree.Project_Nodes.Table (Node).Field2 := To; 2204 end if; 2205 end Set_First_Declarative_Item_Of; 2206 2207 ---------------------------------- 2208 -- Set_First_Expression_In_List -- 2209 ---------------------------------- 2210 2211 procedure Set_First_Expression_In_List 2212 (Node : Project_Node_Id; 2213 In_Tree : Project_Node_Tree_Ref; 2214 To : Project_Node_Id) 2215 is 2216 begin 2217 pragma Assert 2218 (Present (Node) 2219 and then 2220 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List); 2221 In_Tree.Project_Nodes.Table (Node).Field1 := To; 2222 end Set_First_Expression_In_List; 2223 2224 ------------------------------ 2225 -- Set_First_Literal_String -- 2226 ------------------------------ 2227 2228 procedure Set_First_Literal_String 2229 (Node : Project_Node_Id; 2230 In_Tree : Project_Node_Tree_Ref; 2231 To : Project_Node_Id) 2232 is 2233 begin 2234 pragma Assert 2235 (Present (Node) 2236 and then 2237 In_Tree.Project_Nodes.Table (Node).Kind = 2238 N_String_Type_Declaration); 2239 In_Tree.Project_Nodes.Table (Node).Field1 := To; 2240 end Set_First_Literal_String; 2241 2242 -------------------------- 2243 -- Set_First_Package_Of -- 2244 -------------------------- 2245 2246 procedure Set_First_Package_Of 2247 (Node : Project_Node_Id; 2248 In_Tree : Project_Node_Tree_Ref; 2249 To : Package_Declaration_Id) 2250 is 2251 begin 2252 pragma Assert 2253 (Present (Node) 2254 and then 2255 In_Tree.Project_Nodes.Table (Node).Kind = N_Project); 2256 In_Tree.Project_Nodes.Table (Node).Packages := To; 2257 end Set_First_Package_Of; 2258 2259 ------------------------------ 2260 -- Set_First_String_Type_Of -- 2261 ------------------------------ 2262 2263 procedure Set_First_String_Type_Of 2264 (Node : Project_Node_Id; 2265 In_Tree : Project_Node_Tree_Ref; 2266 To : Project_Node_Id) 2267 is 2268 begin 2269 pragma Assert 2270 (Present (Node) 2271 and then 2272 In_Tree.Project_Nodes.Table (Node).Kind = N_Project); 2273 In_Tree.Project_Nodes.Table (Node).Field3 := To; 2274 end Set_First_String_Type_Of; 2275 2276 -------------------- 2277 -- Set_First_Term -- 2278 -------------------- 2279 2280 procedure Set_First_Term 2281 (Node : Project_Node_Id; 2282 In_Tree : Project_Node_Tree_Ref; 2283 To : Project_Node_Id) 2284 is 2285 begin 2286 pragma Assert 2287 (Present (Node) 2288 and then 2289 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression); 2290 In_Tree.Project_Nodes.Table (Node).Field1 := To; 2291 end Set_First_Term; 2292 2293 --------------------------- 2294 -- Set_First_Variable_Of -- 2295 --------------------------- 2296 2297 procedure Set_First_Variable_Of 2298 (Node : Project_Node_Id; 2299 In_Tree : Project_Node_Tree_Ref; 2300 To : Variable_Node_Id) 2301 is 2302 begin 2303 pragma Assert 2304 (Present (Node) 2305 and then 2306 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project 2307 or else 2308 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration)); 2309 In_Tree.Project_Nodes.Table (Node).Variables := To; 2310 end Set_First_Variable_Of; 2311 2312 ------------------------------ 2313 -- Set_First_With_Clause_Of -- 2314 ------------------------------ 2315 2316 procedure Set_First_With_Clause_Of 2317 (Node : Project_Node_Id; 2318 In_Tree : Project_Node_Tree_Ref; 2319 To : Project_Node_Id) 2320 is 2321 begin 2322 pragma Assert 2323 (Present (Node) 2324 and then 2325 In_Tree.Project_Nodes.Table (Node).Kind = N_Project); 2326 In_Tree.Project_Nodes.Table (Node).Field1 := To; 2327 end Set_First_With_Clause_Of; 2328 2329 -------------------------- 2330 -- Set_Is_Extending_All -- 2331 -------------------------- 2332 2333 procedure Set_Is_Extending_All 2334 (Node : Project_Node_Id; 2335 In_Tree : Project_Node_Tree_Ref) 2336 is 2337 begin 2338 pragma Assert 2339 (Present (Node) 2340 and then 2341 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project 2342 or else 2343 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause)); 2344 In_Tree.Project_Nodes.Table (Node).Flag2 := True; 2345 end Set_Is_Extending_All; 2346 2347 ----------------------------- 2348 -- Set_Is_Not_Last_In_List -- 2349 ----------------------------- 2350 2351 procedure Set_Is_Not_Last_In_List 2352 (Node : Project_Node_Id; 2353 In_Tree : Project_Node_Tree_Ref) 2354 is 2355 begin 2356 pragma Assert 2357 (Present (Node) 2358 and then In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause); 2359 In_Tree.Project_Nodes.Table (Node).Flag1 := True; 2360 end Set_Is_Not_Last_In_List; 2361 2362 ----------------- 2363 -- Set_Kind_Of -- 2364 ----------------- 2365 2366 procedure Set_Kind_Of 2367 (Node : Project_Node_Id; 2368 In_Tree : Project_Node_Tree_Ref; 2369 To : Project_Node_Kind) 2370 is 2371 begin 2372 pragma Assert (Present (Node)); 2373 In_Tree.Project_Nodes.Table (Node).Kind := To; 2374 end Set_Kind_Of; 2375 2376 --------------------- 2377 -- Set_Location_Of -- 2378 --------------------- 2379 2380 procedure Set_Location_Of 2381 (Node : Project_Node_Id; 2382 In_Tree : Project_Node_Tree_Ref; 2383 To : Source_Ptr) 2384 is 2385 begin 2386 pragma Assert (Present (Node)); 2387 In_Tree.Project_Nodes.Table (Node).Location := To; 2388 end Set_Location_Of; 2389 2390 ----------------------------- 2391 -- Set_Extended_Project_Of -- 2392 ----------------------------- 2393 2394 procedure Set_Extended_Project_Of 2395 (Node : Project_Node_Id; 2396 In_Tree : Project_Node_Tree_Ref; 2397 To : Project_Node_Id) 2398 is 2399 begin 2400 pragma Assert 2401 (Present (Node) 2402 and then 2403 In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration); 2404 In_Tree.Project_Nodes.Table (Node).Field2 := To; 2405 end Set_Extended_Project_Of; 2406 2407 ---------------------------------- 2408 -- Set_Extended_Project_Path_Of -- 2409 ---------------------------------- 2410 2411 procedure Set_Extended_Project_Path_Of 2412 (Node : Project_Node_Id; 2413 In_Tree : Project_Node_Tree_Ref; 2414 To : Path_Name_Type) 2415 is 2416 begin 2417 pragma Assert 2418 (Present (Node) 2419 and then 2420 In_Tree.Project_Nodes.Table (Node).Kind = N_Project); 2421 In_Tree.Project_Nodes.Table (Node).Value := Name_Id (To); 2422 end Set_Extended_Project_Path_Of; 2423 2424 ------------------------------ 2425 -- Set_Extending_Project_Of -- 2426 ------------------------------ 2427 2428 procedure Set_Extending_Project_Of 2429 (Node : Project_Node_Id; 2430 In_Tree : Project_Node_Tree_Ref; 2431 To : Project_Node_Id) 2432 is 2433 begin 2434 pragma Assert 2435 (Present (Node) 2436 and then 2437 In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration); 2438 In_Tree.Project_Nodes.Table (Node).Field3 := To; 2439 end Set_Extending_Project_Of; 2440 2441 ----------------- 2442 -- Set_Name_Of -- 2443 ----------------- 2444 2445 procedure Set_Name_Of 2446 (Node : Project_Node_Id; 2447 In_Tree : Project_Node_Tree_Ref; 2448 To : Name_Id) 2449 is 2450 begin 2451 pragma Assert (Present (Node)); 2452 In_Tree.Project_Nodes.Table (Node).Name := To; 2453 end Set_Name_Of; 2454 2455 ------------------------- 2456 -- Set_Display_Name_Of -- 2457 ------------------------- 2458 2459 procedure Set_Display_Name_Of 2460 (Node : Project_Node_Id; 2461 In_Tree : Project_Node_Tree_Ref; 2462 To : Name_Id) 2463 is 2464 begin 2465 pragma Assert 2466 (Present (Node) 2467 and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project); 2468 In_Tree.Project_Nodes.Table (Node).Display_Name := To; 2469 end Set_Display_Name_Of; 2470 2471 ------------------------------- 2472 -- Set_Next_Declarative_Item -- 2473 ------------------------------- 2474 2475 procedure Set_Next_Declarative_Item 2476 (Node : Project_Node_Id; 2477 In_Tree : Project_Node_Tree_Ref; 2478 To : Project_Node_Id) 2479 is 2480 begin 2481 pragma Assert 2482 (Present (Node) 2483 and then 2484 In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item); 2485 In_Tree.Project_Nodes.Table (Node).Field2 := To; 2486 end Set_Next_Declarative_Item; 2487 2488 ----------------------- 2489 -- Set_Next_End_Node -- 2490 ----------------------- 2491 2492 procedure Set_Next_End_Node (To : Project_Node_Id) is 2493 begin 2494 Next_End_Nodes.Increment_Last; 2495 Next_End_Nodes.Table (Next_End_Nodes.Last) := To; 2496 end Set_Next_End_Node; 2497 2498 --------------------------------- 2499 -- Set_Next_Expression_In_List -- 2500 --------------------------------- 2501 2502 procedure Set_Next_Expression_In_List 2503 (Node : Project_Node_Id; 2504 In_Tree : Project_Node_Tree_Ref; 2505 To : Project_Node_Id) 2506 is 2507 begin 2508 pragma Assert 2509 (Present (Node) 2510 and then 2511 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression); 2512 In_Tree.Project_Nodes.Table (Node).Field2 := To; 2513 end Set_Next_Expression_In_List; 2514 2515 ----------------------------- 2516 -- Set_Next_Literal_String -- 2517 ----------------------------- 2518 2519 procedure Set_Next_Literal_String 2520 (Node : Project_Node_Id; 2521 In_Tree : Project_Node_Tree_Ref; 2522 To : Project_Node_Id) 2523 is 2524 begin 2525 pragma Assert 2526 (Present (Node) 2527 and then 2528 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String); 2529 In_Tree.Project_Nodes.Table (Node).Field1 := To; 2530 end Set_Next_Literal_String; 2531 2532 --------------------------------- 2533 -- Set_Next_Package_In_Project -- 2534 --------------------------------- 2535 2536 procedure Set_Next_Package_In_Project 2537 (Node : Project_Node_Id; 2538 In_Tree : Project_Node_Tree_Ref; 2539 To : Project_Node_Id) 2540 is 2541 begin 2542 pragma Assert 2543 (Present (Node) 2544 and then 2545 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration); 2546 In_Tree.Project_Nodes.Table (Node).Field3 := To; 2547 end Set_Next_Package_In_Project; 2548 2549 -------------------------- 2550 -- Set_Next_String_Type -- 2551 -------------------------- 2552 2553 procedure Set_Next_String_Type 2554 (Node : Project_Node_Id; 2555 In_Tree : Project_Node_Tree_Ref; 2556 To : Project_Node_Id) 2557 is 2558 begin 2559 pragma Assert 2560 (Present (Node) 2561 and then 2562 In_Tree.Project_Nodes.Table (Node).Kind = 2563 N_String_Type_Declaration); 2564 In_Tree.Project_Nodes.Table (Node).Field2 := To; 2565 end Set_Next_String_Type; 2566 2567 ------------------- 2568 -- Set_Next_Term -- 2569 ------------------- 2570 2571 procedure Set_Next_Term 2572 (Node : Project_Node_Id; 2573 In_Tree : Project_Node_Tree_Ref; 2574 To : Project_Node_Id) 2575 is 2576 begin 2577 pragma Assert 2578 (Present (Node) 2579 and then 2580 In_Tree.Project_Nodes.Table (Node).Kind = N_Term); 2581 In_Tree.Project_Nodes.Table (Node).Field2 := To; 2582 end Set_Next_Term; 2583 2584 ----------------------- 2585 -- Set_Next_Variable -- 2586 ----------------------- 2587 2588 procedure Set_Next_Variable 2589 (Node : Project_Node_Id; 2590 In_Tree : Project_Node_Tree_Ref; 2591 To : Project_Node_Id) 2592 is 2593 begin 2594 pragma Assert 2595 (Present (Node) 2596 and then 2597 (In_Tree.Project_Nodes.Table (Node).Kind = 2598 N_Typed_Variable_Declaration 2599 or else 2600 In_Tree.Project_Nodes.Table (Node).Kind = 2601 N_Variable_Declaration)); 2602 In_Tree.Project_Nodes.Table (Node).Field3 := To; 2603 end Set_Next_Variable; 2604 2605 ----------------------------- 2606 -- Set_Next_With_Clause_Of -- 2607 ----------------------------- 2608 2609 procedure Set_Next_With_Clause_Of 2610 (Node : Project_Node_Id; 2611 In_Tree : Project_Node_Tree_Ref; 2612 To : Project_Node_Id) 2613 is 2614 begin 2615 pragma Assert 2616 (Present (Node) 2617 and then 2618 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause); 2619 In_Tree.Project_Nodes.Table (Node).Field2 := To; 2620 end Set_Next_With_Clause_Of; 2621 2622 ----------------------- 2623 -- Set_Package_Id_Of -- 2624 ----------------------- 2625 2626 procedure Set_Package_Id_Of 2627 (Node : Project_Node_Id; 2628 In_Tree : Project_Node_Tree_Ref; 2629 To : Package_Node_Id) 2630 is 2631 begin 2632 pragma Assert 2633 (Present (Node) 2634 and then 2635 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration); 2636 In_Tree.Project_Nodes.Table (Node).Pkg_Id := To; 2637 end Set_Package_Id_Of; 2638 2639 ------------------------- 2640 -- Set_Package_Node_Of -- 2641 ------------------------- 2642 2643 procedure Set_Package_Node_Of 2644 (Node : Project_Node_Id; 2645 In_Tree : Project_Node_Tree_Ref; 2646 To : Project_Node_Id) 2647 is 2648 begin 2649 pragma Assert 2650 (Present (Node) 2651 and then 2652 (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference 2653 or else 2654 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); 2655 In_Tree.Project_Nodes.Table (Node).Field2 := To; 2656 end Set_Package_Node_Of; 2657 2658 ---------------------- 2659 -- Set_Path_Name_Of -- 2660 ---------------------- 2661 2662 procedure Set_Path_Name_Of 2663 (Node : Project_Node_Id; 2664 In_Tree : Project_Node_Tree_Ref; 2665 To : Path_Name_Type) 2666 is 2667 begin 2668 pragma Assert 2669 (Present (Node) 2670 and then 2671 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project 2672 or else 2673 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause)); 2674 In_Tree.Project_Nodes.Table (Node).Path_Name := To; 2675 end Set_Path_Name_Of; 2676 2677 --------------------------- 2678 -- Set_Previous_End_Node -- 2679 --------------------------- 2680 procedure Set_Previous_End_Node (To : Project_Node_Id) is 2681 begin 2682 Previous_End_Node := To; 2683 end Set_Previous_End_Node; 2684 2685 ---------------------------- 2686 -- Set_Previous_Line_Node -- 2687 ---------------------------- 2688 2689 procedure Set_Previous_Line_Node (To : Project_Node_Id) is 2690 begin 2691 Previous_Line_Node := To; 2692 end Set_Previous_Line_Node; 2693 2694 -------------------------------- 2695 -- Set_Project_Declaration_Of -- 2696 -------------------------------- 2697 2698 procedure Set_Project_Declaration_Of 2699 (Node : Project_Node_Id; 2700 In_Tree : Project_Node_Tree_Ref; 2701 To : Project_Node_Id) 2702 is 2703 begin 2704 pragma Assert 2705 (Present (Node) 2706 and then 2707 In_Tree.Project_Nodes.Table (Node).Kind = N_Project); 2708 In_Tree.Project_Nodes.Table (Node).Field2 := To; 2709 end Set_Project_Declaration_Of; 2710 2711 ------------------------------ 2712 -- Set_Project_Qualifier_Of -- 2713 ------------------------------ 2714 2715 procedure Set_Project_Qualifier_Of 2716 (Node : Project_Node_Id; 2717 In_Tree : Project_Node_Tree_Ref; 2718 To : Project_Qualifier) 2719 is 2720 begin 2721 pragma Assert 2722 (Present (Node) 2723 and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project); 2724 In_Tree.Project_Nodes.Table (Node).Qualifier := To; 2725 end Set_Project_Qualifier_Of; 2726 2727 --------------------------- 2728 -- Set_Parent_Project_Of -- 2729 --------------------------- 2730 2731 procedure Set_Parent_Project_Of 2732 (Node : Project_Node_Id; 2733 In_Tree : Project_Node_Tree_Ref; 2734 To : Project_Node_Id) 2735 is 2736 begin 2737 pragma Assert 2738 (Present (Node) 2739 and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project); 2740 In_Tree.Project_Nodes.Table (Node).Field4 := To; 2741 end Set_Parent_Project_Of; 2742 2743 ----------------------------------------------- 2744 -- Set_Project_File_Includes_Unkept_Comments -- 2745 ----------------------------------------------- 2746 2747 procedure Set_Project_File_Includes_Unkept_Comments 2748 (Node : Project_Node_Id; 2749 In_Tree : Project_Node_Tree_Ref; 2750 To : Boolean) 2751 is 2752 Declaration : constant Project_Node_Id := 2753 Project_Declaration_Of (Node, In_Tree); 2754 begin 2755 In_Tree.Project_Nodes.Table (Declaration).Flag1 := To; 2756 end Set_Project_File_Includes_Unkept_Comments; 2757 2758 ------------------------- 2759 -- Set_Project_Node_Of -- 2760 ------------------------- 2761 2762 procedure Set_Project_Node_Of 2763 (Node : Project_Node_Id; 2764 In_Tree : Project_Node_Tree_Ref; 2765 To : Project_Node_Id; 2766 Limited_With : Boolean := False) 2767 is 2768 begin 2769 pragma Assert 2770 (Present (Node) 2771 and then 2772 (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause 2773 or else 2774 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference 2775 or else 2776 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); 2777 In_Tree.Project_Nodes.Table (Node).Field1 := To; 2778 2779 if In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause 2780 and then not Limited_With 2781 then 2782 In_Tree.Project_Nodes.Table (Node).Field3 := To; 2783 end if; 2784 end Set_Project_Node_Of; 2785 2786 --------------------------------------- 2787 -- Set_Project_Of_Renamed_Package_Of -- 2788 --------------------------------------- 2789 2790 procedure Set_Project_Of_Renamed_Package_Of 2791 (Node : Project_Node_Id; 2792 In_Tree : Project_Node_Tree_Ref; 2793 To : Project_Node_Id) 2794 is 2795 begin 2796 pragma Assert 2797 (Present (Node) 2798 and then 2799 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration); 2800 In_Tree.Project_Nodes.Table (Node).Field1 := To; 2801 end Set_Project_Of_Renamed_Package_Of; 2802 2803 ------------------------- 2804 -- Set_Source_Index_Of -- 2805 ------------------------- 2806 2807 procedure Set_Source_Index_Of 2808 (Node : Project_Node_Id; 2809 In_Tree : Project_Node_Tree_Ref; 2810 To : Int) 2811 is 2812 begin 2813 pragma Assert 2814 (Present (Node) 2815 and then 2816 (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String 2817 or else 2818 In_Tree.Project_Nodes.Table (Node).Kind = 2819 N_Attribute_Declaration)); 2820 In_Tree.Project_Nodes.Table (Node).Src_Index := To; 2821 end Set_Source_Index_Of; 2822 2823 ------------------------ 2824 -- Set_String_Type_Of -- 2825 ------------------------ 2826 2827 procedure Set_String_Type_Of 2828 (Node : Project_Node_Id; 2829 In_Tree : Project_Node_Tree_Ref; 2830 To : Project_Node_Id) 2831 is 2832 begin 2833 pragma Assert 2834 (Present (Node) 2835 and then 2836 (In_Tree.Project_Nodes.Table (Node).Kind = 2837 N_Variable_Reference 2838 or else 2839 In_Tree.Project_Nodes.Table (Node).Kind = 2840 N_Typed_Variable_Declaration) 2841 and then 2842 In_Tree.Project_Nodes.Table (To).Kind = N_String_Type_Declaration); 2843 2844 if In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference then 2845 In_Tree.Project_Nodes.Table (Node).Field3 := To; 2846 else 2847 In_Tree.Project_Nodes.Table (Node).Field2 := To; 2848 end if; 2849 end Set_String_Type_Of; 2850 2851 ------------------------- 2852 -- Set_String_Value_Of -- 2853 ------------------------- 2854 2855 procedure Set_String_Value_Of 2856 (Node : Project_Node_Id; 2857 In_Tree : Project_Node_Tree_Ref; 2858 To : Name_Id) 2859 is 2860 begin 2861 pragma Assert 2862 (Present (Node) 2863 and then 2864 (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause 2865 or else 2866 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment 2867 or else 2868 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String)); 2869 In_Tree.Project_Nodes.Table (Node).Value := To; 2870 end Set_String_Value_Of; 2871 2872 --------------------- 2873 -- Source_Index_Of -- 2874 --------------------- 2875 2876 function Source_Index_Of 2877 (Node : Project_Node_Id; 2878 In_Tree : Project_Node_Tree_Ref) return Int 2879 is 2880 begin 2881 pragma Assert 2882 (Present (Node) 2883 and then 2884 (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String 2885 or else 2886 In_Tree.Project_Nodes.Table (Node).Kind = 2887 N_Attribute_Declaration)); 2888 return In_Tree.Project_Nodes.Table (Node).Src_Index; 2889 end Source_Index_Of; 2890 2891 -------------------- 2892 -- String_Type_Of -- 2893 -------------------- 2894 2895 function String_Type_Of 2896 (Node : Project_Node_Id; 2897 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id 2898 is 2899 begin 2900 pragma Assert 2901 (Present (Node) 2902 and then 2903 (In_Tree.Project_Nodes.Table (Node).Kind = 2904 N_Variable_Reference 2905 or else 2906 In_Tree.Project_Nodes.Table (Node).Kind = 2907 N_Typed_Variable_Declaration)); 2908 2909 if In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference then 2910 return In_Tree.Project_Nodes.Table (Node).Field3; 2911 else 2912 return In_Tree.Project_Nodes.Table (Node).Field2; 2913 end if; 2914 end String_Type_Of; 2915 2916 --------------------- 2917 -- String_Value_Of -- 2918 --------------------- 2919 2920 function String_Value_Of 2921 (Node : Project_Node_Id; 2922 In_Tree : Project_Node_Tree_Ref) return Name_Id 2923 is 2924 begin 2925 pragma Assert 2926 (Present (Node) 2927 and then 2928 (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause 2929 or else 2930 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment 2931 or else 2932 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String)); 2933 return In_Tree.Project_Nodes.Table (Node).Value; 2934 end String_Value_Of; 2935 2936 -------------------- 2937 -- Value_Is_Valid -- 2938 -------------------- 2939 2940 function Value_Is_Valid 2941 (For_Typed_Variable : Project_Node_Id; 2942 In_Tree : Project_Node_Tree_Ref; 2943 Value : Name_Id) return Boolean 2944 is 2945 begin 2946 pragma Assert 2947 (Present (For_Typed_Variable) 2948 and then 2949 (In_Tree.Project_Nodes.Table (For_Typed_Variable).Kind = 2950 N_Typed_Variable_Declaration)); 2951 2952 declare 2953 Current_String : Project_Node_Id := 2954 First_Literal_String 2955 (String_Type_Of (For_Typed_Variable, In_Tree), 2956 In_Tree); 2957 2958 begin 2959 while Present (Current_String) 2960 and then 2961 String_Value_Of (Current_String, In_Tree) /= Value 2962 loop 2963 Current_String := 2964 Next_Literal_String (Current_String, In_Tree); 2965 end loop; 2966 2967 return Present (Current_String); 2968 end; 2969 2970 end Value_Is_Valid; 2971 2972 ------------------------------- 2973 -- There_Are_Unkept_Comments -- 2974 ------------------------------- 2975 2976 function There_Are_Unkept_Comments return Boolean is 2977 begin 2978 return Unkept_Comments; 2979 end There_Are_Unkept_Comments; 2980 2981 -------------------- 2982 -- Create_Project -- 2983 -------------------- 2984 2985 function Create_Project 2986 (In_Tree : Project_Node_Tree_Ref; 2987 Name : Name_Id; 2988 Full_Path : Path_Name_Type; 2989 Is_Config_File : Boolean := False) return Project_Node_Id 2990 is 2991 Project : Project_Node_Id; 2992 Qualifier : Project_Qualifier := Unspecified; 2993 begin 2994 Project := Default_Project_Node (In_Tree, N_Project); 2995 Set_Name_Of (Project, In_Tree, Name); 2996 Set_Display_Name_Of (Project, In_Tree, Name); 2997 Set_Directory_Of 2998 (Project, In_Tree, 2999 Path_Name_Type (Get_Directory (File_Name_Type (Full_Path)))); 3000 Set_Path_Name_Of (Project, In_Tree, Full_Path); 3001 3002 Set_Project_Declaration_Of 3003 (Project, In_Tree, 3004 Default_Project_Node (In_Tree, N_Project_Declaration)); 3005 3006 if Is_Config_File then 3007 Qualifier := Configuration; 3008 end if; 3009 3010 if not Is_Config_File then 3011 Prj.Tree.Tree_Private_Part.Projects_Htable.Set 3012 (In_Tree.Projects_HT, 3013 Name, 3014 Prj.Tree.Tree_Private_Part.Project_Name_And_Node' 3015 (Name => Name, 3016 Resolved_Path => No_Path, 3017 Node => Project, 3018 Extended => False, 3019 From_Extended => False, 3020 Proj_Qualifier => Qualifier)); 3021 end if; 3022 3023 return Project; 3024 end Create_Project; 3025 3026 ---------------- 3027 -- Add_At_End -- 3028 ---------------- 3029 3030 procedure Add_At_End 3031 (Tree : Project_Node_Tree_Ref; 3032 Parent : Project_Node_Id; 3033 Expr : Project_Node_Id; 3034 Add_Before_First_Pkg : Boolean := False; 3035 Add_Before_First_Case : Boolean := False) 3036 is 3037 Real_Parent : Project_Node_Id; 3038 New_Decl, Decl, Next : Project_Node_Id; 3039 Last, L : Project_Node_Id; 3040 3041 begin 3042 if Kind_Of (Expr, Tree) /= N_Declarative_Item then 3043 New_Decl := Default_Project_Node (Tree, N_Declarative_Item); 3044 Set_Current_Item_Node (New_Decl, Tree, Expr); 3045 else 3046 New_Decl := Expr; 3047 end if; 3048 3049 if Kind_Of (Parent, Tree) = N_Project then 3050 Real_Parent := Project_Declaration_Of (Parent, Tree); 3051 else 3052 Real_Parent := Parent; 3053 end if; 3054 3055 Decl := First_Declarative_Item_Of (Real_Parent, Tree); 3056 3057 if Decl = Empty_Node then 3058 Set_First_Declarative_Item_Of (Real_Parent, Tree, New_Decl); 3059 else 3060 loop 3061 Next := Next_Declarative_Item (Decl, Tree); 3062 exit when Next = Empty_Node 3063 or else 3064 (Add_Before_First_Pkg 3065 and then Kind_Of (Current_Item_Node (Next, Tree), Tree) = 3066 N_Package_Declaration) 3067 or else 3068 (Add_Before_First_Case 3069 and then Kind_Of (Current_Item_Node (Next, Tree), Tree) = 3070 N_Case_Construction); 3071 Decl := Next; 3072 end loop; 3073 3074 -- In case Expr is in fact a range of declarative items 3075 3076 Last := New_Decl; 3077 loop 3078 L := Next_Declarative_Item (Last, Tree); 3079 exit when L = Empty_Node; 3080 Last := L; 3081 end loop; 3082 3083 -- In case Expr is in fact a range of declarative items 3084 3085 Last := New_Decl; 3086 loop 3087 L := Next_Declarative_Item (Last, Tree); 3088 exit when L = Empty_Node; 3089 Last := L; 3090 end loop; 3091 3092 Set_Next_Declarative_Item (Last, Tree, Next); 3093 Set_Next_Declarative_Item (Decl, Tree, New_Decl); 3094 end if; 3095 end Add_At_End; 3096 3097 --------------------------- 3098 -- Create_Literal_String -- 3099 --------------------------- 3100 3101 function Create_Literal_String 3102 (Str : Namet.Name_Id; 3103 Tree : Project_Node_Tree_Ref) return Project_Node_Id 3104 is 3105 Node : Project_Node_Id; 3106 begin 3107 Node := Default_Project_Node (Tree, N_Literal_String, Prj.Single); 3108 Set_Next_Literal_String (Node, Tree, Empty_Node); 3109 Set_String_Value_Of (Node, Tree, Str); 3110 return Node; 3111 end Create_Literal_String; 3112 3113 --------------------------- 3114 -- Enclose_In_Expression -- 3115 --------------------------- 3116 3117 function Enclose_In_Expression 3118 (Node : Project_Node_Id; 3119 Tree : Project_Node_Tree_Ref) return Project_Node_Id 3120 is 3121 Expr : Project_Node_Id; 3122 begin 3123 if Kind_Of (Node, Tree) /= N_Expression then 3124 Expr := Default_Project_Node (Tree, N_Expression, Single); 3125 Set_First_Term 3126 (Expr, Tree, Default_Project_Node (Tree, N_Term, Single)); 3127 Set_Current_Term (First_Term (Expr, Tree), Tree, Node); 3128 return Expr; 3129 else 3130 return Node; 3131 end if; 3132 end Enclose_In_Expression; 3133 3134 -------------------- 3135 -- Create_Package -- 3136 -------------------- 3137 3138 function Create_Package 3139 (Tree : Project_Node_Tree_Ref; 3140 Project : Project_Node_Id; 3141 Pkg : String) return Project_Node_Id 3142 is 3143 Pack : Project_Node_Id; 3144 N : Name_Id; 3145 3146 begin 3147 Name_Len := Pkg'Length; 3148 Name_Buffer (1 .. Name_Len) := Pkg; 3149 N := Name_Find; 3150 3151 -- Check if the package already exists 3152 3153 Pack := First_Package_Of (Project, Tree); 3154 while Pack /= Empty_Node loop 3155 if Prj.Tree.Name_Of (Pack, Tree) = N then 3156 return Pack; 3157 end if; 3158 3159 Pack := Next_Package_In_Project (Pack, Tree); 3160 end loop; 3161 3162 -- Create the package and add it to the declarative item 3163 3164 Pack := Default_Project_Node (Tree, N_Package_Declaration); 3165 Set_Name_Of (Pack, Tree, N); 3166 3167 -- Find the correct package id to use 3168 3169 Set_Package_Id_Of (Pack, Tree, Package_Node_Id_Of (N)); 3170 3171 -- Add it to the list of packages 3172 3173 Set_Next_Package_In_Project 3174 (Pack, Tree, First_Package_Of (Project, Tree)); 3175 Set_First_Package_Of (Project, Tree, Pack); 3176 3177 Add_At_End (Tree, Project_Declaration_Of (Project, Tree), Pack); 3178 3179 return Pack; 3180 end Create_Package; 3181 3182 ---------------------- 3183 -- Create_Attribute -- 3184 ---------------------- 3185 3186 function Create_Attribute 3187 (Tree : Project_Node_Tree_Ref; 3188 Prj_Or_Pkg : Project_Node_Id; 3189 Name : Name_Id; 3190 Index_Name : Name_Id := No_Name; 3191 Kind : Variable_Kind := List; 3192 At_Index : Integer := 0; 3193 Value : Project_Node_Id := Empty_Node) return Project_Node_Id 3194 is 3195 Node : constant Project_Node_Id := 3196 Default_Project_Node (Tree, N_Attribute_Declaration, Kind); 3197 3198 Case_Insensitive : Boolean; 3199 3200 Pkg : Package_Node_Id; 3201 Start_At : Attribute_Node_Id; 3202 Expr : Project_Node_Id; 3203 3204 begin 3205 Set_Name_Of (Node, Tree, Name); 3206 3207 if Index_Name /= No_Name then 3208 Set_Associative_Array_Index_Of (Node, Tree, Index_Name); 3209 end if; 3210 3211 if Prj_Or_Pkg /= Empty_Node then 3212 Add_At_End (Tree, Prj_Or_Pkg, Node); 3213 end if; 3214 3215 -- Find out the case sensitivity of the attribute 3216 3217 if Prj_Or_Pkg /= Empty_Node 3218 and then Kind_Of (Prj_Or_Pkg, Tree) = N_Package_Declaration 3219 then 3220 Pkg := Prj.Attr.Package_Node_Id_Of (Name_Of (Prj_Or_Pkg, Tree)); 3221 Start_At := First_Attribute_Of (Pkg); 3222 else 3223 Start_At := Attribute_First; 3224 end if; 3225 3226 Start_At := Attribute_Node_Id_Of (Name, Start_At); 3227 Case_Insensitive := 3228 Attribute_Kind_Of (Start_At) = Case_Insensitive_Associative_Array; 3229 Tree.Project_Nodes.Table (Node).Flag1 := Case_Insensitive; 3230 3231 if At_Index /= 0 then 3232 if Attribute_Kind_Of (Start_At) = 3233 Optional_Index_Associative_Array 3234 or else Attribute_Kind_Of (Start_At) = 3235 Optional_Index_Case_Insensitive_Associative_Array 3236 then 3237 -- Results in: for Name ("index" at index) use "value"; 3238 -- This is currently only used for executables. 3239 3240 Set_Source_Index_Of (Node, Tree, To => Int (At_Index)); 3241 3242 else 3243 -- Results in: for Name ("index") use "value" at index; 3244 3245 -- ??? This limitation makes no sense, we should be able to 3246 -- set the source index on an expression. 3247 3248 pragma Assert (Kind_Of (Value, Tree) = N_Literal_String); 3249 Set_Source_Index_Of (Value, Tree, To => Int (At_Index)); 3250 end if; 3251 end if; 3252 3253 if Value /= Empty_Node then 3254 Expr := Enclose_In_Expression (Value, Tree); 3255 Set_Expression_Of (Node, Tree, Expr); 3256 end if; 3257 3258 return Node; 3259 end Create_Attribute; 3260 3261end Prj.Tree; 3262