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